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
1674 let getpassword () =
1675 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1679 match Unix.open_process_in
passcmd with
1680 | (exception exn
) ->
1681 showtext '
!'
(Printf.sprintf
"open_process_in failed: %s" (exntos exn
));
1684 let s = try input_line ic
1685 with End_of_file
-> E.s in
1686 begin try ignore
(Unix.close_process_in ic
);
1687 with Unix.Unix_error
(Unix.ECHILD
, _, _) -> vlog "ECHILD"
1693 (* dolog "%S" cmds; *)
1694 let cl = splitatspace cmds
in
1696 try Scanf.sscanf
s fmt
f
1698 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1701 let addoutline outline
=
1702 match state
.currently
with
1703 | Outlining outlines
->
1704 state
.currently
<- Outlining
(outline
:: outlines
)
1705 | Idle
-> state
.currently
<- Outlining
[outline
]
1708 dolog
"invalid outlining state";
1709 logcurrently state
.currently
1713 state
.uioh#infochanged Pdim
;
1716 | "clearrects" :: [] ->
1717 state
.rects
<- state
.rects1
;
1718 G.postRedisplay "clearrects";
1720 | "continue" :: args
:: [] ->
1721 let n = scan args
"%u" (fun n -> n) in
1722 state
.pagecount
<- n;
1723 begin match state
.currently
with
1725 state
.currently
<- Idle
;
1726 state
.outlines
<- Array.of_list
(List.rev
l)
1732 let cur, cmds
= state
.geomcmds
in
1734 then failwith
"umpossible";
1736 begin match List.rev cmds
with
1738 state
.geomcmds
<- E.s, [];
1739 state
.throttle
<- None
;
1743 state
.geomcmds
<- s, List.rev rest
;
1745 if conf
.maxwait
= None
&& not
!wtmode
1746 then G.postRedisplay "continue";
1748 | "msg" :: args
:: [] ->
1751 | "vmsg" :: args
:: [] ->
1753 then showtext ' ' args
1755 | "emsg" :: args
:: [] ->
1756 Buffer.add_string state
.errmsgs args
;
1757 state
.newerrmsgs
<- true;
1758 G.postRedisplay "error message"
1760 | "progress" :: args
:: [] ->
1761 let progress, text =
1764 f, String.sub args pos
(String.length args
- pos
))
1767 state
.progress <- progress;
1768 G.postRedisplay "progress"
1770 | "firstmatch" :: args
:: [] ->
1771 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1772 scan args
"%u %d %f %f %f %f %f %f %f %f"
1773 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1774 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1776 let xoff = float (xadjsb ()) in
1780 and x3
= x3
+. xoff in
1781 let y = (getpagey
pageno) + truncate
y0 in
1784 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1786 | "match" :: args
:: [] ->
1787 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1788 scan args
"%u %d %f %f %f %f %f %f %f %f"
1789 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1790 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1792 let xoff = float (xadjsb ()) in
1796 and x3
= x3
+. xoff in
1798 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1800 | "page" :: args
:: [] ->
1801 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1802 let pageopaque = ~
< pageopaques in
1803 begin match state
.currently
with
1804 | Loading
(l, gen
) ->
1805 vlog "page %d took %f sec" l.pageno t
;
1806 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1807 begin match state
.throttle
with
1809 let preloadedpages =
1811 then preloadlayout state
.y
1816 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1817 IntSet.empty
preloadedpages
1820 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1821 if not
(IntSet.mem
pageno set)
1823 wcmd "freepage %s" (~
> opaque
);
1829 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1832 state
.currently
<- Idle
;
1835 tilepage l.pageno pageopaque state
.layout;
1837 load preloadedpages;
1838 let visible = pagevisible state
.layout l.pageno in
1841 match state
.mode
with
1842 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1843 if pageno = l.pageno
1848 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1850 if dir
> 0 then LDfirst
else LDlast
1853 findlink
pageopaque ld
1858 showlinktype (getlink
pageopaque n);
1859 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1861 | LinkNav
(Ltgendir
_)
1862 | LinkNav
(Ltexact
_)
1868 if visible && layoutready state
.layout
1870 G.postRedisplay "page";
1874 | Some
(layout, _, _) ->
1875 state
.currently
<- Idle
;
1876 tilepage l.pageno pageopaque layout;
1883 dolog
"Inconsistent loading state";
1884 logcurrently state
.currently
;
1888 | "tile" :: args
:: [] ->
1889 let (x, y, opaques
, size
, t
) =
1890 scan args
"%u %u %s %u %f"
1891 (fun x y p size t
-> (x, y, p
, size
, t
))
1893 let opaque = ~
< opaques
in
1894 begin match state
.currently
with
1895 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1896 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1899 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1901 wcmd "freetile %s" (~
> opaque);
1902 state
.currently
<- Idle
;
1906 puttileopaque l col row gen cs angle
opaque size t
;
1907 state
.memused
<- state
.memused
+ size
;
1908 state
.uioh#infochanged Memused
;
1910 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1911 opaque, size
) state
.tilelru
;
1914 match state
.throttle
with
1915 | None
-> state
.layout
1916 | Some
(layout, _, _) -> layout
1919 state
.currently
<- Idle
;
1921 && conf
.colorspace
= cs
1922 && conf
.angle
= angle
1923 && tilevisible layout l.pageno x y
1924 then conttiling l.pageno pageopaque;
1926 begin match state
.throttle
with
1928 preload state
.layout;
1930 && conf
.colorspace
= cs
1931 && conf
.angle
= angle
1932 && tilevisible state
.layout l.pageno x y
1933 && (not
!wtmode || layoutready state
.layout)
1934 then G.postRedisplay "tile nothrottle";
1936 | Some
(layout, y, _) ->
1937 let ready = layoutready layout in
1941 state
.layout <- layout;
1942 state
.throttle
<- None
;
1943 G.postRedisplay "throttle";
1952 dolog
"Inconsistent tiling state";
1953 logcurrently state
.currently
;
1957 | "pdim" :: args
:: [] ->
1958 let (n, w, h, _) as pdim
=
1959 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1962 match conf
.fitmodel
with
1964 | FitPage
| FitProportional
->
1965 match conf
.columns
with
1966 | Csplit
_ -> (n, w, h, 0)
1967 | Csingle
_ | Cmulti
_ -> pdim
1969 state
.uioh#infochanged Pdim
;
1970 state
.pdims
<- pdim :: state
.pdims
1972 | "o" :: args
:: [] ->
1973 let (l, n, t
, h, pos
) =
1974 scan args
"%u %u %d %u %n"
1975 (fun l n t
h pos
-> l, n, t
, h, pos
)
1977 let s = String.sub args pos
(String.length args
- pos
) in
1978 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1980 | "ou" :: args
:: [] ->
1981 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1982 let s = String.sub args pos
len in
1983 let pos2 = pos
+ len + 1 in
1984 let uri = String.sub args
pos2 (String.length args
- pos2) in
1985 addoutline (s, l, Ouri
uri)
1987 | "on" :: args
:: [] ->
1988 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1989 let s = String.sub args pos
(String.length args
- pos
) in
1990 addoutline (s, l, Onone
)
1992 | "a" :: args
:: [] ->
1994 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1996 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1998 | "info" :: args
:: [] ->
1999 let pos = nindex args '
\t'
in
2000 if pos >= 0 && String.sub args
0 pos = "Title"
2002 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
2005 state
.docinfo
<- (1, args
) :: state
.docinfo
2007 | "infoend" :: [] ->
2008 state
.uioh#infochanged Docinfo
;
2009 state
.docinfo
<- List.rev state
.docinfo
2013 then Wsi.settitle
"Wrong password";
2014 let password = getpassword () in
2016 then error
"document is password protected"
2017 else opendoc state
.path
password
2020 error
"unknown cmd `%S'" cmds
2025 let action = function
2026 | HCprev
-> cbget cb ~
-1
2027 | HCnext
-> cbget cb
1
2028 | HCfirst
-> cbget cb ~
-(cb
.rc)
2029 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
2030 and cancel
() = cb
.rc <- rc
2034 let search pattern forward
=
2035 match conf
.columns
with
2037 showtext '
!'
"searching does not work properly in split columns mode"
2040 if nonemptystr pattern
2043 match state
.layout with
2046 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
2048 wcmd "search %d %d %d %d,%s\000"
2049 (btod conf
.icase
) pn py (btod forward
) pattern
;
2052 let intentry text key =
2054 if key >= 32 && key < 127
2060 let text = addchar text c in
2064 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2068 let linknentry text key =
2070 if key >= 32 && key < 127
2076 let text = addchar text c in
2080 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2088 let l = String.length
s in
2089 let rec loop pos n = if pos = l then n else
2090 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2091 loop (pos+1) (n*26 + m)
2094 let rec loop n = function
2097 match getopaque l.pageno with
2098 | None
-> loop n rest
2100 let m = getlinkcount
opaque in
2103 let under = getlink
opaque n in
2106 else loop (n-m) rest
2108 loop n state
.layout;
2112 let textentry text key =
2113 if key land 0xff00 = 0xff00
2115 else TEcont
(text ^ toutf8
key)
2118 let reqlayout angle fitmodel
=
2119 match state
.throttle
with
2121 if nogeomcmds state
.geomcmds
2122 then state
.anchor <- getanchor
();
2123 conf
.angle
<- angle
mod 360;
2126 match state
.mode
with
2127 | LinkNav
_ -> state
.mode
<- View
2132 conf
.fitmodel
<- fitmodel
;
2133 invalidate "reqlayout"
2135 wcmd "reqlayout %d %d %d"
2136 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2141 let settrim trimmargins trimfuzz
=
2142 if nogeomcmds state
.geomcmds
2143 then state
.anchor <- getanchor
();
2144 conf
.trimmargins
<- trimmargins
;
2145 conf
.trimfuzz
<- trimfuzz
;
2146 let x0, y0, x1, y1 = trimfuzz
in
2147 invalidate "settrim"
2149 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2154 match state
.throttle
with
2156 let zoom = max
0.0001 zoom in
2157 if zoom <> conf
.zoom
2159 state
.prevzoom
<- (conf
.zoom, state
.x);
2161 reshape state
.winw state
.winh
;
2162 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2165 | Some
(layout, y, started
) ->
2167 match conf
.maxwait
with
2171 let dt = now
() -. started
in
2179 let setcolumns mode columns coverA coverB
=
2180 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2184 then showtext '
!'
"split mode doesn't work in bird's eye"
2186 conf
.columns
<- Csplit
(-columns
, E.a);
2194 conf
.columns
<- Csingle
E.a;
2199 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2203 reshape state
.winw state
.winh
;
2206 let resetmstate () =
2207 state
.mstate
<- Mnone
;
2208 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2211 let enterbirdseye () =
2212 let zoom = float conf
.thumbw
/. float state
.winw
in
2213 let birdseyepageno =
2214 let cy = state
.winh
/ 2 in
2218 let rec fold best
= function
2221 let d = cy - (l.pagedispy + l.pagevh/2)
2222 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2223 if abs
d < abs dbest
2230 state
.mode
<- Birdseye
(
2231 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2235 conf
.presentation
<- false;
2236 conf
.interpagespace
<- 10;
2237 conf
.hlinks
<- false;
2238 conf
.fitmodel
<- FitPage
;
2240 conf
.maxwait
<- None
;
2242 match conf
.beyecolumns
with
2245 Cmulti
((c, 0, 0), E.a)
2246 | None
-> Csingle
E.a
2250 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2255 reshape state
.winw state
.winh
;
2258 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2260 conf
.zoom <- c.zoom;
2261 conf
.presentation
<- c.presentation
;
2262 conf
.interpagespace
<- c.interpagespace
;
2263 conf
.maxwait
<- c.maxwait
;
2264 conf
.hlinks
<- c.hlinks
;
2265 conf
.fitmodel
<- c.fitmodel
;
2266 conf
.beyecolumns
<- (
2267 match conf
.columns
with
2268 | Cmulti
((c, _, _), _) -> Some
c
2270 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2273 match c.columns
with
2274 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2275 | Csingle
_ -> Csingle
E.a
2276 | Csplit
(c, _) -> Csplit
(c, E.a)
2280 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2283 reshape state
.winw state
.winh
;
2284 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2288 let togglebirdseye () =
2289 match state
.mode
with
2290 | Birdseye vals
-> leavebirdseye vals
true
2291 | View
-> enterbirdseye ()
2296 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2297 let pageno = max
0 (pageno - incr
) in
2298 let rec loop = function
2299 | [] -> gotopage1 pageno 0
2300 | l :: _ when l.pageno = pageno ->
2301 if l.pagedispy >= 0 && l.pagey = 0
2302 then G.postRedisplay "upbirdseye"
2303 else gotopage1 pageno 0
2304 | _ :: rest
-> loop rest
2308 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2311 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2312 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2313 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2314 let rec loop = function
2316 let y, h = getpageyh
pageno in
2317 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2319 | l :: _ when l.pageno = pageno ->
2320 if l.pagevh != l.pageh
2321 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2322 else G.postRedisplay "downbirdseye"
2323 | _ :: rest
-> loop rest
2329 let boundastep h step
=
2331 then bound step ~
-h 0
2335 let optentry mode
_ key =
2336 let btos b = if b then "on" else "off" in
2337 if key >= 32 && key < 127
2339 let c = Char.chr
key in
2343 try conf
.scrollstep
<- int_of_string
s with exc
->
2344 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2346 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2351 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2352 if state
.autoscroll
<> None
2353 then state
.autoscroll
<- Some conf
.autoscrollstep
2355 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2357 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2362 let n, a, b = multicolumns_of_string
s in
2363 setcolumns mode
n a b;
2365 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2367 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2372 let zoom = float (int_of_string
s) /. 100.0 in
2375 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2377 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2382 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2384 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2385 begin match mode
with
2387 leavebirdseye beye
false;
2394 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2396 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2401 Some
(int_of_string
s)
2403 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2407 | Some angle
-> reqlayout angle conf
.fitmodel
2410 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2413 conf
.icase
<- not conf
.icase
;
2414 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2417 conf
.preload <- not conf
.preload;
2419 TEdone
("preload " ^
(btos conf
.preload))
2422 conf
.verbose
<- not conf
.verbose
;
2423 TEdone
("verbose " ^
(btos conf
.verbose
))
2426 conf
.debug
<- not conf
.debug
;
2427 TEdone
("debug " ^
(btos conf
.debug
))
2430 conf
.maxhfit
<- not conf
.maxhfit
;
2431 state
.maxy
<- calcheight
();
2432 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2435 conf
.crophack
<- not conf
.crophack
;
2436 TEdone
("crophack " ^
btos conf
.crophack
)
2440 match conf
.maxwait
with
2442 conf
.maxwait
<- Some infinity
;
2443 "always wait for page to complete"
2445 conf
.maxwait
<- None
;
2446 "show placeholder if page is not ready"
2451 conf
.underinfo
<- not conf
.underinfo
;
2452 TEdone
("underinfo " ^
btos conf
.underinfo
)
2455 conf
.savebmarks
<- not conf
.savebmarks
;
2456 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2462 match state
.layout with
2467 conf
.interpagespace
<- int_of_string
s;
2468 docolumns conf
.columns
;
2469 state
.maxy
<- calcheight
();
2470 let y = getpagey
pageno in
2473 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2475 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2479 match conf
.fitmodel
with
2480 | FitProportional
-> FitWidth
2481 | FitWidth
| FitPage
-> FitProportional
2483 reqlayout conf
.angle
fm;
2484 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2487 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2488 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2491 conf
.invert
<- not conf
.invert
;
2492 TEdone
("invert colors " ^
btos conf
.invert
)
2496 cbput state
.hists
.sel
s;
2499 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2500 textentry, ondone, true)
2504 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2505 else conf
.pax
<- None
;
2506 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2509 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2515 class type lvsource
= object
2516 method getitemcount
: int
2517 method getitem
: int -> (string * int)
2518 method hasaction
: int -> bool
2526 method getactive
: int
2527 method getfirst
: int
2529 method getminfo
: (int * int) array
2532 class virtual lvsourcebase
= object
2533 val mutable m_active
= 0
2534 val mutable m_first
= 0
2535 val mutable m_pan
= 0
2536 method getactive
= m_active
2537 method getfirst
= m_first
2538 method getpan
= m_pan
2539 method getminfo
: (int * int) array
= E.a
2542 let withoutlastutf8 s =
2543 let len = String.length
s in
2551 let b = Char.code
s.[pos] in
2552 if b land 0b11000000 = 0b11000000
2557 if Char.code
s.[len-1] land 0x80 = 0
2561 String.sub
s 0 first;
2564 let textentrykeyboard
2565 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2567 if key >= 0xffb0 && key <= 0xffb9
2568 then key - 0xffb0 + 48 else key
2571 state
.mode
<- Textentry
(te
, onleave
);
2574 G.postRedisplay "textentrykeyboard enttext";
2576 let histaction cmd
=
2579 | Some
(action, _) ->
2580 state
.mode
<- Textentry
(
2581 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2583 G.postRedisplay "textentry histaction"
2587 if emptystr
text && cancelonempty
2590 G.postRedisplay "textentrykeyboard after cancel";
2593 let s = withoutlastutf8 text in
2594 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2596 | @enter
| @kpenter
->
2599 G.postRedisplay "textentrykeyboard after confirm"
2601 | @up
| @kpup
-> histaction HCprev
2602 | @down
| @kpdown
-> histaction HCnext
2603 | @home
| @kphome
-> histaction HCfirst
2604 | @jend
| @kpend
-> histaction HClast
2609 begin match opthist
with
2611 | Some
(_, onhistcancel
) -> onhistcancel
()
2615 G.postRedisplay "textentrykeyboard after cancel2"
2618 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2621 | @delete
| @kpdelete
-> ()
2624 && key land 0xff00 != 0xff00 (* keyboard *)
2625 && key land 0xfe00 != 0xfe00 (* xkb *)
2626 && key land 0xfd00 != 0xfd00 (* 3270 *)
2628 begin match onkey
text key with
2632 G.postRedisplay "textentrykeyboard after confirm2";
2635 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2639 G.postRedisplay "textentrykeyboard after cancel3"
2642 state
.mode
<- Textentry
(te
, onleave
);
2643 G.postRedisplay "textentrykeyboard switch";
2647 vlog "unhandled key %s" (Wsi.keyname
key)
2650 let firstof first active
=
2651 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2652 then max
0 (active
- (fstate
.maxrows
/2))
2656 let calcfirst first active
=
2659 let rows = active
- first in
2660 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2664 let scrollph y maxy
=
2665 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2666 let sh = float state
.winh
/. sh in
2667 let sh = max
sh (float conf
.scrollh
) in
2669 let percent = float y /. float maxy
in
2670 let position = (float state
.winh
-. sh) *. percent in
2673 if position +. sh > float state
.winh
2674 then float state
.winh
-. sh
2680 let coe s = (s :> uioh
);;
2682 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2684 val m_pan
= source#getpan
2685 val m_first
= source#getfirst
2686 val m_active
= source#getactive
2688 val m_prev_uioh
= state
.uioh
2690 method private elemunder
y =
2694 let n = y / (fstate
.fontsize
+1) in
2695 if m_first
+ n < source#getitemcount
2697 if source#hasaction
(m_first
+ n)
2698 then Some
(m_first
+ n)
2705 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2706 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2707 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2708 GlDraw.color
(1., 1., 1.);
2709 Gl.enable `texture_2d
;
2710 let fs = fstate
.fontsize
in
2712 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2713 let ww = fstate
.wwidth
in
2714 let tabw = 17.0*.ww in
2715 let itemcount = source#getitemcount
in
2716 let minfo = source#getminfo
in
2719 then float (xadjsb ()), float (state
.winw
- 1)
2720 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2722 let xadj = xadjsb () in
2724 if (row - m_first
) > fstate
.maxrows
2727 if row >= 0 && row < itemcount
2729 let (s, level
) = source#getitem
row in
2730 let y = (row - m_first
) * nfs in
2732 (if conf
.leftscroll
then float xadj else 5.0)
2733 +. (float (level
+ m_pan
)) *. ww in
2736 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2740 Gl.disable `texture_2d
;
2741 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2742 GlDraw.color
(1., 1., 1.) ~
alpha;
2743 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2744 Gl.enable `texture_2d
;
2747 if zebra
&& row land 1 = 1
2751 GlDraw.color
(c,c,c);
2752 let drawtabularstring s =
2754 let x'
= truncate
(x0 +. x) in
2755 let pos = nindex
s '
\000'
in
2757 then drawstring1 fs x'
(y+nfs) s
2759 let s1 = String.sub
s 0 pos
2760 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2765 let s'
= withoutlastutf8 s in
2766 let s = s' ^
"@Uellipsis" in
2767 let w = measurestr
fs s in
2768 if float x'
+. w +. ww < float (hw + x'
)
2773 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2777 ignore
(drawstring1 fs x'
(y+nfs) s1);
2778 drawstring1 fs (hw + x'
) (y+nfs) s2
2782 let x = if helpmode
&& row > 0 then x +. ww else x in
2783 let tabpos = nindex
s '
\t'
in
2786 let len = String.length
s - tabpos - 1 in
2787 let s1 = String.sub
s 0 tabpos
2788 and s2
= String.sub
s (tabpos + 1) len in
2789 let nx = drawstr x s1 in
2791 let x = x +. (max
tabw sw) in
2794 let len = String.length
s - 2 in
2795 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2797 let s = String.sub
s 2 len in
2798 let x = if not helpmode
then x +. ww else x in
2799 GlDraw.color
(1.2, 1.2, 1.2);
2800 let vinc = drawstring1 (fs+fs/4)
2801 (truncate
(x -. ww)) (y+nfs) s in
2802 GlDraw.color
(1., 1., 1.);
2803 vinc +. (float fs *. 0.8)
2809 ignore
(drawtabularstring s);
2815 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2816 let xadj = float (xadjsb () + 5) in
2818 if (row - m_first
) > fstate
.maxrows
2821 if row >= 0 && row < itemcount
2823 let (s, level
) = source#getitem
row in
2824 let pos0 = nindex
s '
\000'
in
2825 let y = (row - m_first
) * nfs in
2826 let x = float (level
+ m_pan
) *. ww in
2827 let (first, last
) = minfo.(row) in
2829 if pos0 > 0 && first > pos0
2830 then String.sub
s (pos0+1) (first-pos0-1)
2831 else String.sub
s 0 first
2833 let suffix = String.sub
s first (last
- first) in
2834 let w1 = measurestr fstate
.fontsize
prefix in
2835 let w2 = measurestr fstate
.fontsize
suffix in
2836 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2837 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2839 and y0 = float (y+2) in
2841 and y1 = float (y+fs+3) in
2842 filledrect x0 y0 x1 y1;
2847 Gl.disable `texture_2d
;
2848 if Array.length
minfo > 0 then loop m_first
;
2851 method updownlevel incr
=
2852 let len = source#getitemcount
in
2854 if m_active
>= 0 && m_active
< len
2855 then snd
(source#getitem m_active
)
2859 if i
= len then i
-1 else if i
= -1 then 0 else
2860 let _, l = source#getitem i
in
2861 if l != curlevel then i
else flow (i
+incr
)
2863 let active = flow m_active
in
2864 let first = calcfirst m_first
active in
2865 G.postRedisplay "outline updownlevel";
2866 {< m_active
= active; m_first
= first >}
2868 method private key1
key mask
=
2869 let set1 active first qsearch
=
2870 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2872 let search active pattern incr
=
2873 let active = if active = -1 then m_first
else active in
2876 if n >= 0 && n < source#getitemcount
2878 let s, _ = source#getitem
n in
2880 (try ignore
(Str.search_forward
re s 0); true
2881 with Not_found
-> false)
2883 else loop (n + incr
)
2890 let re = Str.regexp_case_fold pattern
in
2896 let itemcount = source#getitemcount
in
2897 let find start incr
=
2899 if i
= -1 || i
= itemcount
2902 if source#hasaction i
2904 else find (i
+ incr
)
2909 let set active first =
2910 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2912 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2915 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2917 let incr1 = if incr
> 0 then 1 else -1 in
2918 if isvisible m_first m_active
2921 let next = m_active
+ incr
in
2923 if next < 0 || next >= itemcount
2925 else find next incr1
2927 if abs
(m_active
- next) > fstate
.maxrows
2933 let first = m_first
+ incr
in
2934 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2936 let next = m_active
+ incr
in
2937 let next = bound
next 0 (itemcount - 1) in
2944 if isvisible first next
2951 let first = min
next m_first
in
2953 if abs
(next - first) > fstate
.maxrows
2959 let first = m_first
+ incr
in
2960 let first = bound
first 0 (itemcount - 1) in
2962 let next = m_active
+ incr
in
2963 let next = bound
next 0 (itemcount - 1) in
2964 let next = find next incr1 in
2966 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2968 let active = if m_active
= -1 then next else m_active
in
2973 if isvisible first active
2979 G.postRedisplay "listview navigate";
2983 | (@r|@s) when Wsi.withctrl mask
->
2984 let incr = if key = @r then -1 else 1 in
2986 match search (m_active
+ incr) m_qsearch
incr with
2988 state
.text <- m_qsearch ^
" [not found]";
2991 state
.text <- m_qsearch
;
2992 active, firstof m_first
active
2994 G.postRedisplay "listview ctrl-r/s";
2995 set1 active first m_qsearch
;
2997 | @insert
when Wsi.withctrl mask
->
2998 if m_active
>= 0 && m_active
< source#getitemcount
3000 let s, _ = source#getitem m_active
in
3006 if emptystr m_qsearch
3009 let qsearch = withoutlastutf8 m_qsearch
in
3013 G.postRedisplay "listview empty qsearch";
3014 set1 m_active m_first
E.s;
3018 match search m_active
qsearch ~
-1 with
3020 state
.text <- qsearch ^
" [not found]";
3023 state
.text <- qsearch;
3024 active, firstof m_first
active
3026 G.postRedisplay "listview backspace qsearch";
3027 set1 active first qsearch
3030 | key when (key != 0 && key land 0xff00 != 0xff00) ->
3031 let pattern = m_qsearch ^ toutf8
key in
3033 match search m_active
pattern 1 with
3035 state
.text <- pattern ^
" [not found]";
3038 state
.text <- pattern;
3039 active, firstof m_first
active
3041 G.postRedisplay "listview qsearch add";
3042 set1 active first pattern;
3046 if emptystr m_qsearch
3048 G.postRedisplay "list view escape";
3051 source#exit ~uioh
:(coe self
)
3052 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
3054 | None
-> m_prev_uioh
3059 G.postRedisplay "list view kill qsearch";
3060 coe {< m_qsearch
= E.s >}
3063 | @enter
| @kpenter
->
3065 let self = {< m_qsearch
= E.s >} in
3067 G.postRedisplay "listview enter";
3068 if m_active
>= 0 && m_active
< source#getitemcount
3070 source#exit ~uioh
:(coe self) ~cancel
:false
3071 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3074 source#exit ~uioh
:(coe self) ~cancel
:true
3075 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3078 begin match opt with
3079 | None
-> m_prev_uioh
3083 | @delete
| @kpdelete
->
3086 | @up
| @kpup
-> navigate ~
-1
3087 | @down
| @kpdown
-> navigate 1
3088 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3089 | @next | @kpnext
-> navigate fstate
.maxrows
3091 | @right
| @kpright
->
3093 G.postRedisplay "listview right";
3094 coe {< m_pan
= m_pan
- 1 >}
3096 | @left | @kpleft
->
3098 G.postRedisplay "listview left";
3099 coe {< m_pan
= m_pan
+ 1 >}
3101 | @home
| @kphome
->
3102 let active = find 0 1 in
3103 G.postRedisplay "listview home";
3107 let first = max
0 (itemcount - fstate
.maxrows
) in
3108 let active = find (itemcount - 1) ~
-1 in
3109 G.postRedisplay "listview end";
3112 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3116 dolog
"listview unknown key %#x" key; coe self
3118 method key key mask
=
3119 match state
.mode
with
3120 | Textentry te
-> textentrykeyboard key mask te
; coe self
3123 | LinkNav
_ -> self#key1
key mask
3125 method button button down
x y _ =
3128 | 1 when x > state
.winw
- conf
.scrollbw
->
3129 G.postRedisplay "listview scroll";
3132 let _, position, sh = self#
scrollph in
3133 if y > truncate
position && y < truncate
(position +. sh)
3135 state
.mstate
<- Mscrolly
;
3139 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3140 let first = truncate
(s *. float source#getitemcount
) in
3141 let first = min source#getitemcount
first in
3142 Some
(coe {< m_first
= first; m_active
= first >})
3144 state
.mstate
<- Mnone
;
3148 begin match self#elemunder
y with
3150 G.postRedisplay "listview click";
3151 source#exit ~uioh
:(coe {< m_active
= n >})
3152 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3156 | n when (n == 4 || n == 5) && not down
->
3157 let len = source#getitemcount
in
3159 if n = 5 && m_first
+ fstate
.maxrows
>= len
3163 let first = m_first
+ (if n == 4 then -1 else 1) in
3164 bound
first 0 (len - 1)
3166 G.postRedisplay "listview wheel";
3167 Some
(coe {< m_first
= first >})
3168 | n when (n = 6 || n = 7) && not down
->
3169 let inc = if n = 7 then -1 else 1 in
3170 G.postRedisplay "listview hwheel";
3171 Some
(coe {< m_pan
= m_pan
+ inc >})
3176 | None
-> m_prev_uioh
3179 method multiclick
_ x y = self#button
1 true x y
3182 match state
.mstate
with
3184 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3185 let first = truncate
(s *. float source#getitemcount
) in
3186 let first = min source#getitemcount
first in
3187 G.postRedisplay "listview motion";
3188 coe {< m_first
= first; m_active
= first >}
3196 method pmotion
x y =
3197 if x < state
.winw
- conf
.scrollbw
3200 match self#elemunder
y with
3201 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3202 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3206 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3211 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3215 method infochanged
_ = ()
3217 method scrollpw
= (0, 0.0, 0.0)
3219 let nfs = fstate
.fontsize
+ 1 in
3220 let y = m_first
* nfs in
3221 let itemcount = source#getitemcount
in
3222 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3223 let maxy = maxi * nfs in
3224 let p, h = scrollph y maxy in
3227 method modehash
= modehash
3228 method eformsgs
= false
3229 method alwaysscrolly
= true
3232 class outlinelistview ~zebra ~source
=
3233 let settext autonarrow
s =
3236 let ss = source#statestr
in
3240 else "{" ^
ss ^
"} [" ^
s ^
"]"
3241 else state
.text <- s
3247 ~source
:(source
:> lvsource
)
3249 ~modehash
:(findkeyhash conf
"outline")
3252 val m_autonarrow
= false
3254 method! key key mask
=
3256 if emptystr state
.text
3258 else fstate
.maxrows - 2
3260 let calcfirst first active =
3263 let rows = active - first in
3264 if rows > maxrows then active - maxrows else first
3268 let active = m_active
+ incr in
3269 let active = bound
active 0 (source#getitemcount
- 1) in
3270 let first = calcfirst m_first
active in
3271 G.postRedisplay "outline navigate";
3272 coe {< m_active
= active; m_first
= first >}
3274 let navscroll first =
3276 let dist = m_active
- first in
3282 else first + maxrows
3285 G.postRedisplay "outline navscroll";
3286 coe {< m_first
= first; m_active
= active >}
3288 let ctrl = Wsi.withctrl mask
in
3293 then (source#denarrow
; E.s)
3295 let pattern = source#renarrow
in
3296 if nonemptystr m_qsearch
3297 then (source#narrow m_qsearch
; m_qsearch
)
3301 settext (not m_autonarrow
) text;
3302 G.postRedisplay "toggle auto narrowing";
3303 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3305 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3307 G.postRedisplay "toggle auto narrowing";
3308 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3311 source#narrow m_qsearch
;
3313 then source#add_narrow_pattern m_qsearch
;
3314 G.postRedisplay "outline ctrl-n";
3315 coe {< m_first
= 0; m_active
= 0 >}
3318 let active = source#calcactive
(getanchor
()) in
3319 let first = firstof m_first
active in
3320 G.postRedisplay "outline ctrl-s";
3321 coe {< m_first
= first; m_active
= active >}
3324 G.postRedisplay "outline ctrl-u";
3325 if m_autonarrow
&& nonemptystr m_qsearch
3327 ignore
(source#renarrow
);
3328 settext m_autonarrow
E.s;
3329 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3332 source#del_narrow_pattern
;
3333 let pattern = source#renarrow
in
3335 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3337 settext m_autonarrow
text;
3338 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3342 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3343 G.postRedisplay "outline ctrl-l";
3344 coe {< m_first
= first >}
3346 | @tab
when m_autonarrow
->
3347 if nonemptystr m_qsearch
3349 G.postRedisplay "outline list view tab";
3350 source#add_narrow_pattern m_qsearch
;
3352 coe {< m_qsearch
= E.s >}
3356 | @escape
when m_autonarrow
->
3357 if nonemptystr m_qsearch
3358 then source#add_narrow_pattern m_qsearch
;
3361 | @enter
| @kpenter
when m_autonarrow
->
3362 if nonemptystr m_qsearch
3363 then source#add_narrow_pattern m_qsearch
;
3366 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3367 let pattern = m_qsearch ^ toutf8
key in
3368 G.postRedisplay "outlinelistview autonarrow add";
3369 source#narrow
pattern;
3370 settext true pattern;
3371 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3373 | key when m_autonarrow
&& key = @backspace
->
3374 if emptystr m_qsearch
3377 let pattern = withoutlastutf8 m_qsearch
in
3378 G.postRedisplay "outlinelistview autonarrow backspace";
3379 ignore
(source#renarrow
);
3380 source#narrow
pattern;
3381 settext true pattern;
3382 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3384 | @delete
| @kpdelete
->
3385 source#remove m_active
;
3386 G.postRedisplay "outline delete";
3387 let active = max
0 (m_active
-1) in
3388 coe {< m_first
= firstof m_first
active;
3389 m_active
= active >}
3391 | @up
| @kpup
when ctrl ->
3392 navscroll (max
0 (m_first
- 1))
3394 | @down
| @kpdown
when ctrl ->
3395 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3397 | @up
| @kpup
-> navigate ~
-1
3398 | @down
| @kpdown
-> navigate 1
3399 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3400 | @next | @kpnext
-> navigate fstate
.maxrows
3402 | @right
| @kpright
->
3406 G.postRedisplay "outline ctrl right";
3407 {< m_pan
= m_pan
+ 1 >}
3409 else self#updownlevel
1
3413 | @left | @kpleft
->
3417 G.postRedisplay "outline ctrl left";
3418 {< m_pan
= m_pan
- 1 >}
3420 else self#updownlevel ~
-1
3424 | @home
| @kphome
->
3425 G.postRedisplay "outline home";
3426 coe {< m_first
= 0; m_active
= 0 >}
3429 let active = source#getitemcount
- 1 in
3430 let first = max
0 (active - fstate
.maxrows) in
3431 G.postRedisplay "outline end";
3432 coe {< m_active
= active; m_first
= first >}
3434 | _ -> super#
key key mask
3437 let genhistoutlines =
3438 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3440 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3441 | `path
-> compare p2 p1
3442 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3444 let e1 = emptystr c1
.title
3445 and e2
= emptystr c2
.title
in
3447 then compare
(Filename.basename p2
) (Filename.basename p1
)
3450 else compare c1
.title c2
.title
3452 let showfullpath = ref false in
3455 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3456 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3458 let list = ref [] in
3459 if Config.gethist
list
3463 (fun accu (path
, c, b, x, a) ->
3464 let hist = (path
, (c, b, x, a)) in
3465 let s = if !showfullpath then path
else Filename.basename path
in
3466 let base = mbtoutf8
s in
3467 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3469 [ setorty "Sort by time of last visit" `lastvisit
;
3470 setorty "Sort by file name" `file
;
3471 setorty "Sort by path" `path
;
3472 setorty "Sort by title" `title
;
3473 (if !showfullpath then "@Uradical "
3474 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3475 showfullpath := not
!showfullpath; reeenterhist := true)
3476 ] (List.sort
(order orderty
) !list)
3482 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3483 Config.save
leavebirdseye;
3484 state
.anchor <- anchor;
3486 state
.bookmarks
<- bookmarks
;
3487 state
.origin
<- E.s;
3489 let x0, y0, x1, y1 = conf
.trimfuzz
in
3490 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3494 let makecheckers () =
3495 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3497 converted by Issac Trotts. July 25, 2002 *)
3498 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3499 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3500 let id = GlTex.gen_texture
() in
3501 GlTex.bind_texture ~target
:`texture_2d
id;
3502 GlPix.store
(`unpack_alignment
1);
3503 GlTex.image2d
image;
3504 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3505 [ `mag_filter `nearest
; `min_filter `nearest
];
3509 let setcheckers enabled
=
3510 match state
.checkerstexid
with
3512 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3514 | Some checkerstexid
->
3517 GlTex.delete_texture checkerstexid
;
3518 state
.checkerstexid
<- None
;
3522 let describe_location () =
3523 let fn = page_of_y state
.y in
3524 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3525 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3529 else (100. *. (float state
.y /. float maxy))
3533 Printf.sprintf
"page %d of %d [%.2f%%]"
3534 (fn+1) state
.pagecount
percent
3537 "pages %d-%d of %d [%.2f%%]"
3538 (fn+1) (ln+1) state
.pagecount
percent
3541 let setpresentationmode v
=
3542 let n = page_of_y state
.y in
3543 state
.anchor <- (n, 0.0, 1.0);
3544 conf
.presentation
<- v
;
3545 if conf
.fitmodel
= FitPage
3546 then reqlayout conf
.angle conf
.fitmodel
;
3551 let btos b = if b then "@Uradical" else E.s in
3552 let showextended = ref false in
3553 let leave mode
_ = state
.mode
<- mode
in
3556 val mutable m_first_time
= true
3557 val mutable m_l
= []
3558 val mutable m_a
= E.a
3559 val mutable m_prev_uioh
= nouioh
3560 val mutable m_prev_mode
= View
3562 inherit lvsourcebase
3564 method reset prev_mode prev_uioh
=
3565 m_a
<- Array.of_list
(List.rev m_l
);
3567 m_prev_mode
<- prev_mode
;
3568 m_prev_uioh
<- prev_uioh
;
3572 if n >= Array.length m_a
3576 | _, _, _, Action
_ -> m_active
<- n
3577 | _, _, _, Noaction
-> loop (n+1)
3580 m_first_time
<- false;
3583 method int name get
set =
3585 (name
, `
int get
, 1, Action
(
3588 try set (int_of_string
s)
3590 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3594 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3595 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3599 method int_with_suffix name get
set =
3601 (name
, `intws get
, 1, Action
(
3604 try set (int_of_string_with_suffix
s)
3606 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3611 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3613 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3617 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3619 (name
, `
bool (btos, get
), offset
, Action
(
3626 method color name get
set =
3628 (name
, `color get
, 1, Action
(
3630 let invalid = (nan
, nan
, nan
) in
3633 try color_of_string
s
3635 state
.text <- Printf.sprintf
"bad color `%s': %s"
3642 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3643 state
.text <- color_to_string
(get
());
3644 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3648 method string name get
set =
3650 (name
, `
string get
, 1, Action
(
3652 let ondone s = set s in
3653 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3654 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3658 method colorspace name get
set =
3660 (name
, `
string get
, 1, Action
(
3664 inherit lvsourcebase
3667 m_active
<- CSTE.to_int conf
.colorspace
;
3670 method getitemcount
=
3671 Array.length
CSTE.names
3674 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3675 ignore
(uioh
, first, pan
);
3676 if not cancel
then set active;
3678 method hasaction
_ = true
3682 let modehash = findkeyhash conf
"info" in
3683 coe (new listview ~zebra
:false ~helpmode
:false
3684 ~
source ~trusted
:true ~
modehash)
3687 method paxmark name get
set =
3689 (name
, `
string get
, 1, Action
(
3693 inherit lvsourcebase
3696 m_active
<- MTE.to_int conf
.paxmark
;
3699 method getitemcount
= Array.length
MTE.names
3700 method getitem
n = (MTE.names
.(n), 0)
3701 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3702 ignore
(uioh
, first, pan
);
3703 if not cancel
then set active;
3705 method hasaction
_ = true
3709 let modehash = findkeyhash conf
"info" in
3710 coe (new listview ~zebra
:false ~helpmode
:false
3711 ~
source ~trusted
:true ~
modehash)
3714 method fitmodel name get
set =
3716 (name
, `
string get
, 1, Action
(
3720 inherit lvsourcebase
3723 m_active
<- FMTE.to_int conf
.fitmodel
;
3726 method getitemcount
= Array.length
FMTE.names
3727 method getitem
n = (FMTE.names
.(n), 0)
3728 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3729 ignore
(uioh
, first, pan
);
3730 if not cancel
then set active;
3732 method hasaction
_ = true
3736 let modehash = findkeyhash conf
"info" in
3737 coe (new listview ~zebra
:false ~helpmode
:false
3738 ~
source ~trusted
:true ~
modehash)
3741 method caption
s offset
=
3742 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3744 method caption2
s f offset
=
3745 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3747 method getitemcount
= Array.length m_a
3750 let tostr = function
3751 | `
int f -> string_of_int
(f ())
3752 | `intws
f -> string_with_suffix_of_int
(f ())
3754 | `color
f -> color_to_string
(f ())
3755 | `
bool (btos, f) -> btos (f ())
3758 let name, t
, offset
, _ = m_a
.(n) in
3759 ((let s = tostr t
in
3761 then Printf.sprintf
"%s\t%s" name s
3765 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3770 match m_a
.(active) with
3771 | _, _, _, Action
f -> f uioh
3772 | _, _, _, Noaction
-> uioh
3783 method hasaction
n =
3785 | _, _, _, Action
_ -> true
3786 | _, _, _, Noaction
-> false
3789 let rec fillsrc prevmode prevuioh
=
3790 let sep () = src#caption
E.s 0 in
3791 let colorp name get
set =
3793 (fun () -> color_to_string
(get
()))
3796 let c = color_of_string
v in
3799 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3802 let oldmode = state
.mode
in
3803 let birdseye = isbirdseye state
.mode
in
3805 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3807 src#
bool "presentation mode"
3808 (fun () -> conf
.presentation
)
3809 (fun v -> setpresentationmode v);
3811 src#
bool "ignore case in searches"
3812 (fun () -> conf
.icase
)
3813 (fun v -> conf
.icase
<- v);
3816 (fun () -> conf
.preload)
3817 (fun v -> conf
.preload <- v);
3819 src#
bool "highlight links"
3820 (fun () -> conf
.hlinks
)
3821 (fun v -> conf
.hlinks
<- v);
3823 src#
bool "under info"
3824 (fun () -> conf
.underinfo
)
3825 (fun v -> conf
.underinfo
<- v);
3827 src#
bool "persistent bookmarks"
3828 (fun () -> conf
.savebmarks
)
3829 (fun v -> conf
.savebmarks
<- v);
3831 src#fitmodel
"fit model"
3832 (fun () -> FMTE.to_string conf
.fitmodel
)
3833 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3835 src#
bool "trim margins"
3836 (fun () -> conf
.trimmargins
)
3837 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3839 src#
bool "persistent location"
3840 (fun () -> conf
.jumpback
)
3841 (fun v -> conf
.jumpback
<- v);
3844 src#
int "inter-page space"
3845 (fun () -> conf
.interpagespace
)
3847 conf
.interpagespace
<- n;
3848 docolumns conf
.columns
;
3850 match state
.layout with
3855 state
.maxy <- calcheight
();
3856 let y = getpagey
pageno in
3861 (fun () -> conf
.pagebias
)
3862 (fun v -> conf
.pagebias
<- v);
3864 src#
int "scroll step"
3865 (fun () -> conf
.scrollstep
)
3866 (fun n -> conf
.scrollstep
<- n);
3868 src#
int "horizontal scroll step"
3869 (fun () -> conf
.hscrollstep
)
3870 (fun v -> conf
.hscrollstep
<- v);
3872 src#
int "auto scroll step"
3874 match state
.autoscroll
with
3876 | _ -> conf
.autoscrollstep
)
3878 let n = boundastep state
.winh
n in
3879 if state
.autoscroll
<> None
3880 then state
.autoscroll
<- Some
n;
3881 conf
.autoscrollstep
<- n);
3884 (fun () -> truncate
(conf
.zoom *. 100.))
3885 (fun v -> setzoom ((float v) /. 100.));
3888 (fun () -> conf
.angle
)
3889 (fun v -> reqlayout v conf
.fitmodel
);
3891 src#
int "scroll bar width"
3892 (fun () -> conf
.scrollbw
)
3895 reshape state
.winw state
.winh
;
3898 src#
int "scroll handle height"
3899 (fun () -> conf
.scrollh
)
3900 (fun v -> conf
.scrollh
<- v;);
3902 src#
int "thumbnail width"
3903 (fun () -> conf
.thumbw
)
3905 conf
.thumbw
<- min
4096 v;
3908 leavebirdseye beye
false;
3915 let mode = state
.mode in
3916 src#
string "columns"
3918 match conf
.columns
with
3920 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3921 | Csplit
(count
, _) -> "-" ^ string_of_int count
3924 let n, a, b = multicolumns_of_string
v in
3925 setcolumns mode n a b);
3928 src#caption
"Pixmap cache" 0;
3929 src#int_with_suffix
"size (advisory)"
3930 (fun () -> conf
.memlimit
)
3931 (fun v -> conf
.memlimit
<- v);
3934 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3935 (string_with_suffix_of_int state
.memused
)
3936 (Hashtbl.length state
.tilemap
)) 1;
3939 src#caption
"Layout" 0;
3940 src#caption2
"Dimension"
3942 Printf.sprintf
"%dx%d (virtual %dx%d)"
3943 state
.winw state
.winh
3948 src#caption2
"Position" (fun () ->
3949 Printf.sprintf
"%dx%d" state
.x state
.y
3952 src#caption2
"Position" (fun () -> describe_location ()) 1
3956 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3957 "Save these parameters as global defaults at exit"
3958 (fun () -> conf
.bedefault
)
3959 (fun v -> conf
.bedefault
<- v)
3963 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3964 src#
bool ~offset
:0 ~
btos "Extended parameters"
3965 (fun () -> !showextended)
3966 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3970 (fun () -> conf
.checkers
)
3971 (fun v -> conf
.checkers
<- v; setcheckers v);
3972 src#
bool "update cursor"
3973 (fun () -> conf
.updatecurs
)
3974 (fun v -> conf
.updatecurs
<- v);
3975 src#
bool "scroll-bar on the left"
3976 (fun () -> conf
.leftscroll
)
3977 (fun v -> conf
.leftscroll
<- v);
3979 (fun () -> conf
.verbose
)
3980 (fun v -> conf
.verbose
<- v);
3981 src#
bool "invert colors"
3982 (fun () -> conf
.invert
)
3983 (fun v -> conf
.invert
<- v);
3985 (fun () -> conf
.maxhfit
)
3986 (fun v -> conf
.maxhfit
<- v);
3987 src#
bool "redirect stderr"
3988 (fun () -> conf
.redirectstderr)
3989 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3991 (fun () -> conf
.pax
!= None
)
3994 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3995 else conf
.pax
<- None
);
3996 src#
string "uri launcher"
3997 (fun () -> conf
.urilauncher
)
3998 (fun v -> conf
.urilauncher
<- v);
3999 src#
string "path launcher"
4000 (fun () -> conf
.pathlauncher
)
4001 (fun v -> conf
.pathlauncher
<- v);
4002 src#
string "tile size"
4003 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4006 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4007 conf
.tilew
<- max
64 w;
4008 conf
.tileh
<- max
64 h;
4011 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4014 src#
int "texture count"
4015 (fun () -> conf
.texcount
)
4018 then conf
.texcount
<- v
4019 else showtext '
!'
" Failed to set texture count please retry later"
4021 src#
int "slice height"
4022 (fun () -> conf
.sliceheight
)
4024 conf
.sliceheight
<- v;
4025 wcmd "sliceh %d" conf
.sliceheight
;
4027 src#
int "anti-aliasing level"
4028 (fun () -> conf
.aalevel
)
4030 conf
.aalevel
<- bound
v 0 8;
4031 state
.anchor <- getanchor
();
4032 opendoc state
.path state
.password;
4034 src#
string "page scroll scaling factor"
4035 (fun () -> string_of_float conf
.pgscale)
4038 let s = float_of_string
v in
4041 state
.text <- Printf.sprintf
4042 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4045 src#
int "ui font size"
4046 (fun () -> fstate
.fontsize
)
4047 (fun v -> setfontsize (bound
v 5 100));
4048 src#
int "hint font size"
4049 (fun () -> conf
.hfsize
)
4050 (fun v -> conf
.hfsize
<- bound
v 5 100);
4051 colorp "background color"
4052 (fun () -> conf
.bgcolor
)
4053 (fun v -> conf
.bgcolor
<- v);
4054 src#
bool "crop hack"
4055 (fun () -> conf
.crophack
)
4056 (fun v -> conf
.crophack
<- v);
4057 src#
string "trim fuzz"
4058 (fun () -> irect_to_string conf
.trimfuzz
)
4061 conf
.trimfuzz
<- irect_of_string
v;
4063 then settrim true conf
.trimfuzz
;
4065 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4067 src#
string "throttle"
4069 match conf
.maxwait
with
4070 | None
-> "show place holder if page is not ready"
4073 then "wait for page to fully render"
4075 "wait " ^ string_of_float
time
4076 ^
" seconds before showing placeholder"
4080 let f = float_of_string
v in
4082 then conf
.maxwait
<- None
4083 else conf
.maxwait
<- Some
f
4085 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4087 src#
string "ghyll scroll"
4089 match conf
.ghyllscroll
with
4091 | Some nab
-> ghyllscroll_to_string nab
4094 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4096 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4098 src#
string "selection command"
4099 (fun () -> conf
.selcmd
)
4100 (fun v -> conf
.selcmd
<- v);
4101 src#
string "synctex command"
4102 (fun () -> conf
.stcmd
)
4103 (fun v -> conf
.stcmd
<- v);
4104 src#
string "pax command"
4105 (fun () -> conf
.paxcmd
)
4106 (fun v -> conf
.paxcmd
<- v);
4107 src#
string "ask password command"
4108 (fun () -> conf
.passcmd)
4109 (fun v -> conf
.passcmd <- v);
4110 src#colorspace
"color space"
4111 (fun () -> CSTE.to_string conf
.colorspace
)
4113 conf
.colorspace
<- CSTE.of_int
v;
4117 src#paxmark
"pax mark method"
4118 (fun () -> MTE.to_string conf
.paxmark
)
4119 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4123 (fun () -> conf
.usepbo
)
4124 (fun v -> conf
.usepbo
<- v);
4125 src#
bool "mouse wheel scrolls pages"
4126 (fun () -> conf
.wheelbypage
)
4127 (fun v -> conf
.wheelbypage
<- v);
4128 src#
bool "open remote links in a new instance"
4129 (fun () -> conf
.riani
)
4130 (fun v -> conf
.riani
<- v);
4134 src#caption
"Document" 0;
4135 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4136 src#caption2
"Pages"
4137 (fun () -> string_of_int state
.pagecount
) 1;
4138 src#caption2
"Dimensions"
4139 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4143 src#caption
"Trimmed margins" 0;
4144 src#caption2
"Dimensions"
4145 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4149 src#caption
"OpenGL" 0;
4150 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4151 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4154 src#caption
"Location" 0;
4155 if nonemptystr state
.origin
4156 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4157 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4159 src#reset prevmode prevuioh
;
4164 let prevmode = state
.mode
4165 and prevuioh
= state
.uioh in
4166 fillsrc prevmode prevuioh
;
4167 let source = (src :> lvsource
) in
4168 let modehash = findkeyhash conf
"info" in
4169 state
.uioh <- coe (object (self)
4170 inherit listview ~zebra
:false ~helpmode
:false
4171 ~
source ~trusted
:true ~
modehash as super
4172 val mutable m_prevmemused
= 0
4173 method! infochanged
= function
4175 if m_prevmemused
!= state
.memused
4177 m_prevmemused
<- state
.memused
;
4178 G.postRedisplay "memusedchanged";
4180 | Pdim
-> G.postRedisplay "pdimchanged"
4181 | Docinfo
-> fillsrc prevmode prevuioh
4183 method! key key mask
=
4184 if not
(Wsi.withctrl mask
)
4187 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4188 | @right
| @kpright
-> coe (self#updownlevel
1)
4189 | _ -> super#
key key mask
4190 else super#
key key mask
4192 G.postRedisplay "info";
4198 inherit lvsourcebase
4199 method getitemcount
= Array.length state
.help
4201 let s, l, _ = state
.help
.(n) in
4204 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4208 match state
.help
.(active) with
4209 | _, _, Action
f -> Some
(f uioh)
4210 | _, _, Noaction
-> Some
uioh
4219 method hasaction
n =
4220 match state
.help
.(n) with
4221 | _, _, Action
_ -> true
4222 | _, _, Noaction
-> false
4228 let modehash = findkeyhash conf
"help" in
4230 state
.uioh <- coe (new listview
4231 ~zebra
:false ~helpmode
:true
4232 ~
source ~trusted
:true ~
modehash);
4233 G.postRedisplay "help";
4238 let re = Str.regexp
"[\r\n]" in
4240 inherit lvsourcebase
4241 val mutable m_items
= E.a
4243 method getitemcount
= 1 + Array.length m_items
4248 else m_items
.(n-1), 0
4250 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4255 then Buffer.clear state
.errmsgs
;
4262 method hasaction
n =
4266 state
.newerrmsgs
<- false;
4267 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4268 m_items
<- Array.of_list
l
4277 let source = (msgsource :> lvsource
) in
4278 let modehash = findkeyhash conf
"listview" in
4279 state
.uioh <- coe (object
4280 inherit listview ~zebra
:false ~helpmode
:false
4281 ~
source ~trusted
:false ~
modehash as super
4284 then msgsource#reset
;
4287 G.postRedisplay "msgs";
4290 let enterannotmode =
4293 inherit lvsourcebase
4294 val mutable m_text
= E.s
4295 val mutable m_items
= E.a
4297 method getitemcount
= 1 + Array.length m_items
4300 if n = Array.length m_items
4301 then "[Copy text to the clipboard]", 0
4304 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4305 ignore
(uioh, first, pan
);
4306 if not cancel
&& active = Array.length m_items
4307 then selstring m_text
;
4310 method hasaction
_ = true
4313 let rec split accu b i
=
4315 if p = String.length
s
4316 then String.sub
s b (p-b) :: accu
4318 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4320 let ss = if i
= 0 then E.s else String.sub
s b i
in
4321 split (ss::accu) (p+1) 0
4326 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4335 let source = (msgsource :> lvsource
) in
4336 let modehash = findkeyhash conf
"listview" in
4337 state
.uioh <- coe (object
4338 inherit listview ~zebra
:false ~helpmode
:false
4339 ~
source ~trusted
:false ~
modehash
4341 G.postRedisplay "annot";
4344 let gotounder under =
4345 let getpath filename
=
4347 if nonemptystr filename
4349 if Filename.is_relative filename
4351 let dir = Filename.dirname state
.path in
4353 if Filename.is_implicit
dir
4354 then Filename.concat
(Sys.getcwd
()) dir
4357 Filename.concat
dir filename
4361 if Sys.file_exists
path
4366 | Ulinkgoto
(pageno, top) ->
4370 gotopage1 pageno top;
4376 | Uremote
(filename
, pageno) ->
4377 let path = getpath filename
in
4382 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4383 try popen
command []
4385 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4388 let anchor = getanchor
() in
4389 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4390 state
.origin
<- E.s;
4391 state
.anchor <- (pageno, 0.0, 0.0);
4392 state
.ranchors
<- ranchor :: state
.ranchors
;
4395 else showtext '
!'
("Could not find " ^ filename
)
4397 | Uremotedest
(filename
, destname
) ->
4398 let path = getpath filename
in
4403 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4404 try popen
command []
4407 "failed to execute `%s': %s\n" command (exntos exn
);
4410 let anchor = getanchor
() in
4411 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4412 state
.origin
<- E.s;
4413 state
.nameddest
<- destname
;
4414 state
.ranchors
<- ranchor :: state
.ranchors
;
4417 else showtext '
!'
("Could not find " ^ filename
)
4419 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4420 | Uannotation annot
-> enterannotmode annot
4423 let gotooutline (_, _, kind
) =
4427 let (pageno, y, _) = anchor in
4429 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4433 | Ouri
uri -> gotounder (Ulinkuri
uri)
4434 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4435 | Oremote remote
-> gotounder (Uremote remote
)
4436 | Ohistory
hist -> gotohist hist
4437 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4441 let outlinesource sourcetype
=
4443 inherit lvsourcebase
4444 val mutable m_items
= E.a
4445 val mutable m_minfo
= E.a
4446 val mutable m_orig_items
= E.a
4447 val mutable m_orig_minfo
= E.a
4448 val mutable m_narrow_patterns
= []
4449 val mutable m_hadremovals
= false
4450 val mutable m_gen
= -1
4452 method getitemcount
=
4453 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4456 if n == Array.length m_items
&& m_hadremovals
4458 ("[Confirm removal]", 0)
4460 let s, n, _ = m_items
.(n) in
4463 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4464 ignore
(uioh, first);
4465 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4467 if m_narrow_patterns
= []
4468 then m_orig_items
, m_orig_minfo
4469 else m_items
, m_minfo
4473 if not
confrimremoval
4475 gotooutline m_items
.(active);
4480 state
.bookmarks
<- Array.to_list m_items
;
4481 m_orig_items
<- m_items
;
4482 m_orig_minfo
<- m_minfo
;
4492 method hasaction
_ = true
4495 if Array.length m_items
!= Array.length m_orig_items
4498 match m_narrow_patterns
with
4500 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4502 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4506 match m_narrow_patterns
with
4509 | head
:: _ -> "@Uellipsis" ^ head
4511 method narrow
pattern =
4512 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4516 let rec loop accu minfo n =
4519 m_items
<- Array.of_list
accu;
4520 m_minfo
<- Array.of_list
minfo;
4523 let (s, _, t
) as o = m_items
.(n) in
4526 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4527 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4528 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4530 try Str.search_forward
re s 0
4531 with Not_found
-> -1
4534 then o :: accu, (first, Str.match_end
()) :: minfo
4537 loop accu minfo (n-1)
4539 loop [] [] (Array.length m_items
- 1)
4541 method! getminfo
= m_minfo
4545 match sourcetype
with
4546 | `bookmarks
-> Array.of_list state
.bookmarks
4547 | `outlines
-> state
.outlines
4548 | `history
-> genhistoutlines !Config.historder
4550 m_minfo
<- m_orig_minfo
;
4551 m_items
<- m_orig_items
4554 if sourcetype
= `bookmarks
4556 if m >= 0 && m < Array.length m_items
4558 m_hadremovals
<- true;
4559 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4560 let n = if n >= m then n+1 else n in
4565 method add_narrow_pattern
pattern =
4566 m_narrow_patterns
<- pattern :: m_narrow_patterns
4568 method del_narrow_pattern
=
4569 match m_narrow_patterns
with
4570 | _ :: rest
-> m_narrow_patterns
<- rest
4575 match m_narrow_patterns
with
4576 | pattern :: [] -> self#narrow
pattern; pattern
4578 List.fold_left
(fun accu pattern ->
4579 self#narrow
pattern;
4580 pattern ^
"@Uellipsis" ^
accu) E.s list
4582 method calcactive
anchor =
4583 let rely = getanchory anchor in
4584 let rec loop n best bestd
=
4585 if n = Array.length m_items
4588 let _, _, kind
= m_items
.(n) in
4591 let orely = getanchory anchor in
4592 let d = abs
(orely - rely) in
4595 else loop (n+1) best bestd
4596 | Onone
| Oremote
_ | Olaunch
_
4597 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4598 loop (n+1) best bestd
4602 method reset
anchor items =
4603 m_hadremovals
<- false;
4604 if state
.gen
!= m_gen
4606 m_orig_items
<- items;
4608 m_narrow_patterns
<- [];
4610 m_orig_minfo
<- E.a;
4614 if items != m_orig_items
4616 m_orig_items
<- items;
4617 if m_narrow_patterns
== []
4618 then m_items
<- items;
4621 let active = self#calcactive
anchor in
4623 m_first
<- firstof m_first
active
4627 let enterselector sourcetype
=
4629 let source = outlinesource sourcetype
in
4632 match sourcetype
with
4633 | `bookmarks
-> Array.of_list state
.bookmarks
4634 | `
outlines -> state
.outlines
4635 | `history
-> genhistoutlines !Config.historder
4637 if Array.length
outlines = 0
4639 showtext ' ' errmsg
;
4642 state
.text <- source#greetmsg
;
4643 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4644 let anchor = getanchor
() in
4645 source#reset
anchor outlines;
4647 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4648 G.postRedisplay "enter selector";
4652 let enteroutlinemode =
4653 let f = enterselector `
outlines in
4654 fun () -> f "Document has no outline";
4657 let enterbookmarkmode =
4658 let f = enterselector `bookmarks
in
4659 fun () -> f "Document has no bookmarks (yet)";
4662 let enterhistmode () = enterselector `history
"No history (yet)";;
4664 let quickbookmark ?title
() =
4665 match state
.layout with
4671 let tm = Unix.localtime
(now
()) in
4672 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4676 (tm.Unix.tm_year
+ 1900)
4679 | Some
title -> title
4681 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4684 let setautoscrollspeed step goingdown
=
4685 let incr = max
1 ((abs step
) / 2) in
4686 let incr = if goingdown
then incr else -incr in
4687 let astep = boundastep state
.winh
(step
+ incr) in
4688 state
.autoscroll
<- Some
astep;
4692 match conf
.columns
with
4694 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4697 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4699 let existsinrow pageno (columns
, coverA
, coverB
) p =
4700 let last = ((pageno - coverA
) mod columns
) + columns
in
4701 let rec any = function
4704 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4708 then (if l.pageno = last then false else any rest
)
4716 match state
.layout with
4718 let pageno = page_of_y state
.y in
4719 gotoghyll (getpagey
(pageno+1))
4721 match conf
.columns
with
4723 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4725 let y = clamp (pgscale state
.winh
) in
4728 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4729 gotoghyll (getpagey
pageno)
4730 | Cmulti
((c, _, _) as cl, _) ->
4731 if conf
.presentation
4732 && (existsinrow l.pageno cl
4733 (fun l -> l.pageh
> l.pagey + l.pagevh))
4735 let y = clamp (pgscale state
.winh
) in
4738 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4739 gotoghyll (getpagey
pageno)
4741 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4743 let pagey, pageh
= getpageyh
l.pageno in
4744 let pagey = pagey + pageh
* l.pagecol
in
4745 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4746 gotoghyll (pagey + pageh
+ ips)
4750 match state
.layout with
4752 let pageno = page_of_y state
.y in
4753 gotoghyll (getpagey
(pageno-1))
4755 match conf
.columns
with
4757 if conf
.presentation
&& l.pagey != 0
4759 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4761 let pageno = max
0 (l.pageno-1) in
4762 gotoghyll (getpagey
pageno)
4763 | Cmulti
((c, _, coverB
) as cl, _) ->
4764 if conf
.presentation
&&
4765 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4767 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4770 if l.pageno = state
.pagecount
- coverB
4774 let pageno = max
0 (l.pageno-decr) in
4775 gotoghyll (getpagey
pageno)
4783 let pageno = max
0 (l.pageno-1) in
4784 let pagey, pageh
= getpageyh
pageno in
4787 let pagey, pageh
= getpageyh
l.pageno in
4788 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4793 let viewkeyboard key mask
=
4795 let mode = state
.mode in
4796 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4799 G.postRedisplay "view:enttext"
4801 let ctrl = Wsi.withctrl mask
in
4803 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4808 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4810 state
.mode <- LinkNav
(Ltgendir
0);
4813 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4816 begin match state
.mstate
with
4819 G.postRedisplay "kill zoom rect";
4822 | Mscrolly
| Mscrollx
4825 begin match state
.mode with
4828 G.postRedisplay "esc leave linknav"
4832 match state
.ranchors
with
4834 | (path, password, anchor, origin
) :: rest
->
4835 state
.ranchors
<- rest
;
4836 state
.anchor <- anchor;
4837 state
.origin
<- origin
;
4838 state
.nameddest
<- E.s;
4839 opendoc path password
4844 gotoghyll (getnav ~
-1)
4855 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4856 G.postRedisplay "dehighlight";
4858 | @slash
| @question
->
4859 let ondone isforw
s =
4860 cbput state
.hists
.pat
s;
4861 state
.searchpattern
<- s;
4864 let s = String.make
1 (Char.chr
key) in
4865 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4866 textentry, ondone (key = @slash
), true)
4868 | @plus
| @kpplus
| @equals
when ctrl ->
4869 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4870 setzoom (conf
.zoom +. incr)
4872 | @plus
| @kpplus
->
4875 try int_of_string
s with exc
->
4876 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4882 state
.text <- "page bias is now " ^ string_of_int
n;
4885 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4887 | @minus
| @kpminus
when ctrl ->
4888 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4889 setzoom (max
0.01 (conf
.zoom -. decr))
4891 | @minus
| @kpminus
->
4892 let ondone msg
= state
.text <- msg
in
4894 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4895 optentry state
.mode, ondone, true
4906 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4908 match conf
.columns
with
4909 | Csingle
_ | Cmulti
_ -> 1
4910 | Csplit
(n, _) -> n
4912 let h = state
.winh
-
4913 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4915 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4916 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4921 match conf
.fitmodel
with
4922 | FitWidth
-> FitProportional
4923 | FitProportional
-> FitPage
4924 | FitPage
-> FitWidth
4926 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4927 reqlayout conf
.angle
fm
4935 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4936 when not
ctrl -> (* 0..9 *)
4939 try int_of_string
s with exc
->
4940 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4946 cbput state
.hists
.pag
(string_of_int
n);
4947 gotopage1 (n + conf
.pagebias
- 1) 0;
4950 let pageentry text key =
4951 match Char.unsafe_chr
key with
4952 | '
g'
-> TEdone
text
4953 | _ -> intentry text key
4955 let text = String.make
1 (Char.chr
key) in
4956 enttext (":", text, Some
(onhist state
.hists
.pag
),
4957 pageentry, ondone, true)
4960 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4961 reshape state
.winw state
.winh
;
4964 state
.bzoom
<- not state
.bzoom
;
4966 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4969 conf
.hlinks
<- not conf
.hlinks
;
4970 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4971 G.postRedisplay "toggle highlightlinks";
4974 state
.glinks
<- true;
4975 let mode = state
.mode in
4976 state
.mode <- Textentry
(
4977 (":", E.s, None
, linknentry, linkndone gotounder, false),
4979 state
.glinks
<- false;
4983 G.postRedisplay "view:linkent(F)"
4986 state
.glinks
<- true;
4987 let mode = state
.mode in
4988 state
.mode <- Textentry
(
4990 ":", E.s, None
, linknentry, linkndone (fun under ->
4991 selstring (undertext under);
4995 state
.glinks
<- false;
4999 G.postRedisplay "view:linkent"
5002 begin match state
.autoscroll
with
5004 conf
.autoscrollstep
<- step
;
5005 state
.autoscroll
<- None
5007 if conf
.autoscrollstep
= 0
5008 then state
.autoscroll
<- Some
1
5009 else state
.autoscroll
<- Some conf
.autoscrollstep
5016 setpresentationmode (not conf
.presentation
);
5017 showtext ' '
("presentation mode " ^
5018 if conf
.presentation
then "on" else "off");
5021 if List.mem
Wsi.Fullscreen state
.winstate
5022 then Wsi.reshape conf
.cwinw conf
.cwinh
5023 else Wsi.fullscreen
()
5026 search state
.searchpattern
false
5029 search state
.searchpattern
true
5032 begin match state
.layout with
5035 gotoghyll (getpagey
l.pageno)
5041 | @delete
| @kpdelete
-> (* delete *)
5045 showtext ' '
(describe_location ());
5048 begin match state
.layout with
5051 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5056 enterbookmarkmode ()
5064 | @e when Buffer.length state
.errmsgs
> 0 ->
5069 match state
.layout with
5074 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5077 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5081 showtext ' '
"Quick bookmark added";
5084 begin match state
.layout with
5086 let rect = getpdimrect
l.pagedimno
in
5090 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5091 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5093 (truncate
(rect.(1) -. rect.(0)),
5094 truncate
(rect.(3) -. rect.(0)))
5096 let w = truncate
((float w)*.conf
.zoom)
5097 and h = truncate
((float h)*.conf
.zoom) in
5100 state
.anchor <- getanchor
();
5101 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5103 G.postRedisplay "z";
5108 | @x -> state
.roam
()
5111 reqlayout (conf
.angle
+
5112 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5116 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5118 G.postRedisplay "brightness";
5120 | @c when state
.mode = View
->
5125 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5127 gotoy_and_clear_text state
.y
5131 match state
.prevcolumns
with
5132 | None
-> (1, 0, 0), 1.0
5133 | Some
(columns
, z
) ->
5136 | Csplit
(c, _) -> -c, 0, 0
5137 | Cmulti
((c, a, b), _) -> c, a, b
5138 | Csingle
_ -> 1, 0, 0
5142 setcolumns View
c a b;
5145 | @down
| @up
when ctrl && Wsi.withshift mask
->
5146 let zoom, x = state
.prevzoom
in
5150 | @k
| @up
| @kpup
->
5151 begin match state
.autoscroll
with
5153 begin match state
.mode with
5154 | Birdseye beye
-> upbirdseye 1 beye
5159 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5161 if not
(Wsi.withshift mask
) && conf
.presentation
5163 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5167 setautoscrollspeed n false
5170 | @j
| @down
| @kpdown
->
5171 begin match state
.autoscroll
with
5173 begin match state
.mode with
5174 | Birdseye beye
-> downbirdseye 1 beye
5179 then gotoy_and_clear_text (clamp (state
.winh
/2))
5181 if not
(Wsi.withshift mask
) && conf
.presentation
5183 else gotoghyll1 true (clamp (conf
.scrollstep
))
5187 setautoscrollspeed n true
5190 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5196 else conf
.hscrollstep
5198 let dx = if key = @left || key = @kpleft
then dx else -dx in
5199 state
.x <- panbound (state
.x + dx);
5200 gotoy_and_clear_text state
.y
5203 G.postRedisplay "left/right"
5206 | @prior
| @kpprior
->
5210 match state
.layout with
5212 | l :: _ -> state
.y - l.pagey
5214 clamp (pgscale (-state
.winh
))
5218 | @next | @kpnext
->
5222 match List.rev state
.layout with
5224 | l :: _ -> getpagey
l.pageno
5226 clamp (pgscale state
.winh
)
5230 | @g | @home
| @kphome
->
5233 | @G
| @jend
| @kpend
->
5235 gotoghyll (clamp state
.maxy)
5237 | @right
| @kpright
when Wsi.withalt mask
->
5238 gotoghyll (getnav 1)
5239 | @left | @kpleft
when Wsi.withalt mask
->
5240 gotoghyll (getnav ~
-1)
5245 | @v when conf
.debug
->
5248 match getopaque l.pageno with
5251 let x0, y0, x1, y1 = pagebbox
opaque in
5252 let a,b = float x0, float y0 in
5253 let c,d = float x1, float y0 in
5254 let e,f = float x1, float y1 in
5255 let h,j
= float x0, float y1 in
5256 let rect = (a,b,c,d,e,f,h,j
) in
5258 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5260 G.postRedisplay "v";
5263 let mode = state
.mode in
5264 let cmd = ref E.s in
5265 let onleave = function
5266 | Cancel
-> state
.mode <- mode
5269 match getopaque l.pageno with
5270 | Some
opaque -> pipesel opaque !cmd
5271 | None
-> ()) state
.layout;
5275 cbput state
.hists
.sel
s;
5279 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5281 G.postRedisplay "|";
5282 state
.mode <- Textentry
(te, onleave);
5285 vlog "huh? %s" (Wsi.keyname
key)
5288 let linknavkeyboard key mask
linknav =
5289 let getpage pageno =
5290 let rec loop = function
5292 | l :: _ when l.pageno = pageno -> Some
l
5293 | _ :: rest
-> loop rest
5294 in loop state
.layout
5296 let doexact (pageno, n) =
5297 match getopaque pageno, getpage pageno with
5298 | Some
opaque, Some
l ->
5299 if key = @enter
|| key = @kpenter
5301 let under = getlink
opaque n in
5302 G.postRedisplay "link gotounder";
5309 Some
(findlink
opaque LDfirst
), -1
5312 Some
(findlink
opaque LDlast
), 1
5315 Some
(findlink
opaque (LDleft
n)), -1
5318 Some
(findlink
opaque (LDright
n)), 1
5321 Some
(findlink
opaque (LDup
n)), -1
5324 Some
(findlink
opaque (LDdown
n)), 1
5329 begin match findpwl
l.pageno dir with
5333 state
.mode <- LinkNav
(Ltgendir
dir);
5334 let y, h = getpageyh
pageno in
5337 then y + h - state
.winh
5342 begin match getopaque pageno, getpage pageno with
5343 | Some
opaque, Some
_ ->
5345 let ld = if dir > 0 then LDfirst
else LDlast
in
5348 begin match link with
5350 showlinktype (getlink
opaque m);
5351 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5352 G.postRedisplay "linknav jpage";
5353 | Lnotfound
-> notfound dir
5359 begin match opt with
5360 | Some Lnotfound
-> pwl l dir;
5361 | Some
(Lfound
m) ->
5365 let _, y0, _, y1 = getlinkrect
opaque m in
5367 then gotopage1 l.pageno y0
5369 let d = fstate
.fontsize
+ 1 in
5370 if y1 - l.pagey > l.pagevh - d
5371 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5372 else G.postRedisplay "linknav";
5374 showlinktype (getlink
opaque m);
5375 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5378 | None
-> viewkeyboard key mask
5380 | _ -> viewkeyboard key mask
5385 G.postRedisplay "leave linknav"
5389 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5390 | Ltexact exact
-> doexact exact
5393 let keyboard key mask
=
5394 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5395 then wcmd "interrupt"
5396 else state
.uioh <- state
.uioh#
key key mask
5399 let birdseyekeyboard key mask
5400 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5402 match conf
.columns
with
5404 | Cmulti
((c, _, _), _) -> c
5405 | Csplit
_ -> failwith
"bird's eye split mode"
5407 let pgh layout = List.fold_left
5408 (fun m l -> max
l.pageh
m) state
.winh
layout in
5410 | @l when Wsi.withctrl mask
->
5411 let y, h = getpageyh
pageno in
5412 let top = (state
.winh
- h) / 2 in
5413 gotoy (max
0 (y - top))
5414 | @enter
| @kpenter
-> leavebirdseye beye
false
5415 | @escape
-> leavebirdseye beye
true
5416 | @up
-> upbirdseye incr beye
5417 | @down
-> downbirdseye incr beye
5418 | @left -> upbirdseye 1 beye
5419 | @right
-> downbirdseye 1 beye
5422 begin match state
.layout with
5426 state
.mode <- Birdseye
(
5427 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5429 gotopage1 l.pageno 0;
5432 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5434 | [] -> gotoy (clamp (-state
.winh
))
5436 state
.mode <- Birdseye
(
5437 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5439 gotopage1 l.pageno 0
5442 | [] -> gotoy (clamp (-state
.winh
))
5446 begin match List.rev state
.layout with
5448 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5449 begin match layout with
5451 let incr = l.pageh
- l.pagevh in
5456 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5458 G.postRedisplay "birdseye pagedown";
5460 else gotoy (clamp (incr + conf
.interpagespace
*2));
5464 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5465 gotopage1 l.pageno 0;
5468 | [] -> gotoy (clamp state
.winh
)
5472 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5476 let pageno = state
.pagecount
- 1 in
5477 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5478 if not
(pagevisible state
.layout pageno)
5481 match List.rev state
.pdims
with
5483 | (_, _, h, _) :: _ -> h
5485 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5486 else G.postRedisplay "birdseye end";
5488 | _ -> viewkeyboard key mask
5493 match state
.mode with
5494 | Textentry
_ -> scalecolor 0.4
5496 | View
-> scalecolor 1.0
5497 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5498 if l.pageno = hooverpageno
5501 if l.pageno = pageno
5503 let c = scalecolor 1.0 in
5505 GlDraw.line_width
3.0;
5506 let dispx = xadjsb () + l.pagedispx in
5508 (float (dispx-1)) (float (l.pagedispy-1))
5509 (float (dispx+l.pagevw+1))
5510 (float (l.pagedispy+l.pagevh+1))
5512 GlDraw.line_width
1.0;
5521 let postdrawpage l linkindexbase
=
5522 match getopaque l.pageno with
5524 if tileready l l.pagex
l.pagey
5526 let x = l.pagedispx - l.pagex
+ xadjsb ()
5527 and y = l.pagedispy - l.pagey in
5529 match conf
.columns
with
5530 | Csingle
_ | Cmulti
_ ->
5531 (if conf
.hlinks
then 1 else 0)
5533 && not
(isbirdseye state
.mode) then 2 else 0)
5537 match state
.mode with
5538 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5544 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5549 let scrollindicator () =
5550 let sbw, ph
, sh = state
.uioh#
scrollph in
5551 let sbh, pw, sw = state
.uioh#scrollpw
in
5556 else ((state
.winw
- sbw), state
.winw
, 0)
5559 GlDraw.color (0.64, 0.64, 0.64);
5560 filledrect (float x0) 0. (float x1) (float state
.winh
);
5562 (float hx0
) (float (state
.winh
- sbh))
5563 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5565 GlDraw.color (0.0, 0.0, 0.0);
5567 filledrect (float x0) ph
(float x1) (ph
+. sh);
5568 let pw = pw +. float hx0
in
5569 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5573 match state
.mstate
with
5574 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5577 | Msel
((x0, y0), (x1, y1)) ->
5578 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5579 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5580 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5581 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5584 let showrects = function [] -> () | rects
->
5586 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5587 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5589 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5591 if l.pageno = pageno
5593 let dx = float (l.pagedispx - l.pagex
) in
5594 let dy = float (l.pagedispy - l.pagey) in
5595 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5596 Raw.sets_float state
.vraw ~
pos:0
5601 GlArray.vertex `two state
.vraw
;
5602 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5611 GlClear.color (scalecolor2 conf
.bgcolor
);
5612 GlClear.clear
[`
color];
5613 List.iter
drawpage state
.layout;
5615 match state
.mode with
5616 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5617 begin match getopaque pageno with
5619 let dx = xadjsb () in
5620 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5621 let x0 = x0 + dx and x1 = x1 + dx in
5628 | None
-> state
.rects
5630 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5633 | View
-> state
.rects
5636 let rec postloop linkindexbase
= function
5638 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5639 postloop linkindexbase rest
5643 postloop 0 state
.layout;
5645 begin match state
.mstate
with
5646 | Mzoomrect
((x0, y0), (x1, y1)) ->
5648 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5649 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5650 filledrect (float x0) (float y0) (float x1) (float y1);
5654 | Mscrolly
| Mscrollx
5663 let zoomrect x y x1 y1 =
5666 and y0 = min
y y1 in
5667 gotoy (state
.y + y0);
5668 state
.anchor <- getanchor
();
5669 let zoom = (float state
.w) /. float (x1 - x0) in
5672 let adjw = wadjsb () + state
.winw
in
5674 then (adjw - state
.w) / 2
5677 match conf
.fitmodel
with
5678 | FitWidth
| FitProportional
-> simple ()
5680 match conf
.columns
with
5682 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5683 | Cmulti
_ | Csingle
_ -> simple ()
5685 state
.x <- (state
.x + margin) - x0;
5691 let g opaque l px py =
5692 match rectofblock
opaque px py with
5694 let x0 = a.(0) -. 20. in
5695 let x1 = a.(1) +. 20. in
5696 let y0 = a.(2) -. 20. in
5697 let zoom = (float state
.w) /. (x1 -. x0) in
5698 let pagey = getpagey
l.pageno in
5699 gotoy_and_clear_text (pagey + truncate
y0);
5700 state
.anchor <- getanchor
();
5701 let margin = (state
.w - l.pagew
)/2 in
5702 state
.x <- -truncate
x0 - margin;
5707 match conf
.columns
with
5709 showtext '
!'
"block zooming does not work properly in split columns mode"
5710 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5714 let winw = wadjsb () + state
.winw - 1 in
5715 let s = float x /. float winw in
5716 let destx = truncate
(float (state
.w + winw) *. s) in
5717 state
.x <- winw - destx;
5718 gotoy_and_clear_text state
.y;
5719 state
.mstate
<- Mscrollx
;
5723 let s = float y /. float state
.winh
in
5724 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5725 gotoy_and_clear_text desty;
5726 state
.mstate
<- Mscrolly
;
5729 let viewmulticlick clicks
x y mask
=
5730 let g opaque l px py =
5738 if markunder
opaque px py mark
5742 match getopaque l.pageno with
5744 | Some
opaque -> pipesel opaque cmd
5746 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5747 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5752 G.postRedisplay "viewmulticlick";
5753 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5757 match conf
.columns
with
5759 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5762 let viewmouse button down
x y mask
=
5764 | n when (n == 4 || n == 5) && not down
->
5765 if Wsi.withctrl mask
5767 match state
.mstate
with
5768 | Mzoom
(oldn
, i
) ->
5776 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5778 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5780 let zoom = conf
.zoom -. incr in
5782 state
.mstate
<- Mzoom
(n, 0);
5784 state
.mstate
<- Mzoom
(n, i
+1);
5786 else state
.mstate
<- Mzoom
(n, 0)
5790 | Mscrolly
| Mscrollx
5792 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5795 match state
.autoscroll
with
5796 | Some step
-> setautoscrollspeed step
(n=4)
5798 if conf
.wheelbypage
|| conf
.presentation
5807 then -conf
.scrollstep
5808 else conf
.scrollstep
5810 let incr = incr * 2 in
5811 let y = clamp incr in
5812 gotoy_and_clear_text y
5815 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5817 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5818 gotoy_and_clear_text state
.y
5820 | 1 when Wsi.withshift mask
->
5821 state
.mstate
<- Mnone
;
5824 match unproject x y with
5825 | Some
(pageno, ux
, uy
) ->
5826 let cmd = Printf.sprintf
5828 conf
.stcmd state
.path pageno ux uy
5834 | 1 when Wsi.withctrl mask
->
5837 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5838 state
.mstate
<- Mpan
(x, y)
5841 state
.mstate
<- Mnone
5846 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5848 state
.mstate
<- Mzoomrect
(p, p)
5851 match state
.mstate
with
5852 | Mzoomrect
((x0, y0), _) ->
5853 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5854 then zoomrect x0 y0 x y
5857 G.postRedisplay "kill accidental zoom rect";
5861 | Mscrolly
| Mscrollx
5867 | 1 when x > state
.winw - vscrollw () ->
5870 let _, position, sh = state
.uioh#
scrollph in
5871 if y > truncate
position && y < truncate
(position +. sh)
5872 then state
.mstate
<- Mscrolly
5875 state
.mstate
<- Mnone
5877 | 1 when y > state
.winh
- hscrollh () ->
5880 let _, position, sw = state
.uioh#scrollpw
in
5881 if x > truncate
position && x < truncate
(position +. sw)
5882 then state
.mstate
<- Mscrollx
5885 state
.mstate
<- Mnone
5887 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5890 let dest = if down
then getunder x y else Unone
in
5891 begin match dest with
5894 | Uremote
_ | Uremotedest
_
5895 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5898 | Unone
when down
->
5899 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5900 state
.mstate
<- Mpan
(x, y);
5902 | Uannotation contents
-> enterannotmode contents
5904 | Unone
| Utext
_ ->
5909 state
.mstate
<- Msel
((x, y), (x, y));
5910 G.postRedisplay "mouse select";
5914 match state
.mstate
with
5917 | Mzoom
_ | Mscrollx
| Mscrolly
->
5918 state
.mstate
<- Mnone
5920 | Mzoomrect
((x0, y0), _) ->
5924 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5925 state
.mstate
<- Mnone
5927 | Msel
((x0, y0), (x1, y1)) ->
5928 let rec loop = function
5932 let a0 = l.pagedispy in
5933 let a1 = a0 + l.pagevh in
5934 let b0 = l.pagedispx in
5935 let b1 = b0 + l.pagevw in
5936 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5937 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5941 match getopaque l.pageno with
5944 match Unix.pipe
() with
5948 "can not create sel pipe: %s"
5952 Ne.clo fd
(fun msg
->
5953 dolog
"%s close failed: %s" what msg
)
5956 try popen
cmd [r, 0; w, -1]; true
5958 dolog
"can not execute %S: %s"
5965 G.postRedisplay "copysel";
5967 else clo "Msel pipe/w" w;
5968 clo "Msel pipe/r" r;
5970 dosel conf
.selcmd
();
5971 state
.roam
<- dosel conf
.paxcmd
;
5983 let birdseyemouse button down
x y mask
5984 (conf
, leftx
, _, hooverpageno
, anchor) =
5987 let rec loop = function
5990 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5991 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5993 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5999 | _ -> viewmouse button down
x y mask
6005 method key key mask
=
6006 begin match state
.mode with
6007 | Textentry
textentry -> textentrykeyboard key mask
textentry
6008 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6009 | View
-> viewkeyboard key mask
6010 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6014 method button button bstate
x y mask
=
6015 begin match state
.mode with
6017 | View
-> viewmouse button bstate
x y mask
6018 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6023 method multiclick clicks
x y mask
=
6024 begin match state
.mode with
6026 | View
-> viewmulticlick clicks
x y mask
6033 begin match state
.mode with
6035 | View
| Birdseye
_ | LinkNav
_ ->
6036 match state
.mstate
with
6037 | Mzoom
_ | Mnone
-> ()
6042 state
.mstate
<- Mpan
(x, y);
6044 then state
.x <- panbound (state
.x + dx);
6046 gotoy_and_clear_text y
6049 state
.mstate
<- Msel
(a, (x, y));
6050 G.postRedisplay "motion select";
6053 let y = min state
.winh
(max
0 y) in
6057 let x = min state
.winw (max
0 x) in
6060 | Mzoomrect
(p0
, _) ->
6061 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6062 G.postRedisplay "motion zoomrect";
6066 method pmotion
x y =
6067 begin match state
.mode with
6068 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6069 let rec loop = function
6071 if hooverpageno
!= -1
6073 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6074 G.postRedisplay "pmotion birdseye no hoover";
6077 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6078 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6080 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6081 G.postRedisplay "pmotion birdseye hoover";
6091 match state
.mstate
with
6092 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
6101 let past, _, _ = !r in
6103 let delta = now -. past in
6106 else r := (now, x, y)
6110 method infochanged
_ = ()
6113 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6116 then 0.0, float state
.winh
6117 else scrollph state
.y maxy
6122 let winw = wadjsb () + state
.winw in
6123 let fwinw = float winw in
6125 let sw = fwinw /. float state
.w in
6126 let sw = fwinw *. sw in
6127 max
sw (float conf
.scrollh
)
6130 let maxx = state
.w + winw in
6131 let x = winw - state
.x in
6132 let percent = float x /. float maxx in
6133 (fwinw -. sw) *. percent
6135 hscrollh (), position, sw
6139 match state
.mode with
6140 | LinkNav
_ -> "links"
6141 | Textentry
_ -> "textentry"
6142 | Birdseye
_ -> "birdseye"
6145 findkeyhash conf
modename
6147 method eformsgs
= true
6148 method alwaysscrolly
= false
6151 let adderrmsg src msg
=
6152 Buffer.add_string state
.errmsgs msg
;
6153 state
.newerrmsgs
<- true;
6157 let adderrfmt src fmt
=
6158 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6162 let cl = splitatspace cmds
in
6164 try Scanf.sscanf
s fmt
f
6166 adderrfmt "remote exec"
6167 "error processing '%S': %s\n" cmds
(exntos exn
)
6170 | "reload" :: [] -> reload ()
6171 | "goto" :: args
:: [] ->
6172 scan args
"%u %f %f"
6174 let cmd, _ = state
.geomcmds
in
6176 then gotopagexy pageno x y
6179 gotopagexy pageno x y;
6182 state
.reprf
<- f state
.reprf
6184 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6185 | "gotor" :: args
:: [] ->
6187 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6188 | "gotord" :: args
:: [] ->
6190 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6191 | "rect" :: args
:: [] ->
6192 scan args
"%u %u %f %f %f %f"
6193 (fun pageno color x0 y0 x1 y1 ->
6194 onpagerect pageno (fun w h ->
6195 let _,w1,h1
,_ = getpagedim
pageno in
6196 let sw = float w1 /. float w
6197 and sh = float h1
/. float h in
6201 and y1s
= y1 *. sh in
6202 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6204 state
.rects <- (pageno, color, rect) :: state
.rects;
6205 G.postRedisplay "rect";
6208 | "activatewin" :: [] -> Wsi.activatewin
()
6209 | "quit" :: [] -> raise Quit
6211 adderrfmt "remote command"
6212 "error processing remote command: %S\n" cmds
;
6216 let scratch = Bytes.create
80 in
6217 let buf = Buffer.create
80 in
6220 try Some
(Unix.read fd
scratch 0 80)
6222 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6223 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6226 match tempfr () with
6232 if Buffer.length
buf > 0
6234 let s = Buffer.contents
buf in
6244 let pos = Bytes.index_from
scratch ppos '
\n'
in
6245 if pos >= n then -1 else pos
6246 with Not_found
-> -1
6250 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6251 let s = Buffer.contents
buf in
6257 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6263 let remoteopen path =
6264 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6266 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6271 let gcconfig = ref E.s in
6272 let trimcachepath = ref E.s in
6273 let rcmdpath = ref E.s in
6274 let pageno = ref None
in
6275 let rootwid = ref 0 in
6276 let openlast = ref false in
6277 let nofc = ref false in
6278 selfexec := Sys.executable_name
;
6281 [("-p", Arg.String
(fun s -> state
.password <- s),
6282 "<password> Set password");
6286 Config.fontpath
:= s;
6287 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6289 "<path> Set path to the user interface font");
6293 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6294 Config.confpath
:= s),
6295 "<path> Set path to the configuration file");
6297 ("-last", Arg.Set
openlast, " Open last document");
6299 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6300 "<page-number> Jump to page");
6302 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6303 "<path> Set path to the trim cache file");
6305 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6306 "<named-destination> Set named destination");
6308 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6309 ("-cxack", Arg.Set
cxack, " Cut corners");
6311 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6312 "<path> Set path to the remote commands source");
6314 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6315 "<original-path> Set original path");
6317 ("-gc", Arg.Set_string
gcconfig,
6318 "<script-path> Collect garbage with the help of a script");
6320 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6322 ("-v", Arg.Unit
(fun () ->
6324 "%s\nconfiguration path: %s\n"
6328 exit
0), " Print version and exit");
6330 ("-embed", Arg.Set_int
rootwid,
6331 "<window-id> Embed into window")
6334 (fun s -> state
.path <- s)
6335 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6338 then selfexec := !selfexec ^
" -wtmode";
6340 let histmode = emptystr state
.path && not
!openlast in
6342 if not
(Config.load !openlast)
6343 then prerr_endline
"failed to load configuration";
6344 begin match !pageno with
6345 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6349 if not
(emptystr
!gcconfig)
6352 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6354 error
"gc socketpair failed: %s" (exntos exn
)
6357 match popen
!gcconfig [(c, 0); (c, 1)] with
6362 error
"failed to popen gc script: %s" (exntos exn
);
6365 let wsfd, winw, winh
= Wsi.init
(object (self)
6366 val mutable m_clicks
= 0
6367 val mutable m_click_x
= 0
6368 val mutable m_click_y
= 0
6369 val mutable m_lastclicktime
= infinity
6371 method private cleanup
=
6372 state
.roam
<- noroam
;
6373 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6374 method expose
= G.postRedisplay"expose"
6378 | Wsi.Unobscured
-> "unobscured"
6379 | Wsi.PartiallyObscured
-> "partiallyobscured"
6380 | Wsi.FullyObscured
-> "fullyobscured"
6382 vlog "visibility change %s" name
6383 method display = display ()
6384 method map mapped
= vlog "mappped %b" mapped
6385 method reshape w h =
6388 method mouse
b d x y m =
6389 if d && canselect ()
6391 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6397 if abs
x - m_click_x
> 10
6398 || abs
y - m_click_y
> 10
6399 || abs_float
(t -. m_lastclicktime
) > 0.3
6401 m_clicks
<- m_clicks
+ 1;
6402 m_lastclicktime
<- t;
6406 G.postRedisplay "cleanup";
6407 state
.uioh <- state
.uioh#button
b d x y m;
6409 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6414 m_lastclicktime
<- infinity
;
6415 state
.uioh <- state
.uioh#button
b d x y m
6419 state
.uioh <- state
.uioh#button
b d x y m
6422 state
.mpos
<- (x, y);
6423 state
.uioh <- state
.uioh#motion
x y
6424 method pmotion
x y =
6425 state
.mpos
<- (x, y);
6426 state
.uioh <- state
.uioh#pmotion
x y
6428 let mascm = m land (
6429 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6432 let x = state
.x and y = state
.y in
6434 if x != state
.x || y != state
.y then self#cleanup
6436 match state
.keystate
with
6438 let km = k
, mascm in
6441 let modehash = state
.uioh#
modehash in
6442 try Hashtbl.find modehash km
6444 try Hashtbl.find (findkeyhash conf
"global") km
6445 with Not_found
-> KMinsrt
(k
, m)
6447 | KMinsrt
(k
, m) -> keyboard k
m
6448 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6449 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6451 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6452 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6453 state
.keystate
<- KSnone
6454 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6455 state
.keystate
<- KSinto
(keys
, insrt
)
6456 | KSinto
_ -> state
.keystate
<- KSnone
6459 state
.mpos
<- (x, y);
6460 state
.uioh <- state
.uioh#pmotion
x y
6461 method leave = state
.mpos
<- (-1, -1)
6462 method winstate wsl
= state
.winstate
<- wsl
6463 method quit
= raise Quit
6464 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6469 List.exists
GlMisc.check_extension
6470 [ "GL_ARB_texture_rectangle"
6471 ; "GL_EXT_texture_recangle"
6472 ; "GL_NV_texture_rectangle" ]
6474 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6477 let r = GlMisc.get_string `renderer
in
6478 let p = "Mesa DRI Intel(" in
6479 let l = String.length
p in
6480 String.length
r > l && String.sub
r 0 l = p
6483 defconf
.sliceheight
<- 1024;
6484 defconf
.texcount
<- 32;
6485 defconf
.usepbo
<- true;
6489 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6491 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6499 setcheckers conf
.checkers
;
6501 if conf
.redirectstderr
6505 (Buffer.to_bytes state
.errmsgs
)
6506 (match state
.errfd
with
6508 let s = Bytes.create
(80*24) in
6511 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6513 then Unix.read fd
s 0 (Bytes.length
s)
6519 else Bytes.sub
s 0 n
6523 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6524 with exn
-> print_endline
(exntos exn
)
6529 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6530 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6531 !Config.fontpath
, !trimcachepath,
6532 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6535 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6541 Wsi.settitle
"llpp (history)";
6545 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6546 opendoc state
.path state
.password;
6551 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6554 if nonemptystr
!rcmdpath
6555 then remoteopen !rcmdpath
6560 let rec loop deadline
=
6562 match state
.errfd
with
6563 | None
-> [state
.ss; state
.wsfd]
6564 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6569 | Some fd
-> fd
:: r
6573 state
.redisplay
<- false;
6580 if deadline
= infinity
6582 else max
0.0 (deadline
-. now)
6587 try Unix.select
r [] [] timeout
6588 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6594 if state
.ghyll
== noghyll
6596 match state
.autoscroll
with
6597 | Some step
when step
!= 0 ->
6598 let y = state
.y + step
in
6602 else if y >= state
.maxy then 0 else y
6605 if state
.mode = View
6606 then state
.text <- E.s;
6609 else deadline
+. 0.01
6614 let rec checkfds = function
6616 | fd
:: rest
when fd
= state
.ss ->
6617 let cmd = readcmd state
.ss in
6621 | fd
:: rest
when fd
= state
.wsfd ->
6625 | fd
:: rest
when Some fd
= !optrfd ->
6626 begin match remote fd
with
6627 | None
-> optrfd := remoteopen !rcmdpath;
6628 | opt -> optrfd := opt
6633 let s = Bytes.create
80 in
6634 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6635 if conf
.redirectstderr
6637 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6638 state
.newerrmsgs
<- true;
6639 state
.redisplay
<- true;
6642 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6648 if !reeenterhist then (
6650 reeenterhist := false;
6654 if deadline
= infinity
6658 match state
.autoscroll
with
6659 | Some step
when step
!= 0 -> deadline1
6660 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6668 Config.save
leavebirdseye;