From 47591bb6a099a78a2e2411ed046ce63567307e7e Mon Sep 17 00:00:00 2001
From: malc <av1474@comtv.ru>
Date: Fri, 5 Oct 2012 08:26:13 +0400
Subject: [PATCH] Allow distance traveled when pgup/down is hit be scaled

---
 main.ml | 25 ++++++++++++++++++++++---
 1 file changed, 22 insertions(+), 3 deletions(-)

diff --git a/main.ml b/main.ml
index 5d2f73b..259d983 100644
--- a/main.ml
+++ b/main.ml
@@ -332,6 +332,7 @@ type conf =
     ; mutable updatecurs     : bool
     ; mutable keyhashes      : (string * keyhash) list
     ; mutable hfsize         : int
+    ; mutable pgscale        : float
     }
 and columns =
     | Csingle
@@ -532,7 +533,8 @@ let defconf =
   ; columns        = Csingle
   ; beyecolumns    = None
   ; updatecurs     = false
-  ; hfsize = 12
+  ; hfsize         = 12
+  ; pgscale        = 1.0
   ; keyhashes      =
       let mk n = (n, Hashtbl.create 1) in
       [ mk "global"
@@ -555,6 +557,8 @@ let findkeyhash c name =
 
 let conf = { defconf with angle = defconf.angle };;
 
+let pgscale h = truncate (float h *. conf.pgscale);;
+
 type fontstate =
     { mutable fontsize : int
     ; mutable wwidth : float
@@ -4359,6 +4363,18 @@ let enterinfomode =
           state.anchor <- getanchor ();
           opendoc state.path state.password;
         );
+      src#string "page scroll scaling factor"
+        (fun () -> string_of_float conf.pgscale)
+        (fun v ->
+          try
+            let s = float_of_string v in
+            conf.pgscale <- s
+          with exn ->
+            state.text <- Printf.sprintf
+              "bad page scroll scaling factor `%s': %s"
+              v (Printexc.to_string exn)
+        )
+      ;
       src#int "ui font size"
         (fun () -> fstate.fontsize)
         (fun v -> setfontsize (bound v 5 100));
@@ -5122,7 +5138,7 @@ let viewkeyboard key mask =
           | [] -> state.y
           | l :: _ -> state.y - l.pagey
         else
-          clamp (-conf.winh)
+          clamp (pgscale (-conf.winh))
       in
       gotoghyll y
 
@@ -5134,7 +5150,7 @@ let viewkeyboard key mask =
           | [] -> state.y
           | l :: _ -> getpagey l.pageno
         else
-          clamp conf.winh
+          clamp (pgscale conf.winh)
       in
       gotoghyll y
 
@@ -6044,6 +6060,7 @@ struct
         | "selection-command" -> { c with selcmd = unent v }
         | "update-cursor" -> { c with updatecurs = bool_of_string v }
         | "hint-font-size" -> { c with hfsize = bound (int_of_string v) 5 100 }
+        | "page-scroll-scale" -> { c with pgscale = float_of_string v }
         | _ -> c
       with exn ->
         prerr_endline ("Error processing attribute (`" ^
@@ -6151,6 +6168,7 @@ struct
     dst.keyhashes      <- copykeyhashes src;
     dst.hfsize         <- src.hfsize;
     dst.hscrollstep    <- src.hscrollstep;
+    dst.pgscale        <- src.pgscale;
   ;;
 
   let get s =
@@ -6560,6 +6578,7 @@ struct
     ob "update-cursor" c.updatecurs dc.updatecurs;
     oi "hint-font-size" c.hfsize dc.hfsize;
     oi "horizontal-scroll-step" c.hscrollstep dc.hscrollstep;
+    oF "page-scroll-scale" c.pgscale dc.pgscale;
   ;;
 
   let keymapsbuf always dc c =
-- 
2.11.4.GIT