6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
40 let reeenterhist = ref false;;
41 let selfexec = ref E.s
;;
43 let drawstring size x y s
=
45 Gl.enable `texture_2d
;
46 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
47 ignore
(drawstr size x y s
);
49 Gl.disable `texture_2d
;
52 let drawstring1 size x y s
=
56 let drawstring2 size x y fmt
=
57 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
61 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
62 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
63 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
64 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
65 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
66 dolog
" column %d" l
.pagecol
;
70 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
72 dolog
" x0,y0=(% f, % f)" x0 y0
;
73 dolog
" x1,y1=(% f, % f)" x1 y1
;
74 dolog
" x2,y2=(% f, % f)" x2 y2
;
75 dolog
" x3,y3=(% f, % f)" x3 y3
;
79 let isbirdseye = function
86 let istextentry = function
93 let wtmode = ref false;;
94 let cxack = ref false;;
96 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
99 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
100 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
106 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
111 let wadjsb () = -vscrollw ();;
112 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
115 fstate
.fontsize
<- n
;
116 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
117 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
123 Printf.kprintf prerr_endline fmt
125 Printf.kprintf ignore fmt
129 if emptystr conf
.pathlauncher
130 then print_endline state
.path
132 let re = Str.regexp
"%s" in
133 let command = Str.global_replace
re state
.path conf
.pathlauncher
in
136 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
141 let redirectstderr () =
142 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
143 if conf
.redirectstderr
145 match Unix.pipe
() with
147 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
150 begin match Unix.dup
Unix.stderr
with
152 dolog
"failed to dup stderr: %s" (exntos exn
);
153 Ne.clo r
(clofail "pipe/r");
154 Ne.clo w
(clofail "pipe/w");
157 begin match Unix.dup2 w
Unix.stderr
with
159 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
160 Ne.clo dupstderr
(clofail "stderr duplicate");
161 Ne.clo r
(clofail "redir pipe/r");
162 Ne.clo w
(clofail "redir pipe/w");
165 state
.stderr
<- dupstderr
;
166 state
.errfd
<- Some r
;
170 state
.newerrmsgs
<- false;
171 begin match state
.errfd
with
173 begin match Unix.dup2 state
.stderr
Unix.stderr
with
175 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
177 Ne.clo fd
(clofail "dup of stderr");
182 prerr_string
(Buffer.contents state
.errmsgs
);
184 Buffer.clear state
.errmsgs
;
190 let postRedisplay who
=
192 then prerr_endline
("redisplay for " ^ who
);
193 state
.redisplay
<- true;
197 let getopaque pageno
=
198 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
199 with Not_found
-> None
202 let putopaque pageno opaque
=
203 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
206 let pagetranslatepoint l x y
=
207 let dy = y
- l
.pagedispy
in
208 let y = dy + l
.pagey
in
209 let dx = x
- l
.pagedispx
in
210 let x = dx + l
.pagex
in
214 let onppundermouse g
x y d
=
217 begin match getopaque l
.pageno
with
219 let x0 = l
.pagedispx
in
220 let x1 = x0 + l
.pagevw
in
221 let y0 = l
.pagedispy
in
222 let y1 = y0 + l
.pagevh
in
223 if y >= y0 && y <= y1 && x >= x0 && x <= x1
225 let px, py
= pagetranslatepoint l
x y in
226 match g opaque l
px py
with
239 let g opaque l
px py
=
242 match rectofblock opaque
px py
with
244 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
245 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
246 G.postRedisplay "getunder";
249 let under = whatsunder opaque
px py
in
260 | Uannotation _
-> Some
under
262 onppundermouse g x y Unone
267 match unproject opaque
x y with
268 | Some
(x, y) -> Some
(Some
(l
.pageno
, x, y))
271 onppundermouse g x y None
;
275 state
.text
<- Printf.sprintf
"%c%s" c s
;
276 G.postRedisplay "showtext";
279 let pipesel opaque cmd
=
282 match Unix.pipe
() with
285 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
287 let doclose what fd
=
288 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
291 try popen cmd
[r
, 0; w
, -1]; true
293 dolog
"can not execute %S: %s" cmd
(exntos exn
);
299 G.postRedisplay "pipesel";
301 else doclose "pipesel pipe/w" w
;
302 doclose "pipesel pipe/r" r
;
306 let g opaque l
px py
=
307 if markunder opaque
px py conf
.paxmark
310 match getopaque l
.pageno
with
312 | Some opaque
-> pipesel opaque conf
.paxcmd
317 G.postRedisplay "paxunder";
318 if conf
.paxmark
= Mark_page
321 match getopaque l
.pageno
with
323 | Some opaque
-> clearmark opaque
) state
.layout
;
325 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
329 match Unix.pipe
() with
331 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
334 Ne.clo fd
(fun msg
->
335 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
339 try popen conf
.selcmd
[r
, 0; w
, -1]; true
342 (Printf.sprintf
"failed to execute %s: %s"
343 conf
.selcmd
(exntos exn
));
349 let l = String.length s
in
350 let bytes = Bytes.unsafe_of_string s
in
351 let n = tempfailureretry
(Unix.write w
bytes 0) l in
356 "failed to write %d characters to sel pipe, wrote %d"
361 (Printf.sprintf
"failed to write to sel pipe: %s"
366 clo "selstring pipe/r" r
;
367 clo "selstring pipe/w" w
;
370 let undertext = function
373 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
374 | Utext s
-> "font: " ^ s
375 | Uunexpected s
-> "unexpected: " ^ s
376 | Ulaunch s
-> "launch: " ^ s
377 | Unamed s
-> "named: " ^ s
378 | Uremote
(filename
, pageno
) ->
379 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
380 | Uremotedest
(filename
, destname
) ->
381 Printf.sprintf
"%s: destination %S" filename destname
382 | Uannotation contents
->
383 Printf.sprintf
"annotation " ^ contents
386 let updateunder x y =
387 match getunder x y with
388 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
390 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
391 Wsi.setcursor
Wsi.CURSOR_INFO
392 | Ulinkgoto
(pageno
, _
) ->
394 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
395 Wsi.setcursor
Wsi.CURSOR_INFO
397 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
398 Wsi.setcursor
Wsi.CURSOR_TEXT
400 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
401 Wsi.setcursor
Wsi.CURSOR_INHERIT
403 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
404 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
407 Wsi.setcursor
Wsi.CURSOR_INHERIT
408 | Uremote
(filename
, pageno
) ->
409 if conf
.underinfo
then showtext 'r'
410 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
411 Wsi.setcursor
Wsi.CURSOR_INFO
412 | Uremotedest
(filename
, destname
) ->
413 if conf
.underinfo
then showtext 'r'
414 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
415 Wsi.setcursor
Wsi.CURSOR_INFO
417 if conf
.underinfo
then showtext 'a'
"nnotation";
418 Wsi.setcursor
Wsi.CURSOR_INFO
421 let showlinktype under =
435 let s = undertext under in
440 let b = Buffer.create
(String.length
s + 1) in
441 Buffer.add_string
b s;
446 let intentry_with_suffix text key
=
448 if key
>= 32 && key
< 127
452 match Char.lowercase
c with
454 let text = addchar text c in
458 let text = addchar text c in
462 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
467 let s = Bytes.create
4 in
468 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
469 if n != 4 then error
"incomplete read(len) = %d" n;
470 let len = (Char.code
(Bytes.get
s 0) lsl 24)
471 lor (Char.code
(Bytes.get
s 1) lsl 16)
472 lor (Char.code
(Bytes.get
s 2) lsl 8)
473 lor (Char.code
(Bytes.get
s 3))
475 let s = Bytes.create
len in
476 let n = tempfailureretry
(Unix.read fd
s 0) len in
477 if n != len then error
"incomplete read(data) %d vs %d" n len;
481 let btod b = if b then 1 else 0;;
484 let b = Buffer.create
16 in
485 Buffer.add_string
b "llll";
488 let s = Buffer.to_bytes
b in
489 let n = Bytes.length
s in
491 (* dolog "wcmd %S" (String.sub s 4 len); *)
492 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
493 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
494 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
495 Bytes.set
s 3 (Char.chr
(len land 0xff));
496 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
497 if n'
!= n then error
"write failed %d vs %d" n'
n;
501 let nogeomcmds cmds
=
503 | s, [] -> emptystr
s
507 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
508 let sh = sh - (hscrollh ()) in
509 let wadj = wadjsb () in
510 let rec fold accu
n =
511 if n = Array.length
b
514 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
517 || n = state
.pagecount
- coverB
518 || (n - coverA
) mod columns
= columns
- 1)
524 let pagey = max
0 (y - vy
) in
525 let pagedispy = if pagey > 0 then 0 else vy
- y in
526 let pagedispx, pagex
=
528 if n = coverA
- 1 || n = state
.pagecount
- coverB
529 then state
.x + (wadj + state
.winw
- w
) / 2
530 else dx + xoff
+ state
.x
537 let vw = wadj + state
.winw
- pagedispx in
538 let pw = w
- pagex
in
541 let pagevh = min
(h
- pagey) (sh - pagedispy) in
542 if pagevw > 0 && pagevh > 0
553 ; pagedispx = pagedispx
554 ; pagedispy = pagedispy
566 if Array.length
b = 0
568 else List.rev
(fold [] (page_of_y
y))
571 let layoutS (columns
, b) y sh =
572 let sh = sh - hscrollh () in
573 let wadj = wadjsb () in
574 let rec fold accu n =
575 if n = Array.length
b
578 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
585 let x = xoff
+ state
.x in
586 let pagey = max
0 (y - vy
) in
587 let pagedispy = if pagey > 0 then 0 else vy
- y in
588 let pagedispx, pagex
=
602 let pagecolw = pagew
/columns
in
604 if pagecolw < state
.winw
605 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
609 let vw = wadj + state
.winw
- pagedispx in
610 let pw = pagew
- pagex
in
613 let pagevw = min
pagevw pagecolw in
614 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
615 if pagevw > 0 && pagevh > 0
626 ; pagedispx = pagedispx
627 ; pagedispy = pagedispy
628 ; pagecol
= n mod columns
643 if nogeomcmds state
.geomcmds
645 match conf
.columns
with
646 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
647 | Cmulti
c -> layoutN c y sh
648 | Csplit
s -> layoutS s y sh
653 let y = state
.y + incr
in
655 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
660 let tilex = l.pagex
mod conf
.tilew
in
661 let tiley = l.pagey mod conf
.tileh
in
663 let col = l.pagex
/ conf
.tilew
in
664 let row = l.pagey / conf
.tileh
in
666 let xadj = xadjsb () in
667 let rec rowloop row y0 dispy h
=
671 let dh = conf
.tileh
- y0 in
673 let rec colloop col x0 dispx w
=
677 let dw = conf
.tilew
- x0 in
679 let dispx'
= xadj + dispx in
680 f col row dispx' dispy
x0 y0 dw dh;
681 colloop (col+1) 0 (dispx+dw) (w
-dw)
684 colloop col tilex l.pagedispx l.pagevw;
685 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
688 if l.pagevw > 0 && l.pagevh > 0
689 then rowloop row tiley l.pagedispy l.pagevh;
692 let gettileopaque l col row =
694 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
696 try Some
(Hashtbl.find state
.tilemap
key)
697 with Not_found
-> None
700 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
701 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
702 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
705 let filledrect x0 y0 x1 y1 =
706 GlArray.disable `texture_coord
;
707 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
708 GlArray.vertex `two state
.vraw
;
709 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
710 GlArray.enable `texture_coord
;
713 let linerect x0 y0 x1 y1 =
714 GlArray.disable `texture_coord
;
715 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
716 GlArray.vertex `two state
.vraw
;
717 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
718 GlArray.enable `texture_coord
;
721 let drawtiles l color
=
723 let wadj = wadjsb () in
725 let f col row x y tilex tiley w h
=
726 match gettileopaque l col row with
727 | Some
(opaque
, _
, t
) ->
728 let params = x, y, w
, h
, tilex, tiley in
730 then GlTex.env
(`mode `blend
);
731 drawtile
params opaque
;
733 then GlTex.env
(`mode `modulate
);
737 let s = Printf.sprintf
741 let w = measurestr fstate
.fontsize
s in
742 GlDraw.color
(0.0, 0.0, 0.0);
743 filledrect (float (x-2))
746 (float (y + fstate
.fontsize
+ 2));
747 GlDraw.color
(1.0, 1.0, 1.0);
748 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
758 let lw = wadj + state
.winw
- x in
761 let lh = state
.winh
- y in
765 then GlTex.env
(`mode `blend
);
766 begin match state
.checkerstexid
with
768 Gl.enable `texture_2d
;
769 GlTex.bind_texture ~target
:`texture_2d id
;
773 and y1 = float (y+h
) in
775 let tw = float w /. 16.0
776 and th
= float h
/. 16.0 in
777 let tx0 = float tilex /. 16.0
778 and ty0
= float tiley /. 16.0 in
780 and ty1
= ty0
+. th
in
781 Raw.sets_float state
.vraw ~pos
:0
782 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
783 Raw.sets_float state
.traw ~pos
:0
784 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
785 GlArray.vertex `two state
.vraw
;
786 GlArray.tex_coord `two state
.traw
;
787 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
788 Gl.disable `texture_2d
;
791 GlDraw.color
(1.0, 1.0, 1.0);
792 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
795 then GlTex.env
(`mode `modulate
);
796 if w > 128 && h
> fstate
.fontsize
+ 10
798 let c = if conf
.invert
then 1.0 else 0.0 in
799 GlDraw.color
(c, c, c);
802 then (col*conf
.tilew
, row*conf
.tileh
)
805 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
814 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
816 let tilevisible1 l x y =
818 and ax1
= l.pagex
+ l.pagevw
820 and ay1
= l.pagey + l.pagevh in
824 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
825 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
827 let rx0 = max
ax0 bx0
828 and ry0
= max ay0 by0
829 and rx1
= min ax1
bx1
830 and ry1
= min ay1 by1
in
832 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
836 let tilevisible layout n x y =
837 let rec findpageinlayout m
= function
838 | l :: rest
when l.pageno
= n ->
839 tilevisible1 l x y || (
840 match conf
.columns
with
841 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
846 | _
:: rest
-> findpageinlayout 0 rest
849 findpageinlayout 0 layout;
852 let tileready l x y =
853 tilevisible1 l x y &&
854 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
857 let tilepage n p
layout =
858 let rec loop = function
862 let f col row _ _ _ _ _ _
=
863 if state
.currently
= Idle
865 match gettileopaque l col row with
868 let x = col*conf
.tilew
869 and y = row*conf
.tileh
in
871 let w = l.pagew
- x in
875 let h = l.pageh
- y in
880 then getpbo
w h conf
.colorspace
883 wcmd "tile %s %d %d %d %d %s"
884 (~
> p
) x y w h (~
> pbo);
887 l, p
, conf
.colorspace
, conf
.angle
,
888 state
.gen
, col, row, conf
.tilew
, conf
.tileh
897 if nogeomcmds state
.geomcmds
901 let preloadlayout y =
902 let y = if y < state
.winh
then 0 else y - state
.winh
in
903 let h = state
.winh
*3 in
909 if state
.currently
!= Idle
914 begin match getopaque l.pageno
with
916 wcmd "page %d %d" l.pageno
l.pagedimno
;
917 state
.currently
<- Loading
(l, state
.gen
);
919 tilepage l.pageno opaque pages
;
924 if nogeomcmds state
.geomcmds
930 if conf
.preload && state
.currently
= Idle
931 then load (preloadlayout state
.y);
934 let layoutready layout =
935 let rec fold all ls
=
938 let seen = ref false in
939 let allvisible = ref true in
940 let foo col row _ _ _ _ _ _
=
942 allvisible := !allvisible &&
943 begin match gettileopaque l col row with
949 fold (!seen && !allvisible) rest
952 let alltilesvisible = fold true layout in
957 let y = bound
y 0 state
.maxy
in
958 let y, layout, proceed
=
959 match conf
.maxwait
with
960 | Some time
when state
.ghyll
== noghyll
->
961 begin match state
.throttle
with
963 let layout = layout y state
.winh
in
964 let ready = layoutready layout in
968 state
.throttle
<- Some
(layout, y, now
());
970 else G.postRedisplay "gotoy showall (None)";
972 | Some
(_
, _
, started
) ->
973 let dt = now
() -. started
in
976 state
.throttle
<- None
;
977 let layout = layout y state
.winh
in
979 G.postRedisplay "maxwait";
986 let layout = layout y state
.winh
in
987 if not
!wtmode || layoutready layout
988 then G.postRedisplay "gotoy ready";
994 state
.layout <- layout;
995 begin match state
.mode
with
998 | Ltexact
(pageno
, linkno
) ->
999 let rec loop = function
1001 state
.mode
<- LinkNav
(Ltgendir
0)
1002 | l :: _
when l.pageno
= pageno
->
1003 begin match getopaque pageno
with
1004 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
1006 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1007 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1008 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1009 then state
.mode
<- LinkNav
(Ltgendir
0)
1011 | _
:: rest
-> loop rest
1014 | Ltnotready _
| Ltgendir _
-> ()
1020 begin match state
.mode
with
1021 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1022 if not
(pagevisible layout pageno
)
1024 match state
.layout with
1027 state
.mode
<- Birdseye
(
1028 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1033 | Ltnotready
(_
, dir
)
1036 let rec loop = function
1039 match getopaque l.pageno
with
1040 | None
-> Ltnotready
(l.pageno
, dir
)
1045 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1047 if dir
> 0 then LDfirst
else LDlast
1053 | Lnotfound
-> loop rest
1055 showlinktype (getlink opaque
n);
1056 Ltexact
(l.pageno
, n)
1060 state
.mode
<- LinkNav
linknav
1068 state
.ghyll
<- noghyll
;
1071 let mx, my
= state
.mpos
in
1076 let conttiling pageno opaque
=
1077 tilepage pageno opaque
1078 (if conf
.preload then preloadlayout state
.y else state
.layout)
1081 let gotoy_and_clear_text y =
1082 if not conf
.verbose
then state
.text <- E.s;
1086 let getanchory (n, top
, dtop
) =
1087 let y, h = getpageyh
n in
1088 if conf
.presentation
1090 let ips = calcips
h in
1091 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1093 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1096 let gotoanchor anchor
=
1097 gotoy (getanchory anchor
);
1101 cbput state
.hists
.nav
(getanchor
());
1105 let anchor = cbgetc state
.hists
.nav dir
in
1109 let gotoghyll1 single
y =
1110 let scroll f n a
b =
1111 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1113 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1115 then s (float f /. float a
)
1118 then 1.0 -. s ((float (f-b) /. float (n-b)))
1124 let ins = float a
*. 0.5
1125 and outs
= float (n-b) *. 0.5 in
1127 ins +. outs
+. float ones
1129 let rec set nab
y sy
=
1130 let (_N
, _A
, _B
), y =
1133 let scl = if y > sy
then 2 else -2 in
1134 let _N, _
, _
= nab
in
1135 (_N,0,_N), y+conf
.scrollstep
*scl
1137 let sum = summa
_N _A _B
in
1138 let dy = float (y - sy
) in
1142 then state
.ghyll
<- noghyll
1145 let s = scroll n _N _A _B
in
1146 let y1 = y1 +. ((s *. dy) /. sum) in
1147 gotoy_and_clear_text (truncate
y1);
1148 state
.ghyll
<- gf (n+1) y1;
1152 | Some
y'
when single
-> set nab
y' state
.y
1153 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1155 gf 0 (float state
.y)
1158 match conf
.ghyllscroll
with
1159 | Some nab
when not conf
.presentation
->
1160 if state
.ghyll
== noghyll
1161 then set nab
y state
.y
1162 else state
.ghyll
(Some
y)
1164 gotoy_and_clear_text y
1167 let gotoghyll = gotoghyll1 false;;
1169 let gotopage n top
=
1170 let y, h = getpageyh
n in
1171 let y = y + (truncate
(top
*. float h)) in
1175 let gotopage1 n top
=
1176 let y = getpagey
n in
1181 let invalidate s f =
1186 match state
.geomcmds
with
1187 | ps
, [] when emptystr ps
->
1189 state
.geomcmds
<- s, [];
1192 state
.geomcmds
<- ps
, [s, f];
1194 | ps
, (s'
, _
) :: rest
when s'
= s ->
1195 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1198 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1202 Hashtbl.iter
(fun _ opaque
->
1203 wcmd "freepage %s" (~
> opaque
);
1205 Hashtbl.clear state
.pagemap
;
1209 if not
(Queue.is_empty state
.tilelru
)
1211 Queue.iter
(fun (k
, p
, s) ->
1212 wcmd "freetile %s" (~
> p
);
1213 state
.memused
<- state
.memused
- s;
1214 Hashtbl.remove state
.tilemap k
;
1216 state
.uioh#infochanged Memused
;
1217 Queue.clear state
.tilelru
;
1223 let h = truncate
(float h*.conf
.zoom
) in
1224 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1228 let opendoc path password
=
1230 state
.password
<- password
;
1231 state
.gen
<- state
.gen
+ 1;
1232 state
.docinfo
<- [];
1233 state
.outlines
<- [||];
1236 setaalevel conf
.aalevel
;
1238 if emptystr state
.origin
1242 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1243 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1244 invalidate "reqlayout"
1246 wcmd "reqlayout %d %d %d %s\000"
1247 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1248 (stateh state
.winh
) state
.nameddest
1253 state
.anchor <- getanchor
();
1254 opendoc state
.path state
.password
;
1258 let c = c *. conf
.colorscale
in
1262 let scalecolor2 (r
, g, b) =
1263 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1266 let docolumns columns
=
1267 let wadj = wadjsb () in
1270 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1271 let wadj = wadjsb () in
1272 let rec loop pageno
pdimno pdim
y ph pdims
=
1273 if pageno
= state
.pagecount
1276 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1278 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1279 pdimno+1, pdim
, rest
1283 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1285 (if conf
.presentation
1286 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1287 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1290 a.(pageno
) <- (pdimno, x, y, pdim
);
1291 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1293 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1294 conf
.columns
<- Csingle
a;
1296 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1297 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1298 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1299 let rec fixrow m
= if m
= pageno
then () else
1300 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1303 let y = y + (rowh
- h) / 2 in
1304 a.(m
) <- (pdimno, x, y, pdim
);
1308 if pageno
= state
.pagecount
1309 then fixrow (((pageno
- 1) / columns
) * columns
)
1311 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1313 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1314 pdimno+1, pdim
, rest
1319 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1321 let x = (wadj + state
.winw
- w) / 2 in
1323 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1324 x, y + ips + rowh
, h
1327 if (pageno
- coverA
) mod columns
= 0
1329 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1331 if conf
.presentation
1333 let ips = calcips
h in
1334 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1336 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1340 else x, y, max rowh
h
1344 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1347 if pageno
= columns
&& conf
.presentation
1349 let ips = calcips rowh
in
1350 for i
= 0 to pred columns
1352 let (pdimno, x, y, pdim
) = a.(i
) in
1353 a.(i
) <- (pdimno, x, y+ips, pdim
)
1359 fixrow (pageno
- columns
);
1364 a.(pageno
) <- (pdimno, x, y, pdim
);
1365 let x = x + w + xoff
*2 + conf
.interpagespace
in
1366 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1368 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1369 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1372 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1373 let rec loop pageno
pdimno pdim
y pdims
=
1374 if pageno
= state
.pagecount
1377 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1379 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1380 pdimno+1, pdim
, rest
1385 let rec loop1 n x y =
1386 if n = c then y else (
1387 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1388 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1391 let y = loop1 0 0 y in
1392 loop (pageno
+1) pdimno pdim
y pdims
1394 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1395 conf
.columns
<- Csplit
(c, a);
1399 docolumns conf
.columns
;
1400 state
.maxy
<- calcheight
();
1401 if state
.reprf
== noreprf
1403 match state
.mode
with
1404 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1405 let y, h = getpageyh pageno
in
1406 let top = (state
.winh
- h) / 2 in
1407 gotoy (max
0 (y - top))
1410 | LinkNav _
-> gotoanchor state
.anchor
1414 state
.reprf
<- noreprf
;
1419 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1420 let firsttime = state
.geomcmds
== firstgeomcmds
in
1421 if not
firsttime && nogeomcmds state
.geomcmds
1422 then state
.anchor <- getanchor
();
1425 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1428 setfontsize fstate
.fontsize
;
1429 GlMat.mode `modelview
;
1430 GlMat.load_identity
();
1432 GlMat.mode `projection
;
1433 GlMat.load_identity
();
1434 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1435 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1436 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1441 else float state
.x /. float state
.w
1443 invalidate "geometry"
1447 then state
.x <- truncate
(relx *. float w);
1449 match conf
.columns
with
1451 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1452 | Csplit
(c, _
) -> w * c
1454 wcmd "geometry %d %d %d"
1455 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1460 let len = String.length state
.text in
1461 let x0 = xadjsb () in
1464 match state
.mode
with
1465 | Textentry _
| View
| LinkNav _
->
1466 let h, _
, _
= state
.uioh#scrollpw
in
1471 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1472 (x+.w) (float (state
.winh
- hscrollh))
1475 let w = float (wadjsb () + state
.winw
- 1) in
1476 if state
.progress
>= 0.0 && state
.progress
< 1.0
1478 GlDraw.color
(0.3, 0.3, 0.3);
1479 let w1 = w *. state
.progress
in
1481 GlDraw.color
(0.0, 0.0, 0.0);
1482 rect (float x0+.w1) (float x0+.w-.w1)
1485 GlDraw.color
(0.0, 0.0, 0.0);
1489 GlDraw.color
(1.0, 1.0, 1.0);
1490 drawstring fstate
.fontsize
1491 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1492 (state
.winh
- hscrollh - 5) s;
1495 match state
.mode
with
1496 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1500 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1502 Printf.sprintf
"%s%s_" prefix
text
1508 | LinkNav _
-> state
.text
1513 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1515 let s1 = "(press 'e' to review error messasges)" in
1516 if nonemptystr
s then s ^
" " ^
s1 else s1
1526 let len = Queue.length state
.tilelru
in
1528 match state
.throttle
with
1531 then preloadlayout state
.y
1533 | Some
(layout, _
, _
) ->
1537 if state
.memused
<= conf
.memlimit
1542 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1543 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1544 let (_
, pw, ph
, _
) = getpagedim
n in
1547 && colorspace
= conf
.colorspace
1548 && angle
= conf
.angle
1552 let x = col*conf
.tilew
1553 and y = row*conf
.tileh
in
1554 tilevisible (Lazy.force_val
layout) n x y
1556 then Queue.push lruitem state
.tilelru
1559 wcmd "freetile %s" (~
> p
);
1560 state
.memused
<- state
.memused
- s;
1561 state
.uioh#infochanged Memused
;
1562 Hashtbl.remove state
.tilemap k
;
1570 let logcurrently = function
1571 | Idle
-> dolog
"Idle"
1572 | Loading
(l, gen
) ->
1573 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1574 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1576 "Tiling %d[%d,%d] page=%s cs=%s angle"
1577 l.pageno
col row (~
> pageopaque
)
1578 (CSTE.to_string colorspace
)
1580 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1581 angle gen conf
.angle state
.gen
1583 conf
.tilew conf
.tileh
1590 let r = Str.regexp
" " in
1591 fun s -> Str.bounded_split
r s 2;
1594 let onpagerect pageno
f =
1596 match conf
.columns
with
1597 | Cmulti
(_
, b) -> b
1599 | Csplit
(_
, b) -> b
1601 if pageno
>= 0 && pageno
< Array.length
b
1603 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1607 let gotopagexy1 pageno
x y =
1608 let _,w1,h1
,leftx
= getpagedim pageno
in
1609 let top = y /. (float h1
) in
1610 let left = x /. (float w1) in
1611 let py, w, h = getpageywh pageno
in
1612 let wh = state
.winh
- hscrollh () in
1613 let x = left *. (float w) in
1614 let x = leftx
+ state
.x + truncate
x in
1615 let wadj = wadjsb () in
1617 if x < 0 || x >= wadj + state
.winw
1621 let pdy = truncate
(top *. float h) in
1622 let y'
= py + pdy in
1623 let dy = y'
- state
.y in
1625 if x != state
.x || not
(dy > 0 && dy < wh)
1627 if conf
.presentation
1629 if abs
(py - y'
) > wh
1636 if state
.x != sx || state
.y != sy
1641 let ww = wadj + state
.winw
in
1643 and qy
= pdy / wh in
1645 and y = py + qy
* wh in
1646 let x = if -x + ww > w1 then -(w1-ww) else x
1647 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1649 if conf
.presentation
1651 if abs
(py - y'
) > wh
1661 gotoy_and_clear_text y;
1663 else gotoy_and_clear_text state
.y;
1666 let gotopagexy pageno
x y =
1667 match state
.mode
with
1668 | Birdseye
_ -> gotopage pageno
0.0
1671 | LinkNav
_ -> gotopagexy1 pageno
x y
1675 (* dolog "%S" cmds; *)
1676 let cl = splitatspace cmds
in
1678 try Scanf.sscanf
s fmt
f
1680 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1683 let addoutline outline
=
1684 match state
.currently
with
1685 | Outlining outlines
->
1686 state
.currently
<- Outlining
(outline
:: outlines
)
1687 | Idle
-> state
.currently
<- Outlining
[outline
]
1690 dolog
"invalid outlining state";
1691 logcurrently state
.currently
1695 state
.uioh#infochanged Pdim
;
1698 | "clearrects" :: [] ->
1699 state
.rects
<- state
.rects1
;
1700 G.postRedisplay "clearrects";
1702 | "continue" :: args
:: [] ->
1703 let n = scan args
"%u" (fun n -> n) in
1704 state
.pagecount
<- n;
1705 begin match state
.currently
with
1707 state
.currently
<- Idle
;
1708 state
.outlines
<- Array.of_list
(List.rev
l)
1714 let cur, cmds
= state
.geomcmds
in
1716 then failwith
"umpossible";
1718 begin match List.rev cmds
with
1720 state
.geomcmds
<- E.s, [];
1721 state
.throttle
<- None
;
1725 state
.geomcmds
<- s, List.rev rest
;
1727 if conf
.maxwait
= None
&& not
!wtmode
1728 then G.postRedisplay "continue";
1730 | "msg" :: args
:: [] ->
1733 | "vmsg" :: args
:: [] ->
1735 then showtext ' ' args
1737 | "emsg" :: args
:: [] ->
1738 Buffer.add_string state
.errmsgs args
;
1739 state
.newerrmsgs
<- true;
1740 G.postRedisplay "error message"
1742 | "progress" :: args
:: [] ->
1743 let progress, text =
1746 f, String.sub args pos
(String.length args
- pos
))
1749 state
.progress <- progress;
1750 G.postRedisplay "progress"
1752 | "firstmatch" :: args
:: [] ->
1753 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1754 scan args
"%u %d %f %f %f %f %f %f %f %f"
1755 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1756 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1758 let xoff = float (xadjsb ()) in
1762 and x3
= x3
+. xoff in
1763 let y = (getpagey
pageno) + truncate
y0 in
1766 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1768 | "match" :: args
:: [] ->
1769 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1770 scan args
"%u %d %f %f %f %f %f %f %f %f"
1771 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1772 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1774 let xoff = float (xadjsb ()) in
1778 and x3
= x3
+. xoff in
1780 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1782 | "page" :: args
:: [] ->
1783 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1784 let pageopaque = ~
< pageopaques in
1785 begin match state
.currently
with
1786 | Loading
(l, gen
) ->
1787 vlog "page %d took %f sec" l.pageno t
;
1788 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1789 begin match state
.throttle
with
1791 let preloadedpages =
1793 then preloadlayout state
.y
1798 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1799 IntSet.empty
preloadedpages
1802 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1803 if not
(IntSet.mem
pageno set)
1805 wcmd "freepage %s" (~
> opaque
);
1811 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1814 state
.currently
<- Idle
;
1817 tilepage l.pageno pageopaque state
.layout;
1819 load preloadedpages;
1820 let visible = pagevisible state
.layout l.pageno in
1823 match state
.mode
with
1824 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1825 if pageno = l.pageno
1830 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1832 if dir
> 0 then LDfirst
else LDlast
1835 findlink
pageopaque ld
1840 showlinktype (getlink
pageopaque n);
1841 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1843 | LinkNav
(Ltgendir
_)
1844 | LinkNav
(Ltexact
_)
1850 if visible && layoutready state
.layout
1852 G.postRedisplay "page";
1856 | Some
(layout, _, _) ->
1857 state
.currently
<- Idle
;
1858 tilepage l.pageno pageopaque layout;
1865 dolog
"Inconsistent loading state";
1866 logcurrently state
.currently
;
1870 | "tile" :: args
:: [] ->
1871 let (x, y, opaques
, size
, t
) =
1872 scan args
"%u %u %s %u %f"
1873 (fun x y p size t
-> (x, y, p
, size
, t
))
1875 let opaque = ~
< opaques
in
1876 begin match state
.currently
with
1877 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1878 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1881 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1883 wcmd "freetile %s" (~
> opaque);
1884 state
.currently
<- Idle
;
1888 puttileopaque l col row gen cs angle
opaque size t
;
1889 state
.memused
<- state
.memused
+ size
;
1890 state
.uioh#infochanged Memused
;
1892 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1893 opaque, size
) state
.tilelru
;
1896 match state
.throttle
with
1897 | None
-> state
.layout
1898 | Some
(layout, _, _) -> layout
1901 state
.currently
<- Idle
;
1903 && conf
.colorspace
= cs
1904 && conf
.angle
= angle
1905 && tilevisible layout l.pageno x y
1906 then conttiling l.pageno pageopaque;
1908 begin match state
.throttle
with
1910 preload state
.layout;
1912 && conf
.colorspace
= cs
1913 && conf
.angle
= angle
1914 && tilevisible state
.layout l.pageno x y
1915 && (not
!wtmode || layoutready state
.layout)
1916 then G.postRedisplay "tile nothrottle";
1918 | Some
(layout, y, _) ->
1919 let ready = layoutready layout in
1923 state
.layout <- layout;
1924 state
.throttle
<- None
;
1925 G.postRedisplay "throttle";
1934 dolog
"Inconsistent tiling state";
1935 logcurrently state
.currently
;
1939 | "pdim" :: args
:: [] ->
1940 let (n, w, h, _) as pdim
=
1941 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1944 match conf
.fitmodel
with
1946 | FitPage
| FitProportional
->
1947 match conf
.columns
with
1948 | Csplit
_ -> (n, w, h, 0)
1949 | Csingle
_ | Cmulti
_ -> pdim
1951 state
.uioh#infochanged Pdim
;
1952 state
.pdims
<- pdim :: state
.pdims
1954 | "o" :: args
:: [] ->
1955 let (l, n, t
, h, pos
) =
1956 scan args
"%u %u %d %u %n"
1957 (fun l n t
h pos
-> l, n, t
, h, pos
)
1959 let s = String.sub args pos
(String.length args
- pos
) in
1960 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1962 | "ou" :: args
:: [] ->
1963 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1964 let s = String.sub args pos
len in
1965 let pos2 = pos
+ len + 1 in
1966 let uri = String.sub args
pos2 (String.length args
- pos2) in
1967 addoutline (s, l, Ouri
uri)
1969 | "on" :: args
:: [] ->
1970 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1971 let s = String.sub args pos
(String.length args
- pos
) in
1972 addoutline (s, l, Onone
)
1974 | "a" :: args
:: [] ->
1976 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1978 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1980 | "info" :: args
:: [] ->
1981 let pos = nindex args '
\t'
in
1982 if pos >= 0 && String.sub args
0 pos = "Title"
1984 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1987 state
.docinfo
<- (1, args
) :: state
.docinfo
1989 | "infoend" :: [] ->
1990 state
.uioh#infochanged Docinfo
;
1991 state
.docinfo
<- List.rev state
.docinfo
1994 error
"unknown cmd `%S'" cmds
1999 let action = function
2000 | HCprev
-> cbget cb ~
-1
2001 | HCnext
-> cbget cb
1
2002 | HCfirst
-> cbget cb ~
-(cb
.rc)
2003 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2004 and cancel
() = cb
.rc <- rc
2008 let search pattern forward
=
2009 match conf
.columns
with
2011 showtext '
!'
"searching does not work properly in split columns mode"
2014 if nonemptystr pattern
2017 match state
.layout with
2020 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2022 wcmd "search %d %d %d %d,%s\000"
2023 (btod conf
.icase
) pn py (btod forward
) pattern
;
2026 let intentry text key =
2028 if key >= 32 && key < 127
2034 let text = addchar text c in
2038 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2042 let linknentry text key =
2044 if key >= 32 && key < 127
2050 let text = addchar text c in
2054 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2062 let l = String.length
s in
2063 let rec loop pos n = if pos = l then n else
2064 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2065 loop (pos+1) (n*26 + m)
2068 let rec loop n = function
2071 match getopaque l.pageno with
2072 | None
-> loop n rest
2074 let m = getlinkcount
opaque in
2077 let under = getlink
opaque n in
2080 else loop (n-m) rest
2082 loop n state
.layout;
2086 let textentry text key =
2087 if key land 0xff00 = 0xff00
2089 else TEcont
(text ^ toutf8
key)
2092 let reqlayout angle fitmodel
=
2093 match state
.throttle
with
2095 if nogeomcmds state
.geomcmds
2096 then state
.anchor <- getanchor
();
2097 conf
.angle
<- angle
mod 360;
2100 match state
.mode
with
2101 | LinkNav
_ -> state
.mode
<- View
2106 conf
.fitmodel
<- fitmodel
;
2107 invalidate "reqlayout"
2109 wcmd "reqlayout %d %d %d"
2110 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2115 let settrim trimmargins trimfuzz
=
2116 if nogeomcmds state
.geomcmds
2117 then state
.anchor <- getanchor
();
2118 conf
.trimmargins
<- trimmargins
;
2119 conf
.trimfuzz
<- trimfuzz
;
2120 let x0, y0, x1, y1 = trimfuzz
in
2121 invalidate "settrim"
2123 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2128 match state
.throttle
with
2130 let zoom = max
0.0001 zoom in
2131 if zoom <> conf
.zoom
2133 state
.prevzoom
<- (conf
.zoom, state
.x);
2135 reshape state
.winw state
.winh
;
2136 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2139 | Some
(layout, y, started
) ->
2141 match conf
.maxwait
with
2145 let dt = now
() -. started
in
2153 let setcolumns mode columns coverA coverB
=
2154 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2158 then showtext '
!'
"split mode doesn't work in bird's eye"
2160 conf
.columns
<- Csplit
(-columns
, E.a);
2168 conf
.columns
<- Csingle
E.a;
2173 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2177 reshape state
.winw state
.winh
;
2180 let resetmstate () =
2181 state
.mstate
<- Mnone
;
2182 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2185 let enterbirdseye () =
2186 let zoom = float conf
.thumbw
/. float state
.winw
in
2187 let birdseyepageno =
2188 let cy = state
.winh
/ 2 in
2192 let rec fold best
= function
2195 let d = cy - (l.pagedispy + l.pagevh/2)
2196 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2197 if abs
d < abs dbest
2204 state
.mode
<- Birdseye
(
2205 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2209 conf
.presentation
<- false;
2210 conf
.interpagespace
<- 10;
2211 conf
.hlinks
<- false;
2212 conf
.fitmodel
<- FitPage
;
2214 conf
.maxwait
<- None
;
2216 match conf
.beyecolumns
with
2219 Cmulti
((c, 0, 0), E.a)
2220 | None
-> Csingle
E.a
2224 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2229 reshape state
.winw state
.winh
;
2232 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2234 conf
.zoom <- c.zoom;
2235 conf
.presentation
<- c.presentation
;
2236 conf
.interpagespace
<- c.interpagespace
;
2237 conf
.maxwait
<- c.maxwait
;
2238 conf
.hlinks
<- c.hlinks
;
2239 conf
.fitmodel
<- c.fitmodel
;
2240 conf
.beyecolumns
<- (
2241 match conf
.columns
with
2242 | Cmulti
((c, _, _), _) -> Some
c
2244 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2247 match c.columns
with
2248 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2249 | Csingle
_ -> Csingle
E.a
2250 | Csplit
(c, _) -> Csplit
(c, E.a)
2254 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2257 reshape state
.winw state
.winh
;
2258 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2262 let togglebirdseye () =
2263 match state
.mode
with
2264 | Birdseye vals
-> leavebirdseye vals
true
2265 | View
-> enterbirdseye ()
2270 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2271 let pageno = max
0 (pageno - incr
) in
2272 let rec loop = function
2273 | [] -> gotopage1 pageno 0
2274 | l :: _ when l.pageno = pageno ->
2275 if l.pagedispy >= 0 && l.pagey = 0
2276 then G.postRedisplay "upbirdseye"
2277 else gotopage1 pageno 0
2278 | _ :: rest
-> loop rest
2282 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2285 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2286 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2287 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2288 let rec loop = function
2290 let y, h = getpageyh
pageno in
2291 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2293 | l :: _ when l.pageno = pageno ->
2294 if l.pagevh != l.pageh
2295 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2296 else G.postRedisplay "downbirdseye"
2297 | _ :: rest
-> loop rest
2303 let boundastep h step
=
2305 then bound step ~
-h 0
2309 let optentry mode
_ key =
2310 let btos b = if b then "on" else "off" in
2311 if key >= 32 && key < 127
2313 let c = Char.chr
key in
2317 try conf
.scrollstep
<- int_of_string
s with exc
->
2318 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2320 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2325 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2326 if state
.autoscroll
<> None
2327 then state
.autoscroll
<- Some conf
.autoscrollstep
2329 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2331 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2336 let n, a, b = multicolumns_of_string
s in
2337 setcolumns mode
n a b;
2339 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2341 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2346 let zoom = float (int_of_string
s) /. 100.0 in
2349 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2351 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2356 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2358 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2359 begin match mode
with
2361 leavebirdseye beye
false;
2368 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2370 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2375 Some
(int_of_string
s)
2377 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2381 | Some angle
-> reqlayout angle conf
.fitmodel
2384 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2387 conf
.icase
<- not conf
.icase
;
2388 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2391 conf
.preload <- not conf
.preload;
2393 TEdone
("preload " ^
(btos conf
.preload))
2396 conf
.verbose
<- not conf
.verbose
;
2397 TEdone
("verbose " ^
(btos conf
.verbose
))
2400 conf
.debug
<- not conf
.debug
;
2401 TEdone
("debug " ^
(btos conf
.debug
))
2404 conf
.maxhfit
<- not conf
.maxhfit
;
2405 state
.maxy
<- calcheight
();
2406 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2409 conf
.crophack
<- not conf
.crophack
;
2410 TEdone
("crophack " ^
btos conf
.crophack
)
2414 match conf
.maxwait
with
2416 conf
.maxwait
<- Some infinity
;
2417 "always wait for page to complete"
2419 conf
.maxwait
<- None
;
2420 "show placeholder if page is not ready"
2425 conf
.underinfo
<- not conf
.underinfo
;
2426 TEdone
("underinfo " ^
btos conf
.underinfo
)
2429 conf
.savebmarks
<- not conf
.savebmarks
;
2430 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2436 match state
.layout with
2441 conf
.interpagespace
<- int_of_string
s;
2442 docolumns conf
.columns
;
2443 state
.maxy
<- calcheight
();
2444 let y = getpagey
pageno in
2447 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2449 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2453 match conf
.fitmodel
with
2454 | FitProportional
-> FitWidth
2455 | FitWidth
| FitPage
-> FitProportional
2457 reqlayout conf
.angle
fm;
2458 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2461 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2462 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2465 conf
.invert
<- not conf
.invert
;
2466 TEdone
("invert colors " ^
btos conf
.invert
)
2470 cbput state
.hists
.sel
s;
2473 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2474 textentry, ondone, true)
2478 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2479 else conf
.pax
<- None
;
2480 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2483 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2489 class type lvsource
= object
2490 method getitemcount
: int
2491 method getitem
: int -> (string * int)
2492 method hasaction
: int -> bool
2500 method getactive
: int
2501 method getfirst
: int
2503 method getminfo
: (int * int) array
2506 class virtual lvsourcebase
= object
2507 val mutable m_active
= 0
2508 val mutable m_first
= 0
2509 val mutable m_pan
= 0
2510 method getactive
= m_active
2511 method getfirst
= m_first
2512 method getpan
= m_pan
2513 method getminfo
: (int * int) array
= E.a
2516 let withoutlastutf8 s =
2517 let len = String.length
s in
2525 let b = Char.code
s.[pos] in
2526 if b land 0b11000000 = 0b11000000
2531 if Char.code
s.[len-1] land 0x80 = 0
2535 String.sub
s 0 first;
2538 let textentrykeyboard
2539 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2541 if key >= 0xffb0 && key <= 0xffb9
2542 then key - 0xffb0 + 48 else key
2545 state
.mode
<- Textentry
(te
, onleave
);
2548 G.postRedisplay "textentrykeyboard enttext";
2550 let histaction cmd
=
2553 | Some
(action, _) ->
2554 state
.mode
<- Textentry
(
2555 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2557 G.postRedisplay "textentry histaction"
2561 if emptystr
text && cancelonempty
2564 G.postRedisplay "textentrykeyboard after cancel";
2567 let s = withoutlastutf8 text in
2568 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2570 | @enter
| @kpenter
->
2573 G.postRedisplay "textentrykeyboard after confirm"
2575 | @up
| @kpup
-> histaction HCprev
2576 | @down
| @kpdown
-> histaction HCnext
2577 | @home
| @kphome
-> histaction HCfirst
2578 | @jend
| @kpend
-> histaction HClast
2583 begin match opthist
with
2585 | Some
(_, onhistcancel
) -> onhistcancel
()
2589 G.postRedisplay "textentrykeyboard after cancel2"
2592 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2595 | @delete
| @kpdelete
-> ()
2598 && key land 0xff00 != 0xff00 (* keyboard *)
2599 && key land 0xfe00 != 0xfe00 (* xkb *)
2600 && key land 0xfd00 != 0xfd00 (* 3270 *)
2602 begin match onkey
text key with
2606 G.postRedisplay "textentrykeyboard after confirm2";
2609 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2613 G.postRedisplay "textentrykeyboard after cancel3"
2616 state
.mode
<- Textentry
(te
, onleave
);
2617 G.postRedisplay "textentrykeyboard switch";
2621 vlog "unhandled key %s" (Wsi.keyname
key)
2624 let firstof first active
=
2625 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2626 then max
0 (active
- (fstate
.maxrows
/2))
2630 let calcfirst first active
=
2633 let rows = active
- first in
2634 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2638 let scrollph y maxy
=
2639 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2640 let sh = float state
.winh
/. sh in
2641 let sh = max
sh (float conf
.scrollh
) in
2643 let percent = float y /. float maxy
in
2644 let position = (float state
.winh
-. sh) *. percent in
2647 if position +. sh > float state
.winh
2648 then float state
.winh
-. sh
2654 let coe s = (s :> uioh
);;
2656 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2658 val m_pan
= source#getpan
2659 val m_first
= source#getfirst
2660 val m_active
= source#getactive
2662 val m_prev_uioh
= state
.uioh
2664 method private elemunder
y =
2668 let n = y / (fstate
.fontsize
+1) in
2669 if m_first
+ n < source#getitemcount
2671 if source#hasaction
(m_first
+ n)
2672 then Some
(m_first
+ n)
2679 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2680 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2681 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2682 GlDraw.color
(1., 1., 1.);
2683 Gl.enable `texture_2d
;
2684 let fs = fstate
.fontsize
in
2686 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2687 let ww = fstate
.wwidth
in
2688 let tabw = 17.0*.ww in
2689 let itemcount = source#getitemcount
in
2690 let minfo = source#getminfo
in
2693 then float (xadjsb ()), float (state
.winw
- 1)
2694 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2696 let xadj = xadjsb () in
2698 if (row - m_first
) > fstate
.maxrows
2701 if row >= 0 && row < itemcount
2703 let (s, level
) = source#getitem
row in
2704 let y = (row - m_first
) * nfs in
2706 (if conf
.leftscroll
then float xadj else 5.0)
2707 +. (float (level
+ m_pan
)) *. ww in
2710 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2714 Gl.disable `texture_2d
;
2715 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2716 GlDraw.color
(1., 1., 1.) ~
alpha;
2717 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2718 Gl.enable `texture_2d
;
2721 if zebra
&& row land 1 = 1
2725 GlDraw.color
(c,c,c);
2726 let drawtabularstring s =
2728 let x'
= truncate
(x0 +. x) in
2729 let pos = nindex
s '
\000'
in
2731 then drawstring1 fs x'
(y+nfs) s
2733 let s1 = String.sub
s 0 pos
2734 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2739 let s'
= withoutlastutf8 s in
2740 let s = s' ^
"@Uellipsis" in
2741 let w = measurestr
fs s in
2742 if float x'
+. w +. ww < float (hw + x'
)
2747 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2751 ignore
(drawstring1 fs x'
(y+nfs) s1);
2752 drawstring1 fs (hw + x'
) (y+nfs) s2
2756 let x = if helpmode
&& row > 0 then x +. ww else x in
2757 let tabpos = nindex
s '
\t'
in
2760 let len = String.length
s - tabpos - 1 in
2761 let s1 = String.sub
s 0 tabpos
2762 and s2
= String.sub
s (tabpos + 1) len in
2763 let nx = drawstr x s1 in
2765 let x = x +. (max
tabw sw) in
2768 let len = String.length
s - 2 in
2769 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2771 let s = String.sub
s 2 len in
2772 let x = if not helpmode
then x +. ww else x in
2773 GlDraw.color
(1.2, 1.2, 1.2);
2774 let vinc = drawstring1 (fs+fs/4)
2775 (truncate
(x -. ww)) (y+nfs) s in
2776 GlDraw.color
(1., 1., 1.);
2777 vinc +. (float fs *. 0.8)
2783 ignore
(drawtabularstring s);
2789 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2790 let xadj = float (xadjsb () + 5) in
2792 if (row - m_first
) > fstate
.maxrows
2795 if row >= 0 && row < itemcount
2797 let (s, level
) = source#getitem
row in
2798 let pos0 = nindex
s '
\000'
in
2799 let y = (row - m_first
) * nfs in
2800 let x = float (level
+ m_pan
) *. ww in
2801 let (first, last
) = minfo.(row) in
2803 if pos0 > 0 && first > pos0
2804 then String.sub
s (pos0+1) (first-pos0-1)
2805 else String.sub
s 0 first
2807 let suffix = String.sub
s first (last
- first) in
2808 let w1 = measurestr fstate
.fontsize
prefix in
2809 let w2 = measurestr fstate
.fontsize
suffix in
2810 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2811 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2813 and y0 = float (y+2) in
2815 and y1 = float (y+fs+3) in
2816 filledrect x0 y0 x1 y1;
2821 Gl.disable `texture_2d
;
2822 if Array.length
minfo > 0 then loop m_first
;
2825 method updownlevel incr
=
2826 let len = source#getitemcount
in
2828 if m_active
>= 0 && m_active
< len
2829 then snd
(source#getitem m_active
)
2833 if i
= len then i
-1 else if i
= -1 then 0 else
2834 let _, l = source#getitem i
in
2835 if l != curlevel then i
else flow (i
+incr
)
2837 let active = flow m_active
in
2838 let first = calcfirst m_first
active in
2839 G.postRedisplay "outline updownlevel";
2840 {< m_active
= active; m_first
= first >}
2842 method private key1
key mask
=
2843 let set1 active first qsearch
=
2844 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2846 let search active pattern incr
=
2847 let active = if active = -1 then m_first
else active in
2850 if n >= 0 && n < source#getitemcount
2852 let s, _ = source#getitem
n in
2854 (try ignore
(Str.search_forward
re s 0); true
2855 with Not_found
-> false)
2857 else loop (n + incr
)
2864 let re = Str.regexp_case_fold pattern
in
2870 let itemcount = source#getitemcount
in
2871 let find start incr
=
2873 if i
= -1 || i
= itemcount
2876 if source#hasaction i
2878 else find (i
+ incr
)
2883 let set active first =
2884 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2886 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2889 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2891 let incr1 = if incr
> 0 then 1 else -1 in
2892 if isvisible m_first m_active
2895 let next = m_active
+ incr
in
2897 if next < 0 || next >= itemcount
2899 else find next incr1
2901 if abs
(m_active
- next) > fstate
.maxrows
2907 let first = m_first
+ incr
in
2908 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2910 let next = m_active
+ incr
in
2911 let next = bound
next 0 (itemcount - 1) in
2918 if isvisible first next
2925 let first = min
next m_first
in
2927 if abs
(next - first) > fstate
.maxrows
2933 let first = m_first
+ incr
in
2934 let first = bound
first 0 (itemcount - 1) in
2936 let next = m_active
+ incr
in
2937 let next = bound
next 0 (itemcount - 1) in
2938 let next = find next incr1 in
2940 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2942 let active = if m_active
= -1 then next else m_active
in
2947 if isvisible first active
2953 G.postRedisplay "listview navigate";
2957 | (@r|@s) when Wsi.withctrl mask
->
2958 let incr = if key = @r then -1 else 1 in
2960 match search (m_active
+ incr) m_qsearch
incr with
2962 state
.text <- m_qsearch ^
" [not found]";
2965 state
.text <- m_qsearch
;
2966 active, firstof m_first
active
2968 G.postRedisplay "listview ctrl-r/s";
2969 set1 active first m_qsearch
;
2971 | @insert
when Wsi.withctrl mask
->
2972 if m_active
>= 0 && m_active
< source#getitemcount
2974 let s, _ = source#getitem m_active
in
2980 if emptystr m_qsearch
2983 let qsearch = withoutlastutf8 m_qsearch
in
2987 G.postRedisplay "listview empty qsearch";
2988 set1 m_active m_first
E.s;
2992 match search m_active
qsearch ~
-1 with
2994 state
.text <- qsearch ^
" [not found]";
2997 state
.text <- qsearch;
2998 active, firstof m_first
active
3000 G.postRedisplay "listview backspace qsearch";
3001 set1 active first qsearch
3004 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3005 let pattern = m_qsearch ^ toutf8
key in
3007 match search m_active
pattern 1 with
3009 state
.text <- pattern ^
" [not found]";
3012 state
.text <- pattern;
3013 active, firstof m_first
active
3015 G.postRedisplay "listview qsearch add";
3016 set1 active first pattern;
3020 if emptystr m_qsearch
3022 G.postRedisplay "list view escape";
3025 source#exit ~uioh
:(coe self
)
3026 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3028 | None
-> m_prev_uioh
3033 G.postRedisplay "list view kill qsearch";
3034 coe {< m_qsearch
= E.s >}
3037 | @enter
| @kpenter
->
3039 let self = {< m_qsearch
= E.s >} in
3041 G.postRedisplay "listview enter";
3042 if m_active
>= 0 && m_active
< source#getitemcount
3044 source#exit ~uioh
:(coe self) ~cancel
:false
3045 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3048 source#exit ~uioh
:(coe self) ~cancel
:true
3049 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3052 begin match opt with
3053 | None
-> m_prev_uioh
3057 | @delete
| @kpdelete
->
3060 | @up
| @kpup
-> navigate ~
-1
3061 | @down
| @kpdown
-> navigate 1
3062 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3063 | @next | @kpnext
-> navigate fstate
.maxrows
3065 | @right
| @kpright
->
3067 G.postRedisplay "listview right";
3068 coe {< m_pan
= m_pan
- 1 >}
3070 | @left | @kpleft
->
3072 G.postRedisplay "listview left";
3073 coe {< m_pan
= m_pan
+ 1 >}
3075 | @home
| @kphome
->
3076 let active = find 0 1 in
3077 G.postRedisplay "listview home";
3081 let first = max
0 (itemcount - fstate
.maxrows
) in
3082 let active = find (itemcount - 1) ~
-1 in
3083 G.postRedisplay "listview end";
3086 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3090 dolog
"listview unknown key %#x" key; coe self
3092 method key key mask
=
3093 match state
.mode
with
3094 | Textentry te
-> textentrykeyboard key mask te
; coe self
3097 | LinkNav
_ -> self#key1
key mask
3099 method button button down
x y _ =
3102 | 1 when x > state
.winw
- conf
.scrollbw
->
3103 G.postRedisplay "listview scroll";
3106 let _, position, sh = self#
scrollph in
3107 if y > truncate
position && y < truncate
(position +. sh)
3109 state
.mstate
<- Mscrolly
;
3113 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3114 let first = truncate
(s *. float source#getitemcount
) in
3115 let first = min source#getitemcount
first in
3116 Some
(coe {< m_first
= first; m_active
= first >})
3118 state
.mstate
<- Mnone
;
3122 begin match self#elemunder
y with
3124 G.postRedisplay "listview click";
3125 source#exit ~uioh
:(coe {< m_active
= n >})
3126 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3130 | n when (n == 4 || n == 5) && not down
->
3131 let len = source#getitemcount
in
3133 if n = 5 && m_first
+ fstate
.maxrows
>= len
3137 let first = m_first
+ (if n == 4 then -1 else 1) in
3138 bound
first 0 (len - 1)
3140 G.postRedisplay "listview wheel";
3141 Some
(coe {< m_first
= first >})
3142 | n when (n = 6 || n = 7) && not down
->
3143 let inc = if n = 7 then -1 else 1 in
3144 G.postRedisplay "listview hwheel";
3145 Some
(coe {< m_pan
= m_pan
+ inc >})
3150 | None
-> m_prev_uioh
3153 method multiclick
_ x y = self#button
1 true x y
3156 match state
.mstate
with
3158 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3159 let first = truncate
(s *. float source#getitemcount
) in
3160 let first = min source#getitemcount
first in
3161 G.postRedisplay "listview motion";
3162 coe {< m_first
= first; m_active
= first >}
3170 method pmotion
x y =
3171 if x < state
.winw
- conf
.scrollbw
3174 match self#elemunder
y with
3175 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3176 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3180 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3185 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3189 method infochanged
_ = ()
3191 method scrollpw
= (0, 0.0, 0.0)
3193 let nfs = fstate
.fontsize
+ 1 in
3194 let y = m_first
* nfs in
3195 let itemcount = source#getitemcount
in
3196 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3197 let maxy = maxi * nfs in
3198 let p, h = scrollph y maxy in
3201 method modehash
= modehash
3202 method eformsgs
= false
3203 method alwaysscrolly
= true
3206 class outlinelistview ~zebra ~source
=
3207 let settext autonarrow
s =
3210 let ss = source#statestr
in
3214 else "{" ^
ss ^
"} [" ^
s ^
"]"
3215 else state
.text <- s
3221 ~source
:(source
:> lvsource
)
3223 ~modehash
:(findkeyhash conf
"outline")
3226 val m_autonarrow
= false
3228 method! key key mask
=
3230 if emptystr state
.text
3232 else fstate
.maxrows - 2
3234 let calcfirst first active =
3237 let rows = active - first in
3238 if rows > maxrows then active - maxrows else first
3242 let active = m_active
+ incr in
3243 let active = bound
active 0 (source#getitemcount
- 1) in
3244 let first = calcfirst m_first
active in
3245 G.postRedisplay "outline navigate";
3246 coe {< m_active
= active; m_first
= first >}
3248 let navscroll first =
3250 let dist = m_active
- first in
3256 else first + maxrows
3259 G.postRedisplay "outline navscroll";
3260 coe {< m_first
= first; m_active
= active >}
3262 let ctrl = Wsi.withctrl mask
in
3267 then (source#denarrow
; E.s)
3269 let pattern = source#renarrow
in
3270 if nonemptystr m_qsearch
3271 then (source#narrow m_qsearch
; m_qsearch
)
3275 settext (not m_autonarrow
) text;
3276 G.postRedisplay "toggle auto narrowing";
3277 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3279 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3281 G.postRedisplay "toggle auto narrowing";
3282 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3285 source#narrow m_qsearch
;
3287 then source#add_narrow_pattern m_qsearch
;
3288 G.postRedisplay "outline ctrl-n";
3289 coe {< m_first
= 0; m_active
= 0 >}
3292 let active = source#calcactive
(getanchor
()) in
3293 let first = firstof m_first
active in
3294 G.postRedisplay "outline ctrl-s";
3295 coe {< m_first
= first; m_active
= active >}
3298 G.postRedisplay "outline ctrl-u";
3299 if m_autonarrow
&& nonemptystr m_qsearch
3301 ignore
(source#renarrow
);
3302 settext m_autonarrow
E.s;
3303 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3306 source#del_narrow_pattern
;
3307 let pattern = source#renarrow
in
3309 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3311 settext m_autonarrow
text;
3312 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3316 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3317 G.postRedisplay "outline ctrl-l";
3318 coe {< m_first
= first >}
3320 | @tab
when m_autonarrow
->
3321 if nonemptystr m_qsearch
3323 G.postRedisplay "outline list view tab";
3324 source#add_narrow_pattern m_qsearch
;
3326 coe {< m_qsearch
= E.s >}
3330 | @escape
when m_autonarrow
->
3331 if nonemptystr m_qsearch
3332 then source#add_narrow_pattern m_qsearch
;
3335 | @enter
| @kpenter
when m_autonarrow
->
3336 if nonemptystr m_qsearch
3337 then source#add_narrow_pattern m_qsearch
;
3340 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3341 let pattern = m_qsearch ^ toutf8
key in
3342 G.postRedisplay "outlinelistview autonarrow add";
3343 source#narrow
pattern;
3344 settext true pattern;
3345 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3347 | key when m_autonarrow
&& key = @backspace
->
3348 if emptystr m_qsearch
3351 let pattern = withoutlastutf8 m_qsearch
in
3352 G.postRedisplay "outlinelistview autonarrow backspace";
3353 ignore
(source#renarrow
);
3354 source#narrow
pattern;
3355 settext true pattern;
3356 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3358 | @delete
| @kpdelete
->
3359 source#remove m_active
;
3360 G.postRedisplay "outline delete";
3361 let active = max
0 (m_active
-1) in
3362 coe {< m_first
= firstof m_first
active;
3363 m_active
= active >}
3365 | @up
| @kpup
when ctrl ->
3366 navscroll (max
0 (m_first
- 1))
3368 | @down
| @kpdown
when ctrl ->
3369 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3371 | @up
| @kpup
-> navigate ~
-1
3372 | @down
| @kpdown
-> navigate 1
3373 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3374 | @next | @kpnext
-> navigate fstate
.maxrows
3376 | @right
| @kpright
->
3380 G.postRedisplay "outline ctrl right";
3381 {< m_pan
= m_pan
+ 1 >}
3383 else self#updownlevel
1
3387 | @left | @kpleft
->
3391 G.postRedisplay "outline ctrl left";
3392 {< m_pan
= m_pan
- 1 >}
3394 else self#updownlevel ~
-1
3398 | @home
| @kphome
->
3399 G.postRedisplay "outline home";
3400 coe {< m_first
= 0; m_active
= 0 >}
3403 let active = source#getitemcount
- 1 in
3404 let first = max
0 (active - fstate
.maxrows) in
3405 G.postRedisplay "outline end";
3406 coe {< m_active
= active; m_first
= first >}
3408 | _ -> super#
key key mask
3411 let genhistoutlines =
3412 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3414 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3415 | `path
-> compare p2 p1
3416 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3418 let e1 = emptystr c1
.title
3419 and e2
= emptystr c2
.title
in
3421 then compare
(Filename.basename p2
) (Filename.basename p1
)
3424 else compare c1
.title c2
.title
3426 let showfullpath = ref false in
3429 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3430 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3432 let list = ref [] in
3433 if Config.gethist
list
3437 (fun accu (path
, c, b, x, a) ->
3438 let hist = (path
, (c, b, x, a)) in
3439 let s = if !showfullpath then path
else Filename.basename path
in
3440 let base = mbtoutf8
s in
3441 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3443 [ setorty "Sort by time of last visit" `lastvisit
;
3444 setorty "Sort by file name" `file
;
3445 setorty "Sort by path" `path
;
3446 setorty "Sort by title" `title
;
3447 (if !showfullpath then "@Uradical "
3448 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3449 showfullpath := not
!showfullpath; reeenterhist := true)
3450 ] (List.sort
(order orderty
) !list)
3456 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3457 Config.save
leavebirdseye;
3458 state
.anchor <- anchor;
3460 state
.bookmarks
<- bookmarks
;
3461 state
.origin
<- E.s;
3463 let x0, y0, x1, y1 = conf
.trimfuzz
in
3464 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3468 let makecheckers () =
3469 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3471 converted by Issac Trotts. July 25, 2002 *)
3472 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3473 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3474 let id = GlTex.gen_texture
() in
3475 GlTex.bind_texture ~target
:`texture_2d
id;
3476 GlPix.store
(`unpack_alignment
1);
3477 GlTex.image2d
image;
3478 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3479 [ `mag_filter `nearest
; `min_filter `nearest
];
3483 let setcheckers enabled
=
3484 match state
.checkerstexid
with
3486 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3488 | Some checkerstexid
->
3491 GlTex.delete_texture checkerstexid
;
3492 state
.checkerstexid
<- None
;
3496 let describe_location () =
3497 let fn = page_of_y state
.y in
3498 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3499 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3503 else (100. *. (float state
.y /. float maxy))
3507 Printf.sprintf
"page %d of %d [%.2f%%]"
3508 (fn+1) state
.pagecount
percent
3511 "pages %d-%d of %d [%.2f%%]"
3512 (fn+1) (ln+1) state
.pagecount
percent
3515 let setpresentationmode v
=
3516 let n = page_of_y state
.y in
3517 state
.anchor <- (n, 0.0, 1.0);
3518 conf
.presentation
<- v
;
3519 if conf
.fitmodel
= FitPage
3520 then reqlayout conf
.angle conf
.fitmodel
;
3525 let btos b = if b then "@Uradical" else E.s in
3526 let showextended = ref false in
3527 let leave mode
_ = state
.mode
<- mode
in
3530 val mutable m_first_time
= true
3531 val mutable m_l
= []
3532 val mutable m_a
= E.a
3533 val mutable m_prev_uioh
= nouioh
3534 val mutable m_prev_mode
= View
3536 inherit lvsourcebase
3538 method reset prev_mode prev_uioh
=
3539 m_a
<- Array.of_list
(List.rev m_l
);
3541 m_prev_mode
<- prev_mode
;
3542 m_prev_uioh
<- prev_uioh
;
3546 if n >= Array.length m_a
3550 | _, _, _, Action
_ -> m_active
<- n
3551 | _, _, _, Noaction
-> loop (n+1)
3554 m_first_time
<- false;
3557 method int name get
set =
3559 (name
, `
int get
, 1, Action
(
3562 try set (int_of_string
s)
3564 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3568 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3569 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3573 method int_with_suffix name get
set =
3575 (name
, `intws get
, 1, Action
(
3578 try set (int_of_string_with_suffix
s)
3580 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3585 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3587 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3591 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3593 (name
, `
bool (btos, get
), offset
, Action
(
3600 method color name get
set =
3602 (name
, `color get
, 1, Action
(
3604 let invalid = (nan
, nan
, nan
) in
3607 try color_of_string
s
3609 state
.text <- Printf.sprintf
"bad color `%s': %s"
3616 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3617 state
.text <- color_to_string
(get
());
3618 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3622 method string name get
set =
3624 (name
, `
string get
, 1, Action
(
3626 let ondone s = set s in
3627 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3628 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3632 method colorspace name get
set =
3634 (name
, `
string get
, 1, Action
(
3638 inherit lvsourcebase
3641 m_active
<- CSTE.to_int conf
.colorspace
;
3644 method getitemcount
=
3645 Array.length
CSTE.names
3648 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3649 ignore
(uioh
, first, pan
);
3650 if not cancel
then set active;
3652 method hasaction
_ = true
3656 let modehash = findkeyhash conf
"info" in
3657 coe (new listview ~zebra
:false ~helpmode
:false
3658 ~
source ~trusted
:true ~
modehash)
3661 method paxmark name get
set =
3663 (name
, `
string get
, 1, Action
(
3667 inherit lvsourcebase
3670 m_active
<- MTE.to_int conf
.paxmark
;
3673 method getitemcount
= Array.length
MTE.names
3674 method getitem
n = (MTE.names
.(n), 0)
3675 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3676 ignore
(uioh
, first, pan
);
3677 if not cancel
then set active;
3679 method hasaction
_ = true
3683 let modehash = findkeyhash conf
"info" in
3684 coe (new listview ~zebra
:false ~helpmode
:false
3685 ~
source ~trusted
:true ~
modehash)
3688 method fitmodel name get
set =
3690 (name
, `
string get
, 1, Action
(
3694 inherit lvsourcebase
3697 m_active
<- FMTE.to_int conf
.fitmodel
;
3700 method getitemcount
= Array.length
FMTE.names
3701 method getitem
n = (FMTE.names
.(n), 0)
3702 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3703 ignore
(uioh
, first, pan
);
3704 if not cancel
then set active;
3706 method hasaction
_ = true
3710 let modehash = findkeyhash conf
"info" in
3711 coe (new listview ~zebra
:false ~helpmode
:false
3712 ~
source ~trusted
:true ~
modehash)
3715 method caption
s offset
=
3716 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3718 method caption2
s f offset
=
3719 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3721 method getitemcount
= Array.length m_a
3724 let tostr = function
3725 | `
int f -> string_of_int
(f ())
3726 | `intws
f -> string_with_suffix_of_int
(f ())
3728 | `color
f -> color_to_string
(f ())
3729 | `
bool (btos, f) -> btos (f ())
3732 let name, t
, offset
, _ = m_a
.(n) in
3733 ((let s = tostr t
in
3735 then Printf.sprintf
"%s\t%s" name s
3739 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3744 match m_a
.(active) with
3745 | _, _, _, Action
f -> f uioh
3746 | _, _, _, Noaction
-> uioh
3757 method hasaction
n =
3759 | _, _, _, Action
_ -> true
3760 | _, _, _, Noaction
-> false
3763 let rec fillsrc prevmode prevuioh
=
3764 let sep () = src#caption
E.s 0 in
3765 let colorp name get
set =
3767 (fun () -> color_to_string
(get
()))
3770 let c = color_of_string
v in
3773 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3776 let oldmode = state
.mode
in
3777 let birdseye = isbirdseye state
.mode
in
3779 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3781 src#
bool "presentation mode"
3782 (fun () -> conf
.presentation
)
3783 (fun v -> setpresentationmode v);
3785 src#
bool "ignore case in searches"
3786 (fun () -> conf
.icase
)
3787 (fun v -> conf
.icase
<- v);
3790 (fun () -> conf
.preload)
3791 (fun v -> conf
.preload <- v);
3793 src#
bool "highlight links"
3794 (fun () -> conf
.hlinks
)
3795 (fun v -> conf
.hlinks
<- v);
3797 src#
bool "under info"
3798 (fun () -> conf
.underinfo
)
3799 (fun v -> conf
.underinfo
<- v);
3801 src#
bool "persistent bookmarks"
3802 (fun () -> conf
.savebmarks
)
3803 (fun v -> conf
.savebmarks
<- v);
3805 src#fitmodel
"fit model"
3806 (fun () -> FMTE.to_string conf
.fitmodel
)
3807 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3809 src#
bool "trim margins"
3810 (fun () -> conf
.trimmargins
)
3811 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3813 src#
bool "persistent location"
3814 (fun () -> conf
.jumpback
)
3815 (fun v -> conf
.jumpback
<- v);
3818 src#
int "inter-page space"
3819 (fun () -> conf
.interpagespace
)
3821 conf
.interpagespace
<- n;
3822 docolumns conf
.columns
;
3824 match state
.layout with
3829 state
.maxy <- calcheight
();
3830 let y = getpagey
pageno in
3835 (fun () -> conf
.pagebias
)
3836 (fun v -> conf
.pagebias
<- v);
3838 src#
int "scroll step"
3839 (fun () -> conf
.scrollstep
)
3840 (fun n -> conf
.scrollstep
<- n);
3842 src#
int "horizontal scroll step"
3843 (fun () -> conf
.hscrollstep
)
3844 (fun v -> conf
.hscrollstep
<- v);
3846 src#
int "auto scroll step"
3848 match state
.autoscroll
with
3850 | _ -> conf
.autoscrollstep
)
3852 let n = boundastep state
.winh
n in
3853 if state
.autoscroll
<> None
3854 then state
.autoscroll
<- Some
n;
3855 conf
.autoscrollstep
<- n);
3858 (fun () -> truncate
(conf
.zoom *. 100.))
3859 (fun v -> setzoom ((float v) /. 100.));
3862 (fun () -> conf
.angle
)
3863 (fun v -> reqlayout v conf
.fitmodel
);
3865 src#
int "scroll bar width"
3866 (fun () -> conf
.scrollbw
)
3869 reshape state
.winw state
.winh
;
3872 src#
int "scroll handle height"
3873 (fun () -> conf
.scrollh
)
3874 (fun v -> conf
.scrollh
<- v;);
3876 src#
int "thumbnail width"
3877 (fun () -> conf
.thumbw
)
3879 conf
.thumbw
<- min
4096 v;
3882 leavebirdseye beye
false;
3889 let mode = state
.mode in
3890 src#
string "columns"
3892 match conf
.columns
with
3894 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3895 | Csplit
(count
, _) -> "-" ^ string_of_int count
3898 let n, a, b = multicolumns_of_string
v in
3899 setcolumns mode n a b);
3902 src#caption
"Pixmap cache" 0;
3903 src#int_with_suffix
"size (advisory)"
3904 (fun () -> conf
.memlimit
)
3905 (fun v -> conf
.memlimit
<- v);
3908 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3909 (string_with_suffix_of_int state
.memused
)
3910 (Hashtbl.length state
.tilemap
)) 1;
3913 src#caption
"Layout" 0;
3914 src#caption2
"Dimension"
3916 Printf.sprintf
"%dx%d (virtual %dx%d)"
3917 state
.winw state
.winh
3922 src#caption2
"Position" (fun () ->
3923 Printf.sprintf
"%dx%d" state
.x state
.y
3926 src#caption2
"Position" (fun () -> describe_location ()) 1
3930 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3931 "Save these parameters as global defaults at exit"
3932 (fun () -> conf
.bedefault
)
3933 (fun v -> conf
.bedefault
<- v)
3937 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3938 src#
bool ~offset
:0 ~
btos "Extended parameters"
3939 (fun () -> !showextended)
3940 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3944 (fun () -> conf
.checkers
)
3945 (fun v -> conf
.checkers
<- v; setcheckers v);
3946 src#
bool "update cursor"
3947 (fun () -> conf
.updatecurs
)
3948 (fun v -> conf
.updatecurs
<- v);
3949 src#
bool "scroll-bar on the left"
3950 (fun () -> conf
.leftscroll
)
3951 (fun v -> conf
.leftscroll
<- v);
3953 (fun () -> conf
.verbose
)
3954 (fun v -> conf
.verbose
<- v);
3955 src#
bool "invert colors"
3956 (fun () -> conf
.invert
)
3957 (fun v -> conf
.invert
<- v);
3959 (fun () -> conf
.maxhfit
)
3960 (fun v -> conf
.maxhfit
<- v);
3961 src#
bool "redirect stderr"
3962 (fun () -> conf
.redirectstderr)
3963 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3965 (fun () -> conf
.pax
!= None
)
3968 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3969 else conf
.pax
<- None
);
3970 src#
string "uri launcher"
3971 (fun () -> conf
.urilauncher
)
3972 (fun v -> conf
.urilauncher
<- v);
3973 src#
string "path launcher"
3974 (fun () -> conf
.pathlauncher
)
3975 (fun v -> conf
.pathlauncher
<- v);
3976 src#
string "tile size"
3977 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3980 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3981 conf
.tilew
<- max
64 w;
3982 conf
.tileh
<- max
64 h;
3985 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3988 src#
int "texture count"
3989 (fun () -> conf
.texcount
)
3992 then conf
.texcount
<- v
3993 else showtext '
!'
" Failed to set texture count please retry later"
3995 src#
int "slice height"
3996 (fun () -> conf
.sliceheight
)
3998 conf
.sliceheight
<- v;
3999 wcmd "sliceh %d" conf
.sliceheight
;
4001 src#
int "anti-aliasing level"
4002 (fun () -> conf
.aalevel
)
4004 conf
.aalevel
<- bound
v 0 8;
4005 state
.anchor <- getanchor
();
4006 opendoc state
.path state
.password
;
4008 src#
string "page scroll scaling factor"
4009 (fun () -> string_of_float conf
.pgscale)
4012 let s = float_of_string
v in
4015 state
.text <- Printf.sprintf
4016 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4019 src#
int "ui font size"
4020 (fun () -> fstate
.fontsize
)
4021 (fun v -> setfontsize (bound
v 5 100));
4022 src#
int "hint font size"
4023 (fun () -> conf
.hfsize
)
4024 (fun v -> conf
.hfsize
<- bound
v 5 100);
4025 colorp "background color"
4026 (fun () -> conf
.bgcolor
)
4027 (fun v -> conf
.bgcolor
<- v);
4028 src#
bool "crop hack"
4029 (fun () -> conf
.crophack
)
4030 (fun v -> conf
.crophack
<- v);
4031 src#
string "trim fuzz"
4032 (fun () -> irect_to_string conf
.trimfuzz
)
4035 conf
.trimfuzz
<- irect_of_string
v;
4037 then settrim true conf
.trimfuzz
;
4039 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4041 src#
string "throttle"
4043 match conf
.maxwait
with
4044 | None
-> "show place holder if page is not ready"
4047 then "wait for page to fully render"
4049 "wait " ^ string_of_float
time
4050 ^
" seconds before showing placeholder"
4054 let f = float_of_string
v in
4056 then conf
.maxwait
<- None
4057 else conf
.maxwait
<- Some
f
4059 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4061 src#
string "ghyll scroll"
4063 match conf
.ghyllscroll
with
4065 | Some nab
-> ghyllscroll_to_string nab
4068 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4070 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4072 src#
string "selection command"
4073 (fun () -> conf
.selcmd
)
4074 (fun v -> conf
.selcmd
<- v);
4075 src#
string "synctex command"
4076 (fun () -> conf
.stcmd
)
4077 (fun v -> conf
.stcmd
<- v);
4078 src#
string "pax command"
4079 (fun () -> conf
.paxcmd
)
4080 (fun v -> conf
.paxcmd
<- v);
4081 src#colorspace
"color space"
4082 (fun () -> CSTE.to_string conf
.colorspace
)
4084 conf
.colorspace
<- CSTE.of_int
v;
4088 src#paxmark
"pax mark method"
4089 (fun () -> MTE.to_string conf
.paxmark
)
4090 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4094 (fun () -> conf
.usepbo
)
4095 (fun v -> conf
.usepbo
<- v);
4096 src#
bool "mouse wheel scrolls pages"
4097 (fun () -> conf
.wheelbypage
)
4098 (fun v -> conf
.wheelbypage
<- v);
4099 src#
bool "open remote links in a new instance"
4100 (fun () -> conf
.riani
)
4101 (fun v -> conf
.riani
<- v);
4105 src#caption
"Document" 0;
4106 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4107 src#caption2
"Pages"
4108 (fun () -> string_of_int state
.pagecount
) 1;
4109 src#caption2
"Dimensions"
4110 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4114 src#caption
"Trimmed margins" 0;
4115 src#caption2
"Dimensions"
4116 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4120 src#caption
"OpenGL" 0;
4121 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4122 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4125 src#caption
"Location" 0;
4126 if nonemptystr state
.origin
4127 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4128 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4130 src#reset prevmode prevuioh
;
4135 let prevmode = state
.mode
4136 and prevuioh
= state
.uioh in
4137 fillsrc prevmode prevuioh
;
4138 let source = (src :> lvsource
) in
4139 let modehash = findkeyhash conf
"info" in
4140 state
.uioh <- coe (object (self)
4141 inherit listview ~zebra
:false ~helpmode
:false
4142 ~
source ~trusted
:true ~
modehash as super
4143 val mutable m_prevmemused
= 0
4144 method! infochanged
= function
4146 if m_prevmemused
!= state
.memused
4148 m_prevmemused
<- state
.memused
;
4149 G.postRedisplay "memusedchanged";
4151 | Pdim
-> G.postRedisplay "pdimchanged"
4152 | Docinfo
-> fillsrc prevmode prevuioh
4154 method! key key mask
=
4155 if not
(Wsi.withctrl mask
)
4158 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4159 | @right
| @kpright
-> coe (self#updownlevel
1)
4160 | _ -> super#
key key mask
4161 else super#
key key mask
4163 G.postRedisplay "info";
4169 inherit lvsourcebase
4170 method getitemcount
= Array.length state
.help
4172 let s, l, _ = state
.help
.(n) in
4175 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4179 match state
.help
.(active) with
4180 | _, _, Action
f -> Some
(f uioh)
4181 | _, _, Noaction
-> Some
uioh
4190 method hasaction
n =
4191 match state
.help
.(n) with
4192 | _, _, Action
_ -> true
4193 | _, _, Noaction
-> false
4199 let modehash = findkeyhash conf
"help" in
4201 state
.uioh <- coe (new listview
4202 ~zebra
:false ~helpmode
:true
4203 ~
source ~trusted
:true ~
modehash);
4204 G.postRedisplay "help";
4209 let re = Str.regexp
"[\r\n]" in
4211 inherit lvsourcebase
4212 val mutable m_items
= E.a
4214 method getitemcount
= 1 + Array.length m_items
4219 else m_items
.(n-1), 0
4221 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4226 then Buffer.clear state
.errmsgs
;
4233 method hasaction
n =
4237 state
.newerrmsgs
<- false;
4238 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4239 m_items
<- Array.of_list
l
4248 let source = (msgsource :> lvsource
) in
4249 let modehash = findkeyhash conf
"listview" in
4250 state
.uioh <- coe (object
4251 inherit listview ~zebra
:false ~helpmode
:false
4252 ~
source ~trusted
:false ~
modehash as super
4255 then msgsource#reset
;
4258 G.postRedisplay "msgs";
4261 let enterannotmode =
4264 inherit lvsourcebase
4265 val mutable m_text
= E.s
4266 val mutable m_items
= E.a
4268 method getitemcount
= 1 + Array.length m_items
4271 if n = Array.length m_items
4272 then "[Copy text to the clipboard]", 0
4275 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4276 ignore
(uioh, first, pan
);
4277 if not cancel
&& active = 0
4278 then selstring m_text
;
4281 method hasaction
_ = true
4284 let rec split accu b i
=
4286 if p = String.length
s
4287 then String.sub
s b (p-b) :: accu
4289 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4291 let ss = if i
= 0 then E.s else String.sub
s b i
in
4292 split (ss::accu) (p+1) 0
4297 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4306 let source = (msgsource :> lvsource
) in
4307 let modehash = findkeyhash conf
"listview" in
4308 state
.uioh <- coe (object
4309 inherit listview ~zebra
:false ~helpmode
:false
4310 ~
source ~trusted
:false ~
modehash
4312 G.postRedisplay "annot";
4315 let gotounder under =
4316 let getpath filename
=
4318 if nonemptystr filename
4320 if Filename.is_relative filename
4322 let dir = Filename.dirname state
.path in
4324 if Filename.is_implicit
dir
4325 then Filename.concat
(Sys.getcwd
()) dir
4328 Filename.concat
dir filename
4332 if Sys.file_exists
path
4337 | Ulinkgoto
(pageno, top) ->
4341 gotopage1 pageno top;
4347 | Uremote
(filename
, pageno) ->
4348 let path = getpath filename
in
4353 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4354 try popen
command []
4356 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4359 let anchor = getanchor
() in
4360 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
4361 state
.origin
<- E.s;
4362 state
.anchor <- (pageno, 0.0, 0.0);
4363 state
.ranchors
<- ranchor :: state
.ranchors
;
4366 else showtext '
!'
("Could not find " ^ filename
)
4368 | Uremotedest
(filename
, destname
) ->
4369 let path = getpath filename
in
4374 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4375 try popen
command []
4378 "failed to execute `%s': %s\n" command (exntos exn
);
4381 let anchor = getanchor
() in
4382 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
4383 state
.origin
<- E.s;
4384 state
.nameddest
<- destname
;
4385 state
.ranchors
<- ranchor :: state
.ranchors
;
4388 else showtext '
!'
("Could not find " ^ filename
)
4390 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4391 | Uannotation annot
-> enterannotmode annot
4394 let gotooutline (_, _, kind
) =
4398 let (pageno, y, _) = anchor in
4400 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4404 | Ouri
uri -> gotounder (Ulinkuri
uri)
4405 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4406 | Oremote remote
-> gotounder (Uremote remote
)
4407 | Ohistory
hist -> gotohist hist
4408 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4412 let outlinesource sourcetype
=
4414 inherit lvsourcebase
4415 val mutable m_items
= E.a
4416 val mutable m_minfo
= E.a
4417 val mutable m_orig_items
= E.a
4418 val mutable m_orig_minfo
= E.a
4419 val mutable m_narrow_patterns
= []
4420 val mutable m_hadremovals
= false
4421 val mutable m_gen
= -1
4423 method getitemcount
=
4424 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4427 if n == Array.length m_items
&& m_hadremovals
4429 ("[Confirm removal]", 0)
4431 let s, n, _ = m_items
.(n) in
4434 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4435 ignore
(uioh, first);
4436 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4438 if m_narrow_patterns
= []
4439 then m_orig_items
, m_orig_minfo
4440 else m_items
, m_minfo
4444 if not
confrimremoval
4446 gotooutline m_items
.(active);
4451 state
.bookmarks
<- Array.to_list m_items
;
4452 m_orig_items
<- m_items
;
4453 m_orig_minfo
<- m_minfo
;
4463 method hasaction
_ = true
4466 if Array.length m_items
!= Array.length m_orig_items
4469 match m_narrow_patterns
with
4471 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4473 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4477 match m_narrow_patterns
with
4480 | head
:: _ -> "@Uellipsis" ^ head
4482 method narrow
pattern =
4483 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4487 let rec loop accu minfo n =
4490 m_items
<- Array.of_list
accu;
4491 m_minfo
<- Array.of_list
minfo;
4494 let (s, _, t
) as o = m_items
.(n) in
4497 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4498 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4499 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4501 try Str.search_forward
re s 0
4502 with Not_found
-> -1
4505 then o :: accu, (first, Str.match_end
()) :: minfo
4508 loop accu minfo (n-1)
4510 loop [] [] (Array.length m_items
- 1)
4512 method! getminfo
= m_minfo
4516 match sourcetype
with
4517 | `bookmarks
-> Array.of_list state
.bookmarks
4518 | `outlines
-> state
.outlines
4519 | `history
-> genhistoutlines !Config.historder
4521 m_minfo
<- m_orig_minfo
;
4522 m_items
<- m_orig_items
4525 if sourcetype
= `bookmarks
4527 if m >= 0 && m < Array.length m_items
4529 m_hadremovals
<- true;
4530 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4531 let n = if n >= m then n+1 else n in
4536 method add_narrow_pattern
pattern =
4537 m_narrow_patterns
<- pattern :: m_narrow_patterns
4539 method del_narrow_pattern
=
4540 match m_narrow_patterns
with
4541 | _ :: rest
-> m_narrow_patterns
<- rest
4546 match m_narrow_patterns
with
4547 | pattern :: [] -> self#narrow
pattern; pattern
4549 List.fold_left
(fun accu pattern ->
4550 self#narrow
pattern;
4551 pattern ^
"@Uellipsis" ^
accu) E.s list
4553 method calcactive
anchor =
4554 let rely = getanchory anchor in
4555 let rec loop n best bestd
=
4556 if n = Array.length m_items
4559 let _, _, kind
= m_items
.(n) in
4562 let orely = getanchory anchor in
4563 let d = abs
(orely - rely) in
4566 else loop (n+1) best bestd
4567 | Onone
| Oremote
_ | Olaunch
_
4568 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4569 loop (n+1) best bestd
4573 method reset
anchor items =
4574 m_hadremovals
<- false;
4575 if state
.gen
!= m_gen
4577 m_orig_items
<- items;
4579 m_narrow_patterns
<- [];
4581 m_orig_minfo
<- E.a;
4585 if items != m_orig_items
4587 m_orig_items
<- items;
4588 if m_narrow_patterns
== []
4589 then m_items
<- items;
4592 let active = self#calcactive
anchor in
4594 m_first
<- firstof m_first
active
4598 let enterselector sourcetype
=
4600 let source = outlinesource sourcetype
in
4603 match sourcetype
with
4604 | `bookmarks
-> Array.of_list state
.bookmarks
4605 | `
outlines -> state
.outlines
4606 | `history
-> genhistoutlines !Config.historder
4608 if Array.length
outlines = 0
4610 showtext ' ' errmsg
;
4613 state
.text <- source#greetmsg
;
4614 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4615 let anchor = getanchor
() in
4616 source#reset
anchor outlines;
4618 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4619 G.postRedisplay "enter selector";
4623 let enteroutlinemode =
4624 let f = enterselector `
outlines in
4625 fun () -> f "Document has no outline";
4628 let enterbookmarkmode =
4629 let f = enterselector `bookmarks
in
4630 fun () -> f "Document has no bookmarks (yet)";
4633 let enterhistmode () = enterselector `history
"No history (yet)";;
4635 let quickbookmark ?title
() =
4636 match state
.layout with
4642 let tm = Unix.localtime
(now
()) in
4643 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4647 (tm.Unix.tm_year
+ 1900)
4650 | Some
title -> title
4652 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4655 let setautoscrollspeed step goingdown
=
4656 let incr = max
1 ((abs step
) / 2) in
4657 let incr = if goingdown
then incr else -incr in
4658 let astep = boundastep state
.winh
(step
+ incr) in
4659 state
.autoscroll
<- Some
astep;
4663 match conf
.columns
with
4665 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4668 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4670 let existsinrow pageno (columns
, coverA
, coverB
) p =
4671 let last = ((pageno - coverA
) mod columns
) + columns
in
4672 let rec any = function
4675 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4679 then (if l.pageno = last then false else any rest
)
4687 match state
.layout with
4689 let pageno = page_of_y state
.y in
4690 gotoghyll (getpagey
(pageno+1))
4692 match conf
.columns
with
4694 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4696 let y = clamp (pgscale state
.winh
) in
4699 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4700 gotoghyll (getpagey
pageno)
4701 | Cmulti
((c, _, _) as cl, _) ->
4702 if conf
.presentation
4703 && (existsinrow l.pageno cl
4704 (fun l -> l.pageh
> l.pagey + l.pagevh))
4706 let y = clamp (pgscale state
.winh
) in
4709 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4710 gotoghyll (getpagey
pageno)
4712 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4714 let pagey, pageh
= getpageyh
l.pageno in
4715 let pagey = pagey + pageh
* l.pagecol
in
4716 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4717 gotoghyll (pagey + pageh
+ ips)
4721 match state
.layout with
4723 let pageno = page_of_y state
.y in
4724 gotoghyll (getpagey
(pageno-1))
4726 match conf
.columns
with
4728 if conf
.presentation
&& l.pagey != 0
4730 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4732 let pageno = max
0 (l.pageno-1) in
4733 gotoghyll (getpagey
pageno)
4734 | Cmulti
((c, _, coverB
) as cl, _) ->
4735 if conf
.presentation
&&
4736 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4738 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4741 if l.pageno = state
.pagecount
- coverB
4745 let pageno = max
0 (l.pageno-decr) in
4746 gotoghyll (getpagey
pageno)
4754 let pageno = max
0 (l.pageno-1) in
4755 let pagey, pageh
= getpageyh
pageno in
4758 let pagey, pageh
= getpageyh
l.pageno in
4759 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4764 let viewkeyboard key mask
=
4766 let mode = state
.mode in
4767 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4770 G.postRedisplay "view:enttext"
4772 let ctrl = Wsi.withctrl mask
in
4774 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4779 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4781 state
.mode <- LinkNav
(Ltgendir
0);
4784 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4787 begin match state
.mstate
with
4790 G.postRedisplay "kill zoom rect";
4793 | Mscrolly
| Mscrollx
4796 begin match state
.mode with
4799 G.postRedisplay "esc leave linknav"
4803 match state
.ranchors
with
4805 | (path, password
, anchor, origin
) :: rest
->
4806 state
.ranchors
<- rest
;
4807 state
.anchor <- anchor;
4808 state
.origin
<- origin
;
4809 state
.nameddest
<- E.s;
4810 opendoc path password
4815 gotoghyll (getnav ~
-1)
4826 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4827 G.postRedisplay "dehighlight";
4829 | @slash
| @question
->
4830 let ondone isforw
s =
4831 cbput state
.hists
.pat
s;
4832 state
.searchpattern
<- s;
4835 let s = String.make
1 (Char.chr
key) in
4836 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4837 textentry, ondone (key = @slash
), true)
4839 | @plus
| @kpplus
| @equals
when ctrl ->
4840 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4841 setzoom (conf
.zoom +. incr)
4843 | @plus
| @kpplus
->
4846 try int_of_string
s with exc
->
4847 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4853 state
.text <- "page bias is now " ^ string_of_int
n;
4856 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4858 | @minus
| @kpminus
when ctrl ->
4859 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4860 setzoom (max
0.01 (conf
.zoom -. decr))
4862 | @minus
| @kpminus
->
4863 let ondone msg
= state
.text <- msg
in
4865 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4866 optentry state
.mode, ondone, true
4877 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4879 match conf
.columns
with
4880 | Csingle
_ | Cmulti
_ -> 1
4881 | Csplit
(n, _) -> n
4883 let h = state
.winh
-
4884 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4886 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4887 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4892 match conf
.fitmodel
with
4893 | FitWidth
-> FitProportional
4894 | FitProportional
-> FitPage
4895 | FitPage
-> FitWidth
4897 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4898 reqlayout conf
.angle
fm
4906 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4907 when not
ctrl -> (* 0..9 *)
4910 try int_of_string
s with exc
->
4911 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4917 cbput state
.hists
.pag
(string_of_int
n);
4918 gotopage1 (n + conf
.pagebias
- 1) 0;
4921 let pageentry text key =
4922 match Char.unsafe_chr
key with
4923 | '
g'
-> TEdone
text
4924 | _ -> intentry text key
4926 let text = String.make
1 (Char.chr
key) in
4927 enttext (":", text, Some
(onhist state
.hists
.pag
),
4928 pageentry, ondone, true)
4931 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4932 reshape state
.winw state
.winh
;
4935 state
.bzoom
<- not state
.bzoom
;
4937 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4940 conf
.hlinks
<- not conf
.hlinks
;
4941 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4942 G.postRedisplay "toggle highlightlinks";
4945 state
.glinks
<- true;
4946 let mode = state
.mode in
4947 state
.mode <- Textentry
(
4948 (":", E.s, None
, linknentry, linkndone gotounder, false),
4950 state
.glinks
<- false;
4954 G.postRedisplay "view:linkent(F)"
4957 state
.glinks
<- true;
4958 let mode = state
.mode in
4959 state
.mode <- Textentry
(
4961 ":", E.s, None
, linknentry, linkndone (fun under ->
4962 selstring (undertext under);
4966 state
.glinks
<- false;
4970 G.postRedisplay "view:linkent"
4973 begin match state
.autoscroll
with
4975 conf
.autoscrollstep
<- step
;
4976 state
.autoscroll
<- None
4978 if conf
.autoscrollstep
= 0
4979 then state
.autoscroll
<- Some
1
4980 else state
.autoscroll
<- Some conf
.autoscrollstep
4987 setpresentationmode (not conf
.presentation
);
4988 showtext ' '
("presentation mode " ^
4989 if conf
.presentation
then "on" else "off");
4992 if List.mem
Wsi.Fullscreen state
.winstate
4993 then Wsi.reshape conf
.cwinw conf
.cwinh
4994 else Wsi.fullscreen
()
4997 search state
.searchpattern
false
5000 search state
.searchpattern
true
5003 begin match state
.layout with
5006 gotoghyll (getpagey
l.pageno)
5012 | @delete
| @kpdelete
-> (* delete *)
5016 showtext ' '
(describe_location ());
5019 begin match state
.layout with
5022 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5027 enterbookmarkmode ()
5035 | @e when Buffer.length state
.errmsgs
> 0 ->
5040 match state
.layout with
5045 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5048 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5052 showtext ' '
"Quick bookmark added";
5055 begin match state
.layout with
5057 let rect = getpdimrect
l.pagedimno
in
5061 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5062 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5064 (truncate
(rect.(1) -. rect.(0)),
5065 truncate
(rect.(3) -. rect.(0)))
5067 let w = truncate
((float w)*.conf
.zoom)
5068 and h = truncate
((float h)*.conf
.zoom) in
5071 state
.anchor <- getanchor
();
5072 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5074 G.postRedisplay "z";
5079 | @x -> state
.roam
()
5082 reqlayout (conf
.angle
+
5083 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5087 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5089 G.postRedisplay "brightness";
5091 | @c when state
.mode = View
->
5096 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5098 gotoy_and_clear_text state
.y
5102 match state
.prevcolumns
with
5103 | None
-> (1, 0, 0), 1.0
5104 | Some
(columns
, z
) ->
5107 | Csplit
(c, _) -> -c, 0, 0
5108 | Cmulti
((c, a, b), _) -> c, a, b
5109 | Csingle
_ -> 1, 0, 0
5113 setcolumns View
c a b;
5116 | @down
| @up
when ctrl && Wsi.withshift mask
->
5117 let zoom, x = state
.prevzoom
in
5121 | @k
| @up
| @kpup
->
5122 begin match state
.autoscroll
with
5124 begin match state
.mode with
5125 | Birdseye beye
-> upbirdseye 1 beye
5130 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5132 if not
(Wsi.withshift mask
) && conf
.presentation
5134 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5138 setautoscrollspeed n false
5141 | @j
| @down
| @kpdown
->
5142 begin match state
.autoscroll
with
5144 begin match state
.mode with
5145 | Birdseye beye
-> downbirdseye 1 beye
5150 then gotoy_and_clear_text (clamp (state
.winh
/2))
5152 if not
(Wsi.withshift mask
) && conf
.presentation
5154 else gotoghyll1 true (clamp (conf
.scrollstep
))
5158 setautoscrollspeed n true
5161 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5167 else conf
.hscrollstep
5169 let dx = if key = @left || key = @kpleft
then dx else -dx in
5170 state
.x <- panbound (state
.x + dx);
5171 gotoy_and_clear_text state
.y
5174 G.postRedisplay "left/right"
5177 | @prior
| @kpprior
->
5181 match state
.layout with
5183 | l :: _ -> state
.y - l.pagey
5185 clamp (pgscale (-state
.winh
))
5189 | @next | @kpnext
->
5193 match List.rev state
.layout with
5195 | l :: _ -> getpagey
l.pageno
5197 clamp (pgscale state
.winh
)
5201 | @g | @home
| @kphome
->
5204 | @G
| @jend
| @kpend
->
5206 gotoghyll (clamp state
.maxy)
5208 | @right
| @kpright
when Wsi.withalt mask
->
5209 gotoghyll (getnav 1)
5210 | @left | @kpleft
when Wsi.withalt mask
->
5211 gotoghyll (getnav ~
-1)
5216 | @v when conf
.debug
->
5219 match getopaque l.pageno with
5222 let x0, y0, x1, y1 = pagebbox
opaque in
5223 let a,b = float x0, float y0 in
5224 let c,d = float x1, float y0 in
5225 let e,f = float x1, float y1 in
5226 let h,j
= float x0, float y1 in
5227 let rect = (a,b,c,d,e,f,h,j
) in
5229 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5231 G.postRedisplay "v";
5234 let mode = state
.mode in
5235 let cmd = ref E.s in
5236 let onleave = function
5237 | Cancel
-> state
.mode <- mode
5240 match getopaque l.pageno with
5241 | Some
opaque -> pipesel opaque !cmd
5242 | None
-> ()) state
.layout;
5246 cbput state
.hists
.sel
s;
5250 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5252 G.postRedisplay "|";
5253 state
.mode <- Textentry
(te, onleave);
5256 vlog "huh? %s" (Wsi.keyname
key)
5259 let linknavkeyboard key mask
linknav =
5260 let getpage pageno =
5261 let rec loop = function
5263 | l :: _ when l.pageno = pageno -> Some
l
5264 | _ :: rest
-> loop rest
5265 in loop state
.layout
5267 let doexact (pageno, n) =
5268 match getopaque pageno, getpage pageno with
5269 | Some
opaque, Some
l ->
5270 if key = @enter
|| key = @kpenter
5272 let under = getlink
opaque n in
5273 G.postRedisplay "link gotounder";
5280 Some
(findlink
opaque LDfirst
), -1
5283 Some
(findlink
opaque LDlast
), 1
5286 Some
(findlink
opaque (LDleft
n)), -1
5289 Some
(findlink
opaque (LDright
n)), 1
5292 Some
(findlink
opaque (LDup
n)), -1
5295 Some
(findlink
opaque (LDdown
n)), 1
5300 begin match findpwl
l.pageno dir with
5304 state
.mode <- LinkNav
(Ltgendir
dir);
5305 let y, h = getpageyh
pageno in
5308 then y + h - state
.winh
5313 begin match getopaque pageno, getpage pageno with
5314 | Some
opaque, Some
_ ->
5316 let ld = if dir > 0 then LDfirst
else LDlast
in
5319 begin match link with
5321 showlinktype (getlink
opaque m);
5322 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5323 G.postRedisplay "linknav jpage";
5324 | Lnotfound
-> notfound dir
5330 begin match opt with
5331 | Some Lnotfound
-> pwl l dir;
5332 | Some
(Lfound
m) ->
5336 let _, y0, _, y1 = getlinkrect
opaque m in
5338 then gotopage1 l.pageno y0
5340 let d = fstate
.fontsize
+ 1 in
5341 if y1 - l.pagey > l.pagevh - d
5342 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5343 else G.postRedisplay "linknav";
5345 showlinktype (getlink
opaque m);
5346 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5349 | None
-> viewkeyboard key mask
5351 | _ -> viewkeyboard key mask
5356 G.postRedisplay "leave linknav"
5360 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5361 | Ltexact exact
-> doexact exact
5364 let keyboard key mask
=
5365 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5366 then wcmd "interrupt"
5367 else state
.uioh <- state
.uioh#
key key mask
5370 let birdseyekeyboard key mask
5371 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5373 match conf
.columns
with
5375 | Cmulti
((c, _, _), _) -> c
5376 | Csplit
_ -> failwith
"bird's eye split mode"
5378 let pgh layout = List.fold_left
5379 (fun m l -> max
l.pageh
m) state
.winh
layout in
5381 | @l when Wsi.withctrl mask
->
5382 let y, h = getpageyh
pageno in
5383 let top = (state
.winh
- h) / 2 in
5384 gotoy (max
0 (y - top))
5385 | @enter
| @kpenter
-> leavebirdseye beye
false
5386 | @escape
-> leavebirdseye beye
true
5387 | @up
-> upbirdseye incr beye
5388 | @down
-> downbirdseye incr beye
5389 | @left -> upbirdseye 1 beye
5390 | @right
-> downbirdseye 1 beye
5393 begin match state
.layout with
5397 state
.mode <- Birdseye
(
5398 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5400 gotopage1 l.pageno 0;
5403 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5405 | [] -> gotoy (clamp (-state
.winh
))
5407 state
.mode <- Birdseye
(
5408 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5410 gotopage1 l.pageno 0
5413 | [] -> gotoy (clamp (-state
.winh
))
5417 begin match List.rev state
.layout with
5419 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5420 begin match layout with
5422 let incr = l.pageh
- l.pagevh in
5427 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5429 G.postRedisplay "birdseye pagedown";
5431 else gotoy (clamp (incr + conf
.interpagespace
*2));
5435 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5436 gotopage1 l.pageno 0;
5439 | [] -> gotoy (clamp state
.winh
)
5443 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5447 let pageno = state
.pagecount
- 1 in
5448 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5449 if not
(pagevisible state
.layout pageno)
5452 match List.rev state
.pdims
with
5454 | (_, _, h, _) :: _ -> h
5456 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5457 else G.postRedisplay "birdseye end";
5459 | _ -> viewkeyboard key mask
5464 match state
.mode with
5465 | Textentry
_ -> scalecolor 0.4
5467 | View
-> scalecolor 1.0
5468 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5469 if l.pageno = hooverpageno
5472 if l.pageno = pageno
5474 let c = scalecolor 1.0 in
5476 GlDraw.line_width
3.0;
5477 let dispx = xadjsb () + l.pagedispx in
5479 (float (dispx-1)) (float (l.pagedispy-1))
5480 (float (dispx+l.pagevw+1))
5481 (float (l.pagedispy+l.pagevh+1))
5483 GlDraw.line_width
1.0;
5492 let postdrawpage l linkindexbase
=
5493 match getopaque l.pageno with
5495 if tileready l l.pagex
l.pagey
5497 let x = l.pagedispx - l.pagex
+ xadjsb ()
5498 and y = l.pagedispy - l.pagey in
5500 match conf
.columns
with
5501 | Csingle
_ | Cmulti
_ ->
5502 (if conf
.hlinks
then 1 else 0)
5504 && not
(isbirdseye state
.mode) then 2 else 0)
5508 match state
.mode with
5509 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5515 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5520 let scrollindicator () =
5521 let sbw, ph
, sh = state
.uioh#
scrollph in
5522 let sbh, pw, sw = state
.uioh#scrollpw
in
5527 else ((state
.winw
- sbw), state
.winw
, 0)
5530 GlDraw.color (0.64, 0.64, 0.64);
5531 filledrect (float x0) 0. (float x1) (float state
.winh
);
5533 (float hx0
) (float (state
.winh
- sbh))
5534 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5536 GlDraw.color (0.0, 0.0, 0.0);
5538 filledrect (float x0) ph
(float x1) (ph
+. sh);
5539 let pw = pw +. float hx0
in
5540 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5544 match state
.mstate
with
5545 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5548 | Msel
((x0, y0), (x1, y1)) ->
5549 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5550 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5551 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5552 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5555 let showrects = function [] -> () | rects
->
5557 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5558 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5560 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5562 if l.pageno = pageno
5564 let dx = float (l.pagedispx - l.pagex
) in
5565 let dy = float (l.pagedispy - l.pagey) in
5566 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5567 Raw.sets_float state
.vraw ~
pos:0
5572 GlArray.vertex `two state
.vraw
;
5573 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5582 GlClear.color (scalecolor2 conf
.bgcolor
);
5583 GlClear.clear
[`
color];
5584 List.iter
drawpage state
.layout;
5586 match state
.mode with
5587 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5588 begin match getopaque pageno with
5590 let dx = xadjsb () in
5591 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5592 let x0 = x0 + dx and x1 = x1 + dx in
5599 | None
-> state
.rects
5601 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5604 | View
-> state
.rects
5607 let rec postloop linkindexbase
= function
5609 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5610 postloop linkindexbase rest
5614 postloop 0 state
.layout;
5616 begin match state
.mstate
with
5617 | Mzoomrect
((x0, y0), (x1, y1)) ->
5619 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5620 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5621 filledrect (float x0) (float y0) (float x1) (float y1);
5625 | Mscrolly
| Mscrollx
5634 let zoomrect x y x1 y1 =
5637 and y0 = min
y y1 in
5638 gotoy (state
.y + y0);
5639 state
.anchor <- getanchor
();
5640 let zoom = (float state
.w) /. float (x1 - x0) in
5643 let adjw = wadjsb () + state
.winw
in
5645 then (adjw - state
.w) / 2
5648 match conf
.fitmodel
with
5649 | FitWidth
| FitProportional
-> simple ()
5651 match conf
.columns
with
5653 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5654 | Cmulti
_ | Csingle
_ -> simple ()
5656 state
.x <- (state
.x + margin) - x0;
5662 let g opaque l px py =
5663 match rectofblock
opaque px py with
5665 let x0 = a.(0) -. 20. in
5666 let x1 = a.(1) +. 20. in
5667 let y0 = a.(2) -. 20. in
5668 let zoom = (float state
.w) /. (x1 -. x0) in
5669 let pagey = getpagey
l.pageno in
5670 gotoy_and_clear_text (pagey + truncate
y0);
5671 state
.anchor <- getanchor
();
5672 let margin = (state
.w - l.pagew
)/2 in
5673 state
.x <- -truncate
x0 - margin;
5678 match conf
.columns
with
5680 showtext '
!'
"block zooming does not work properly in split columns mode"
5681 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5685 let winw = wadjsb () + state
.winw - 1 in
5686 let s = float x /. float winw in
5687 let destx = truncate
(float (state
.w + winw) *. s) in
5688 state
.x <- winw - destx;
5689 gotoy_and_clear_text state
.y;
5690 state
.mstate
<- Mscrollx
;
5694 let s = float y /. float state
.winh
in
5695 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5696 gotoy_and_clear_text desty;
5697 state
.mstate
<- Mscrolly
;
5700 let viewmulticlick clicks
x y mask
=
5701 let g opaque l px py =
5709 if markunder
opaque px py mark
5713 match getopaque l.pageno with
5715 | Some
opaque -> pipesel opaque cmd
5717 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5718 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5723 G.postRedisplay "viewmulticlick";
5724 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5728 match conf
.columns
with
5730 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5733 let viewmouse button down
x y mask
=
5735 | n when (n == 4 || n == 5) && not down
->
5736 if Wsi.withctrl mask
5738 match state
.mstate
with
5739 | Mzoom
(oldn
, i
) ->
5747 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5749 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5751 let zoom = conf
.zoom -. incr in
5753 state
.mstate
<- Mzoom
(n, 0);
5755 state
.mstate
<- Mzoom
(n, i
+1);
5757 else state
.mstate
<- Mzoom
(n, 0)
5761 | Mscrolly
| Mscrollx
5763 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5766 match state
.autoscroll
with
5767 | Some step
-> setautoscrollspeed step
(n=4)
5769 if conf
.wheelbypage
|| conf
.presentation
5778 then -conf
.scrollstep
5779 else conf
.scrollstep
5781 let incr = incr * 2 in
5782 let y = clamp incr in
5783 gotoy_and_clear_text y
5786 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5788 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5789 gotoy_and_clear_text state
.y
5791 | 1 when Wsi.withshift mask
->
5792 state
.mstate
<- Mnone
;
5795 match unproject x y with
5796 | Some
(pageno, ux
, uy
) ->
5797 let cmd = Printf.sprintf
5799 conf
.stcmd state
.path pageno ux uy
5805 | 1 when Wsi.withctrl mask
->
5808 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5809 state
.mstate
<- Mpan
(x, y)
5812 state
.mstate
<- Mnone
5817 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5819 state
.mstate
<- Mzoomrect
(p, p)
5822 match state
.mstate
with
5823 | Mzoomrect
((x0, y0), _) ->
5824 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5825 then zoomrect x0 y0 x y
5828 G.postRedisplay "kill accidental zoom rect";
5832 | Mscrolly
| Mscrollx
5838 | 1 when x > state
.winw - vscrollw () ->
5841 let _, position, sh = state
.uioh#
scrollph in
5842 if y > truncate
position && y < truncate
(position +. sh)
5843 then state
.mstate
<- Mscrolly
5846 state
.mstate
<- Mnone
5848 | 1 when y > state
.winh
- hscrollh () ->
5851 let _, position, sw = state
.uioh#scrollpw
in
5852 if x > truncate
position && x < truncate
(position +. sw)
5853 then state
.mstate
<- Mscrollx
5856 state
.mstate
<- Mnone
5858 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5861 let dest = if down
then getunder x y else Unone
in
5862 begin match dest with
5865 | Uremote
_ | Uremotedest
_
5866 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5869 | Unone
when down
->
5870 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5871 state
.mstate
<- Mpan
(x, y);
5873 | Uannotation contents
-> enterannotmode contents
5875 | Unone
| Utext
_ ->
5880 state
.mstate
<- Msel
((x, y), (x, y));
5881 G.postRedisplay "mouse select";
5885 match state
.mstate
with
5888 | Mzoom
_ | Mscrollx
| Mscrolly
->
5889 state
.mstate
<- Mnone
5891 | Mzoomrect
((x0, y0), _) ->
5895 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5896 state
.mstate
<- Mnone
5898 | Msel
((x0, y0), (x1, y1)) ->
5899 let rec loop = function
5903 let a0 = l.pagedispy in
5904 let a1 = a0 + l.pagevh in
5905 let b0 = l.pagedispx in
5906 let b1 = b0 + l.pagevw in
5907 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5908 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5912 match getopaque l.pageno with
5915 match Unix.pipe
() with
5919 "can not create sel pipe: %s"
5923 Ne.clo fd
(fun msg
->
5924 dolog
"%s close failed: %s" what msg
)
5927 try popen
cmd [r, 0; w, -1]; true
5929 dolog
"can not execute %S: %s"
5936 G.postRedisplay "copysel";
5938 else clo "Msel pipe/w" w;
5939 clo "Msel pipe/r" r;
5941 dosel conf
.selcmd
();
5942 state
.roam
<- dosel conf
.paxcmd
;
5954 let birdseyemouse button down
x y mask
5955 (conf
, leftx
, _, hooverpageno
, anchor) =
5958 let rec loop = function
5961 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5962 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5964 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5970 | _ -> viewmouse button down
x y mask
5976 method key key mask
=
5977 begin match state
.mode with
5978 | Textentry
textentry -> textentrykeyboard key mask
textentry
5979 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5980 | View
-> viewkeyboard key mask
5981 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5985 method button button bstate
x y mask
=
5986 begin match state
.mode with
5988 | View
-> viewmouse button bstate
x y mask
5989 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5994 method multiclick clicks
x y mask
=
5995 begin match state
.mode with
5997 | View
-> viewmulticlick clicks
x y mask
6004 begin match state
.mode with
6006 | View
| Birdseye
_ | LinkNav
_ ->
6007 match state
.mstate
with
6008 | Mzoom
_ | Mnone
-> ()
6013 state
.mstate
<- Mpan
(x, y);
6015 then state
.x <- panbound (state
.x + dx);
6017 gotoy_and_clear_text y
6020 state
.mstate
<- Msel
(a, (x, y));
6021 G.postRedisplay "motion select";
6024 let y = min state
.winh
(max
0 y) in
6028 let x = min state
.winw (max
0 x) in
6031 | Mzoomrect
(p0
, _) ->
6032 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6033 G.postRedisplay "motion zoomrect";
6037 method pmotion
x y =
6038 begin match state
.mode with
6039 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6040 let rec loop = function
6042 if hooverpageno
!= -1
6044 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6045 G.postRedisplay "pmotion birdseye no hoover";
6048 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6049 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6051 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6052 G.postRedisplay "pmotion birdseye hoover";
6062 match state
.mstate
with
6063 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
6072 let past, _, _ = !r in
6074 let delta = now -. past in
6077 else r := (now, x, y)
6081 method infochanged
_ = ()
6084 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6087 then 0.0, float state
.winh
6088 else scrollph state
.y maxy
6093 let winw = wadjsb () + state
.winw in
6094 let fwinw = float winw in
6096 let sw = fwinw /. float state
.w in
6097 let sw = fwinw *. sw in
6098 max
sw (float conf
.scrollh
)
6101 let maxx = state
.w + winw in
6102 let x = winw - state
.x in
6103 let percent = float x /. float maxx in
6104 (fwinw -. sw) *. percent
6106 hscrollh (), position, sw
6110 match state
.mode with
6111 | LinkNav
_ -> "links"
6112 | Textentry
_ -> "textentry"
6113 | Birdseye
_ -> "birdseye"
6116 findkeyhash conf
modename
6118 method eformsgs
= true
6119 method alwaysscrolly
= false
6122 let adderrmsg src msg
=
6123 Buffer.add_string state
.errmsgs msg
;
6124 state
.newerrmsgs
<- true;
6128 let adderrfmt src fmt
=
6129 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6133 let cl = splitatspace cmds
in
6135 try Scanf.sscanf
s fmt
f
6137 adderrfmt "remote exec"
6138 "error processing '%S': %s\n" cmds
(exntos exn
)
6141 | "reload" :: [] -> reload ()
6142 | "goto" :: args
:: [] ->
6143 scan args
"%u %f %f"
6145 let cmd, _ = state
.geomcmds
in
6147 then gotopagexy pageno x y
6150 gotopagexy pageno x y;
6153 state
.reprf
<- f state
.reprf
6155 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6156 | "gotor" :: args
:: [] ->
6158 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6159 | "gotord" :: args
:: [] ->
6161 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6162 | "rect" :: args
:: [] ->
6163 scan args
"%u %u %f %f %f %f"
6164 (fun pageno color x0 y0 x1 y1 ->
6165 onpagerect pageno (fun w h ->
6166 let _,w1,h1
,_ = getpagedim
pageno in
6167 let sw = float w1 /. float w
6168 and sh = float h1
/. float h in
6172 and y1s
= y1 *. sh in
6173 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6175 state
.rects <- (pageno, color, rect) :: state
.rects;
6176 G.postRedisplay "rect";
6179 | "activatewin" :: [] -> Wsi.activatewin
()
6180 | "quit" :: [] -> raise Quit
6182 adderrfmt "remote command"
6183 "error processing remote command: %S\n" cmds
;
6187 let scratch = Bytes.create
80 in
6188 let buf = Buffer.create
80 in
6191 try Some
(Unix.read fd
scratch 0 80)
6193 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6194 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6197 match tempfr () with
6203 if Buffer.length
buf > 0
6205 let s = Buffer.contents
buf in
6215 let pos = Bytes.index_from
scratch ppos '
\n'
in
6216 if pos >= n then -1 else pos
6217 with Not_found
-> -1
6221 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6222 let s = Buffer.contents
buf in
6228 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6234 let remoteopen path =
6235 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6237 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6242 let gcconfig = ref E.s in
6243 let trimcachepath = ref E.s in
6244 let rcmdpath = ref E.s in
6245 let pageno = ref None
in
6246 let rootwid = ref 0 in
6247 let openlast = ref false in
6248 let nofc = ref false in
6249 selfexec := Sys.executable_name
;
6252 [("-p", Arg.String
(fun s -> state
.password
<- s),
6253 "<password> Set password");
6257 Config.fontpath
:= s;
6258 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6260 "<path> Set path to the user interface font");
6264 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6265 Config.confpath
:= s),
6266 "<path> Set path to the configuration file");
6268 ("-last", Arg.Set
openlast, " Open last document");
6270 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6271 "<page-number> Jump to page");
6273 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6274 "<path> Set path to the trim cache file");
6276 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6277 "<named-destination> Set named destination");
6279 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6280 ("-cxack", Arg.Set
cxack, " Cut corners");
6282 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6283 "<path> Set path to the remote commands source");
6285 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6286 "<original-path> Set original path");
6288 ("-gc", Arg.Set_string
gcconfig,
6289 "<script-path> Collect garbage with the help of a script");
6291 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6293 ("-v", Arg.Unit
(fun () ->
6295 "%s\nconfiguration path: %s\n"
6299 exit
0), " Print version and exit");
6301 ("-embed", Arg.Set_int
rootwid,
6302 "<window-id> Embed into window")
6305 (fun s -> state
.path <- s)
6306 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6309 then selfexec := !selfexec ^
" -wtmode";
6311 let histmode = emptystr state
.path && not
!openlast in
6313 if not
(Config.load !openlast)
6314 then prerr_endline
"failed to load configuration";
6315 begin match !pageno with
6316 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6320 if not
(emptystr
!gcconfig)
6323 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6325 error
"gc socketpair failed: %s" (exntos exn
)
6328 match popen
!gcconfig [(c, 0); (c, 1)] with
6333 error
"failed to popen gc script: %s" (exntos exn
);
6336 let wsfd, winw, winh
= Wsi.init
(object (self)
6337 val mutable m_clicks
= 0
6338 val mutable m_click_x
= 0
6339 val mutable m_click_y
= 0
6340 val mutable m_lastclicktime
= infinity
6342 method private cleanup
=
6343 state
.roam
<- noroam
;
6344 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6345 method expose
= G.postRedisplay"expose"
6349 | Wsi.Unobscured
-> "unobscured"
6350 | Wsi.PartiallyObscured
-> "partiallyobscured"
6351 | Wsi.FullyObscured
-> "fullyobscured"
6353 vlog "visibility change %s" name
6354 method display = display ()
6355 method map mapped
= vlog "mappped %b" mapped
6356 method reshape w h =
6359 method mouse
b d x y m =
6360 if d && canselect ()
6362 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6368 if abs
x - m_click_x
> 10
6369 || abs
y - m_click_y
> 10
6370 || abs_float
(t -. m_lastclicktime
) > 0.3
6372 m_clicks
<- m_clicks
+ 1;
6373 m_lastclicktime
<- t;
6377 G.postRedisplay "cleanup";
6378 state
.uioh <- state
.uioh#button
b d x y m;
6380 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6385 m_lastclicktime
<- infinity
;
6386 state
.uioh <- state
.uioh#button
b d x y m
6390 state
.uioh <- state
.uioh#button
b d x y m
6393 state
.mpos
<- (x, y);
6394 state
.uioh <- state
.uioh#motion
x y
6395 method pmotion
x y =
6396 state
.mpos
<- (x, y);
6397 state
.uioh <- state
.uioh#pmotion
x y
6399 let mascm = m land (
6400 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6403 let x = state
.x and y = state
.y in
6405 if x != state
.x || y != state
.y then self#cleanup
6407 match state
.keystate
with
6409 let km = k
, mascm in
6412 let modehash = state
.uioh#
modehash in
6413 try Hashtbl.find modehash km
6415 try Hashtbl.find (findkeyhash conf
"global") km
6416 with Not_found
-> KMinsrt
(k
, m)
6418 | KMinsrt
(k
, m) -> keyboard k
m
6419 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6420 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6422 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6423 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6424 state
.keystate
<- KSnone
6425 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6426 state
.keystate
<- KSinto
(keys
, insrt
)
6427 | KSinto
_ -> state
.keystate
<- KSnone
6430 state
.mpos
<- (x, y);
6431 state
.uioh <- state
.uioh#pmotion
x y
6432 method leave = state
.mpos
<- (-1, -1)
6433 method winstate wsl
= state
.winstate
<- wsl
6434 method quit
= raise Quit
6435 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6440 List.exists
GlMisc.check_extension
6441 [ "GL_ARB_texture_rectangle"
6442 ; "GL_EXT_texture_recangle"
6443 ; "GL_NV_texture_rectangle" ]
6445 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6448 let r = GlMisc.get_string `renderer
in
6449 let p = "Mesa DRI Intel(" in
6450 let l = String.length
p in
6451 String.length
r > l && String.sub
r 0 l = p
6454 defconf
.sliceheight
<- 1024;
6455 defconf
.texcount
<- 32;
6456 defconf
.usepbo
<- true;
6460 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6462 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6470 setcheckers conf
.checkers
;
6472 if conf
.redirectstderr
6476 (Buffer.to_bytes state
.errmsgs
)
6477 (match state
.errfd
with
6479 let s = Bytes.create
(80*24) in
6482 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6484 then Unix.read fd
s 0 (Bytes.length
s)
6490 else Bytes.sub
s 0 n
6494 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6495 with exn
-> print_endline
(exntos exn
)
6500 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6501 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6502 !Config.fontpath
, !trimcachepath,
6503 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6506 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6512 Wsi.settitle
"llpp (history)";
6516 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6517 opendoc state
.path state
.password
;
6522 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6525 if nonemptystr
!rcmdpath
6526 then remoteopen !rcmdpath
6531 let rec loop deadline
=
6533 match state
.errfd
with
6534 | None
-> [state
.ss; state
.wsfd]
6535 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6540 | Some fd
-> fd
:: r
6544 state
.redisplay
<- false;
6551 if deadline
= infinity
6553 else max
0.0 (deadline
-. now)
6558 try Unix.select
r [] [] timeout
6559 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6565 if state
.ghyll
== noghyll
6567 match state
.autoscroll
with
6568 | Some step
when step
!= 0 ->
6569 let y = state
.y + step
in
6573 else if y >= state
.maxy then 0 else y
6576 if state
.mode = View
6577 then state
.text <- E.s;
6580 else deadline
+. 0.01
6585 let rec checkfds = function
6587 | fd
:: rest
when fd
= state
.ss ->
6588 let cmd = readcmd state
.ss in
6592 | fd
:: rest
when fd
= state
.wsfd ->
6596 | fd
:: rest
when Some fd
= !optrfd ->
6597 begin match remote fd
with
6598 | None
-> optrfd := remoteopen !rcmdpath;
6599 | opt -> optrfd := opt
6604 let s = Bytes.create
80 in
6605 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6606 if conf
.redirectstderr
6608 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6609 state
.newerrmsgs
<- true;
6610 state
.redisplay
<- true;
6613 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6619 if !reeenterhist then (
6621 reeenterhist := false;
6625 if deadline
= infinity
6629 match state
.autoscroll
with
6630 | Some step
when step
!= 0 -> deadline1
6631 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6639 Config.save
leavebirdseye;