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
1005 state
.mode
<- LinkNav
(Ltgendir
0)
1007 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1008 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1009 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1010 then state
.mode
<- LinkNav
(Ltgendir
0)
1012 | _
:: rest
-> loop rest
1021 begin match state
.mode
with
1022 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1023 if not
(pagevisible layout pageno
)
1025 match state
.layout with
1028 state
.mode
<- Birdseye
(
1029 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1036 let rec loop = function
1039 match getopaque l.pageno
with
1045 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1047 if dir
> 0 then LDfirst
else LDlast
1053 | Lnotfound
-> loop rest
1055 showlinktype (getlink opaque
n);
1056 Ltexact
(l.pageno
, n)
1060 state
.mode
<- LinkNav
linknav
1068 state
.ghyll
<- noghyll
;
1071 let mx, my
= state
.mpos
in
1076 let conttiling pageno opaque
=
1077 tilepage pageno opaque
1078 (if conf
.preload then preloadlayout state
.y else state
.layout)
1081 let gotoy_and_clear_text y =
1082 if not conf
.verbose
then state
.text <- E.s;
1086 let getanchory (n, top
, dtop
) =
1087 let y, h = getpageyh
n in
1088 if conf
.presentation
1090 let ips = calcips
h in
1091 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1093 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1096 let gotoanchor anchor
=
1097 gotoy (getanchory anchor
);
1101 cbput state
.hists
.nav
(getanchor
());
1105 let anchor = cbgetc state
.hists
.nav dir
in
1109 let gotoghyll1 single
y =
1110 let scroll f n a
b =
1111 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1113 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1115 then s (float f /. float a
)
1118 then 1.0 -. s ((float (f-b) /. float (n-b)))
1124 let ins = float a
*. 0.5
1125 and outs
= float (n-b) *. 0.5 in
1127 ins +. outs
+. float ones
1129 let rec set nab
y sy
=
1130 let (_N
, _A
, _B
), y =
1133 let scl = if y > sy
then 2 else -2 in
1134 let _N, _
, _
= nab
in
1135 (_N,0,_N), y+conf
.scrollstep
*scl
1137 let sum = summa
_N _A _B
in
1138 let dy = float (y - sy
) in
1142 then state
.ghyll
<- noghyll
1145 let s = scroll n _N _A _B
in
1146 let y1 = y1 +. ((s *. dy) /. sum) in
1147 gotoy_and_clear_text (truncate
y1);
1148 state
.ghyll
<- gf (n+1) y1;
1152 | Some
y'
when single
-> set nab
y' state
.y
1153 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1155 gf 0 (float state
.y)
1158 match conf
.ghyllscroll
with
1159 | Some nab
when not conf
.presentation
->
1160 if state
.ghyll
== noghyll
1161 then set nab
y state
.y
1162 else state
.ghyll
(Some
y)
1164 gotoy_and_clear_text y
1167 let gotoghyll = gotoghyll1 false;;
1169 let gotopage n top
=
1170 let y, h = getpageyh
n in
1171 let y = y + (truncate
(top
*. float h)) in
1175 let gotopage1 n top
=
1176 let y = getpagey
n in
1181 let invalidate s f =
1186 match state
.geomcmds
with
1187 | ps
, [] when emptystr ps
->
1189 state
.geomcmds
<- s, [];
1192 state
.geomcmds
<- ps
, [s, f];
1194 | ps
, (s'
, _
) :: rest
when s'
= s ->
1195 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1198 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1202 Hashtbl.iter
(fun _ opaque
->
1203 wcmd "freepage %s" (~
> opaque
);
1205 Hashtbl.clear state
.pagemap
;
1209 if not
(Queue.is_empty state
.tilelru
)
1211 Queue.iter
(fun (k
, p
, s) ->
1212 wcmd "freetile %s" (~
> p
);
1213 state
.memused
<- state
.memused
- s;
1214 Hashtbl.remove state
.tilemap k
;
1216 state
.uioh#infochanged Memused
;
1217 Queue.clear state
.tilelru
;
1223 let h = truncate
(float h*.conf
.zoom
) in
1224 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1228 let opendoc path password
=
1230 state
.password
<- password
;
1231 state
.gen
<- state
.gen
+ 1;
1232 state
.docinfo
<- [];
1233 state
.outlines
<- [||];
1236 setaalevel conf
.aalevel
;
1238 if emptystr state
.origin
1242 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1243 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1244 invalidate "reqlayout"
1246 wcmd "reqlayout %d %d %d %s\000"
1247 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1248 (stateh state
.winh
) state
.nameddest
1253 state
.anchor <- getanchor
();
1254 opendoc state
.path state
.password
;
1258 let c = c *. conf
.colorscale
in
1262 let scalecolor2 (r
, g, b) =
1263 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1266 let docolumns columns
=
1267 let wadj = wadjsb () in
1270 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1271 let wadj = wadjsb () in
1272 let rec loop pageno
pdimno pdim
y ph pdims
=
1273 if pageno
= state
.pagecount
1276 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1278 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1279 pdimno+1, pdim
, rest
1283 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1285 (if conf
.presentation
1286 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1287 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1290 a.(pageno
) <- (pdimno, x, y, pdim
);
1291 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1293 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1294 conf
.columns
<- Csingle
a;
1296 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1297 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1298 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1299 let rec fixrow m
= if m
= pageno
then () else
1300 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1303 let y = y + (rowh
- h) / 2 in
1304 a.(m
) <- (pdimno, x, y, pdim
);
1308 if pageno
= state
.pagecount
1309 then fixrow (((pageno
- 1) / columns
) * columns
)
1311 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1313 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1314 pdimno+1, pdim
, rest
1319 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1321 let x = (wadj + state
.winw
- w) / 2 in
1323 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1324 x, y + ips + rowh
, h
1327 if (pageno
- coverA
) mod columns
= 0
1329 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1331 if conf
.presentation
1333 let ips = calcips
h in
1334 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1336 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1340 else x, y, max rowh
h
1344 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1347 if pageno
= columns
&& conf
.presentation
1349 let ips = calcips rowh
in
1350 for i
= 0 to pred columns
1352 let (pdimno, x, y, pdim
) = a.(i
) in
1353 a.(i
) <- (pdimno, x, y+ips, pdim
)
1359 fixrow (pageno
- columns
);
1364 a.(pageno
) <- (pdimno, x, y, pdim
);
1365 let x = x + w + xoff
*2 + conf
.interpagespace
in
1366 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1368 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1369 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1372 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1373 let rec loop pageno
pdimno pdim
y pdims
=
1374 if pageno
= state
.pagecount
1377 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1379 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1380 pdimno+1, pdim
, rest
1385 let rec loop1 n x y =
1386 if n = c then y else (
1387 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1388 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1391 let y = loop1 0 0 y in
1392 loop (pageno
+1) pdimno pdim
y pdims
1394 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1395 conf
.columns
<- Csplit
(c, a);
1399 docolumns conf
.columns
;
1400 state
.maxy
<- calcheight
();
1401 if state
.reprf
== noreprf
1403 match state
.mode
with
1404 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1405 let y, h = getpageyh pageno
in
1406 let top = (state
.winh
- h) / 2 in
1407 gotoy (max
0 (y - top))
1410 | LinkNav _
-> gotoanchor state
.anchor
1414 state
.reprf
<- noreprf
;
1419 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1420 let firsttime = state
.geomcmds
== firstgeomcmds
in
1421 if not
firsttime && nogeomcmds state
.geomcmds
1422 then state
.anchor <- getanchor
();
1425 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1428 setfontsize fstate
.fontsize
;
1429 GlMat.mode `modelview
;
1430 GlMat.load_identity
();
1432 GlMat.mode `projection
;
1433 GlMat.load_identity
();
1434 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1435 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1436 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1441 else float state
.x /. float state
.w
1443 invalidate "geometry"
1447 then state
.x <- truncate
(relx *. float w);
1449 match conf
.columns
with
1451 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1452 | Csplit
(c, _
) -> w * c
1454 wcmd "geometry %d %d %d"
1455 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1460 let len = String.length state
.text in
1461 let x0 = xadjsb () in
1464 match state
.mode
with
1465 | Textentry _
| View
| LinkNav _
->
1466 let h, _
, _
= state
.uioh#scrollpw
in
1471 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1472 (x+.w) (float (state
.winh
- hscrollh))
1475 let w = float (wadjsb () + state
.winw
- 1) in
1476 if state
.progress
>= 0.0 && state
.progress
< 1.0
1478 GlDraw.color
(0.3, 0.3, 0.3);
1479 let w1 = w *. state
.progress
in
1481 GlDraw.color
(0.0, 0.0, 0.0);
1482 rect (float x0+.w1) (float x0+.w-.w1)
1485 GlDraw.color
(0.0, 0.0, 0.0);
1489 GlDraw.color
(1.0, 1.0, 1.0);
1490 drawstring fstate
.fontsize
1491 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1492 (state
.winh
- hscrollh - 5) s;
1495 match state
.mode
with
1496 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1500 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1502 Printf.sprintf
"%s%s_" prefix
text
1508 | LinkNav _
-> state
.text
1513 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1515 let s1 = "(press 'e' to review error messasges)" in
1516 if nonemptystr
s then s ^
" " ^
s1 else s1
1526 let len = Queue.length state
.tilelru
in
1528 match state
.throttle
with
1531 then preloadlayout state
.y
1533 | Some
(layout, _
, _
) ->
1537 if state
.memused
<= conf
.memlimit
1542 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1543 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1544 let (_
, pw, ph
, _
) = getpagedim
n in
1547 && colorspace
= conf
.colorspace
1548 && angle
= conf
.angle
1552 let x = col*conf
.tilew
1553 and y = row*conf
.tileh
in
1554 tilevisible (Lazy.force_val
layout) n x y
1556 then Queue.push lruitem state
.tilelru
1559 wcmd "freetile %s" (~
> p
);
1560 state
.memused
<- state
.memused
- s;
1561 state
.uioh#infochanged Memused
;
1562 Hashtbl.remove state
.tilemap k
;
1570 let logcurrently = function
1571 | Idle
-> dolog
"Idle"
1572 | Loading
(l, gen
) ->
1573 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1574 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1576 "Tiling %d[%d,%d] page=%s cs=%s angle"
1577 l.pageno
col row (~
> pageopaque
)
1578 (CSTE.to_string colorspace
)
1580 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1581 angle gen conf
.angle state
.gen
1583 conf
.tilew conf
.tileh
1590 let r = Str.regexp
" " in
1591 fun s -> Str.bounded_split
r s 2;
1594 let onpagerect pageno
f =
1596 match conf
.columns
with
1597 | Cmulti
(_
, b) -> b
1599 | Csplit
(_
, b) -> b
1601 if pageno
>= 0 && pageno
< Array.length
b
1603 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1607 let gotopagexy1 pageno
x y =
1608 let _,w1,h1
,leftx
= getpagedim pageno
in
1609 let top = y /. (float h1
) in
1610 let left = x /. (float w1) in
1611 let py, w, h = getpageywh pageno
in
1612 let wh = state
.winh
- hscrollh () in
1613 let x = left *. (float w) in
1614 let x = leftx
+ state
.x + truncate
x in
1615 let wadj = wadjsb () in
1617 if x < 0 || x >= wadj + state
.winw
1621 let pdy = truncate
(top *. float h) in
1622 let y'
= py + pdy in
1623 let dy = y'
- state
.y in
1625 if x != state
.x || not
(dy > 0 && dy < wh)
1627 if conf
.presentation
1629 if abs
(py - y'
) > wh
1636 if state
.x != sx || state
.y != sy
1641 let ww = wadj + state
.winw
in
1643 and qy
= pdy / wh in
1645 and y = py + qy
* wh in
1646 let x = if -x + ww > w1 then -(w1-ww) else x
1647 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1649 if conf
.presentation
1651 if abs
(py - y'
) > wh
1661 gotoy_and_clear_text y;
1663 else gotoy_and_clear_text state
.y;
1666 let gotopagexy pageno
x y =
1667 match state
.mode
with
1668 | Birdseye
_ -> gotopage pageno
0.0
1671 | LinkNav
_ -> gotopagexy1 pageno
x y
1675 (* dolog "%S" cmds; *)
1676 let cl = splitatspace cmds
in
1678 try Scanf.sscanf
s fmt
f
1680 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1683 let addoutline outline
=
1684 match state
.currently
with
1685 | Outlining outlines
->
1686 state
.currently
<- Outlining
(outline
:: outlines
)
1687 | Idle
-> state
.currently
<- Outlining
[outline
]
1690 dolog
"invalid outlining state";
1691 logcurrently state
.currently
1695 state
.uioh#infochanged Pdim
;
1698 | "clearrects" :: [] ->
1699 state
.rects
<- state
.rects1
;
1700 G.postRedisplay "clearrects";
1702 | "continue" :: args
:: [] ->
1703 let n = scan args
"%u" (fun n -> n) in
1704 state
.pagecount
<- n;
1705 begin match state
.currently
with
1707 state
.currently
<- Idle
;
1708 state
.outlines
<- Array.of_list
(List.rev
l)
1714 let cur, cmds
= state
.geomcmds
in
1716 then failwith
"umpossible";
1718 begin match List.rev cmds
with
1720 state
.geomcmds
<- E.s, [];
1721 state
.throttle
<- None
;
1725 state
.geomcmds
<- s, List.rev rest
;
1727 if conf
.maxwait
= None
&& not
!wtmode
1728 then G.postRedisplay "continue";
1730 | "msg" :: args
:: [] ->
1733 | "vmsg" :: args
:: [] ->
1735 then showtext ' ' args
1737 | "emsg" :: args
:: [] ->
1738 Buffer.add_string state
.errmsgs args
;
1739 state
.newerrmsgs
<- true;
1740 G.postRedisplay "error message"
1742 | "progress" :: args
:: [] ->
1743 let progress, text =
1746 f, String.sub args pos
(String.length args
- pos
))
1749 state
.progress <- progress;
1750 G.postRedisplay "progress"
1752 | "firstmatch" :: args
:: [] ->
1753 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1754 scan args
"%u %d %f %f %f %f %f %f %f %f"
1755 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1756 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1758 let xoff = float (xadjsb ()) in
1762 and x3
= x3
+. xoff in
1763 let y = (getpagey
pageno) + truncate
y0 in
1766 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1768 | "match" :: args
:: [] ->
1769 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1770 scan args
"%u %d %f %f %f %f %f %f %f %f"
1771 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1772 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1774 let xoff = float (xadjsb ()) in
1778 and x3
= x3
+. xoff in
1780 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1782 | "page" :: args
:: [] ->
1783 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1784 let pageopaque = ~
< pageopaques in
1785 begin match state
.currently
with
1786 | Loading
(l, gen
) ->
1787 vlog "page %d took %f sec" l.pageno t
;
1788 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1789 begin match state
.throttle
with
1791 let preloadedpages =
1793 then preloadlayout state
.y
1798 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1799 IntSet.empty
preloadedpages
1802 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1803 if not
(IntSet.mem
pageno set)
1805 wcmd "freepage %s" (~
> opaque
);
1811 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1814 state
.currently
<- Idle
;
1817 tilepage l.pageno pageopaque state
.layout;
1819 load preloadedpages;
1820 if pagevisible state
.layout l.pageno
1821 && layoutready state
.layout
1822 then G.postRedisplay "page";
1825 | Some
(layout, _, _) ->
1826 state
.currently
<- Idle
;
1827 tilepage l.pageno pageopaque layout;
1834 dolog
"Inconsistent loading state";
1835 logcurrently state
.currently
;
1839 | "tile" :: args
:: [] ->
1840 let (x, y, opaques
, size
, t
) =
1841 scan args
"%u %u %s %u %f"
1842 (fun x y p size t
-> (x, y, p
, size
, t
))
1844 let opaque = ~
< opaques
in
1845 begin match state
.currently
with
1846 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1847 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1850 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1852 wcmd "freetile %s" (~
> opaque);
1853 state
.currently
<- Idle
;
1857 puttileopaque l col row gen cs angle
opaque size t
;
1858 state
.memused
<- state
.memused
+ size
;
1859 state
.uioh#infochanged Memused
;
1861 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1862 opaque, size
) state
.tilelru
;
1865 match state
.throttle
with
1866 | None
-> state
.layout
1867 | Some
(layout, _, _) -> layout
1870 state
.currently
<- Idle
;
1872 && conf
.colorspace
= cs
1873 && conf
.angle
= angle
1874 && tilevisible layout l.pageno x y
1875 then conttiling l.pageno pageopaque;
1877 begin match state
.throttle
with
1879 preload state
.layout;
1881 && conf
.colorspace
= cs
1882 && conf
.angle
= angle
1883 && tilevisible state
.layout l.pageno x y
1884 && (not
!wtmode || layoutready state
.layout)
1885 then G.postRedisplay "tile nothrottle";
1887 | Some
(layout, y, _) ->
1888 let ready = layoutready layout in
1892 state
.layout <- layout;
1893 state
.throttle
<- None
;
1894 G.postRedisplay "throttle";
1903 dolog
"Inconsistent tiling state";
1904 logcurrently state
.currently
;
1908 | "pdim" :: args
:: [] ->
1909 let (n, w, h, _) as pdim
=
1910 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1913 match conf
.fitmodel
with
1915 | FitPage
| FitProportional
->
1916 match conf
.columns
with
1917 | Csplit
_ -> (n, w, h, 0)
1918 | Csingle
_ | Cmulti
_ -> pdim
1920 state
.uioh#infochanged Pdim
;
1921 state
.pdims
<- pdim :: state
.pdims
1923 | "o" :: args
:: [] ->
1924 let (l, n, t
, h, pos
) =
1925 scan args
"%u %u %d %u %n"
1926 (fun l n t
h pos
-> l, n, t
, h, pos
)
1928 let s = String.sub args pos
(String.length args
- pos
) in
1929 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1931 | "ou" :: args
:: [] ->
1932 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1933 let s = String.sub args pos
len in
1934 let pos2 = pos
+ len + 1 in
1935 let uri = String.sub args
pos2 (String.length args
- pos2) in
1936 addoutline (s, l, Ouri
uri)
1938 | "on" :: args
:: [] ->
1939 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1940 let s = String.sub args pos
(String.length args
- pos
) in
1941 addoutline (s, l, Onone
)
1943 | "a" :: args
:: [] ->
1945 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1947 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1949 | "info" :: args
:: [] ->
1950 let pos = nindex args '
\t'
in
1951 if pos >= 0 && String.sub args
0 pos = "Title"
1953 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1956 state
.docinfo
<- (1, args
) :: state
.docinfo
1958 | "infoend" :: [] ->
1959 state
.uioh#infochanged Docinfo
;
1960 state
.docinfo
<- List.rev state
.docinfo
1963 error
"unknown cmd `%S'" cmds
1968 let action = function
1969 | HCprev
-> cbget cb ~
-1
1970 | HCnext
-> cbget cb
1
1971 | HCfirst
-> cbget cb ~
-(cb
.rc)
1972 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1973 and cancel
() = cb
.rc <- rc
1977 let search pattern forward
=
1978 match conf
.columns
with
1980 showtext '
!'
"searching does not work properly in split columns mode"
1983 if nonemptystr pattern
1986 match state
.layout with
1989 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1991 wcmd "search %d %d %d %d,%s\000"
1992 (btod conf
.icase
) pn py (btod forward
) pattern
;
1995 let intentry text key =
1997 if key >= 32 && key < 127
2003 let text = addchar text c in
2007 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2011 let linknentry text key =
2013 if key >= 32 && key < 127
2019 let text = addchar text c in
2023 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2031 let l = String.length
s in
2032 let rec loop pos n = if pos = l then n else
2033 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2034 loop (pos+1) (n*26 + m)
2037 let rec loop n = function
2040 match getopaque l.pageno with
2041 | None
-> loop n rest
2043 let m = getlinkcount
opaque in
2046 let under = getlink
opaque n in
2049 else loop (n-m) rest
2051 loop n state
.layout;
2055 let textentry text key =
2056 if key land 0xff00 = 0xff00
2058 else TEcont
(text ^ toutf8
key)
2061 let reqlayout angle fitmodel
=
2062 match state
.throttle
with
2064 if nogeomcmds state
.geomcmds
2065 then state
.anchor <- getanchor
();
2066 conf
.angle
<- angle
mod 360;
2069 match state
.mode
with
2070 | LinkNav
_ -> state
.mode
<- View
2075 conf
.fitmodel
<- fitmodel
;
2076 invalidate "reqlayout"
2078 wcmd "reqlayout %d %d %d"
2079 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2084 let settrim trimmargins trimfuzz
=
2085 if nogeomcmds state
.geomcmds
2086 then state
.anchor <- getanchor
();
2087 conf
.trimmargins
<- trimmargins
;
2088 conf
.trimfuzz
<- trimfuzz
;
2089 let x0, y0, x1, y1 = trimfuzz
in
2090 invalidate "settrim"
2092 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2097 match state
.throttle
with
2099 let zoom = max
0.0001 zoom in
2100 if zoom <> conf
.zoom
2102 state
.prevzoom
<- (conf
.zoom, state
.x);
2104 reshape state
.winw state
.winh
;
2105 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2108 | Some
(layout, y, started
) ->
2110 match conf
.maxwait
with
2114 let dt = now
() -. started
in
2122 let setcolumns mode columns coverA coverB
=
2123 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2127 then showtext '
!'
"split mode doesn't work in bird's eye"
2129 conf
.columns
<- Csplit
(-columns
, E.a);
2137 conf
.columns
<- Csingle
E.a;
2142 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2146 reshape state
.winw state
.winh
;
2149 let resetmstate () =
2150 state
.mstate
<- Mnone
;
2151 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2154 let enterbirdseye () =
2155 let zoom = float conf
.thumbw
/. float state
.winw
in
2156 let birdseyepageno =
2157 let cy = state
.winh
/ 2 in
2161 let rec fold best
= function
2164 let d = cy - (l.pagedispy + l.pagevh/2)
2165 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2166 if abs
d < abs dbest
2173 state
.mode
<- Birdseye
(
2174 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2178 conf
.presentation
<- false;
2179 conf
.interpagespace
<- 10;
2180 conf
.hlinks
<- false;
2181 conf
.fitmodel
<- FitPage
;
2183 conf
.maxwait
<- None
;
2185 match conf
.beyecolumns
with
2188 Cmulti
((c, 0, 0), E.a)
2189 | None
-> Csingle
E.a
2193 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2198 reshape state
.winw state
.winh
;
2201 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2203 conf
.zoom <- c.zoom;
2204 conf
.presentation
<- c.presentation
;
2205 conf
.interpagespace
<- c.interpagespace
;
2206 conf
.maxwait
<- c.maxwait
;
2207 conf
.hlinks
<- c.hlinks
;
2208 conf
.fitmodel
<- c.fitmodel
;
2209 conf
.beyecolumns
<- (
2210 match conf
.columns
with
2211 | Cmulti
((c, _, _), _) -> Some
c
2213 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2216 match c.columns
with
2217 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2218 | Csingle
_ -> Csingle
E.a
2219 | Csplit
(c, _) -> Csplit
(c, E.a)
2223 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2226 reshape state
.winw state
.winh
;
2227 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2231 let togglebirdseye () =
2232 match state
.mode
with
2233 | Birdseye vals
-> leavebirdseye vals
true
2234 | View
-> enterbirdseye ()
2239 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2240 let pageno = max
0 (pageno - incr
) in
2241 let rec loop = function
2242 | [] -> gotopage1 pageno 0
2243 | l :: _ when l.pageno = pageno ->
2244 if l.pagedispy >= 0 && l.pagey = 0
2245 then G.postRedisplay "upbirdseye"
2246 else gotopage1 pageno 0
2247 | _ :: rest
-> loop rest
2251 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2254 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2255 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2256 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2257 let rec loop = function
2259 let y, h = getpageyh
pageno in
2260 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2262 | l :: _ when l.pageno = pageno ->
2263 if l.pagevh != l.pageh
2264 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2265 else G.postRedisplay "downbirdseye"
2266 | _ :: rest
-> loop rest
2272 let boundastep h step
=
2274 then bound step ~
-h 0
2278 let optentry mode
_ key =
2279 let btos b = if b then "on" else "off" in
2280 if key >= 32 && key < 127
2282 let c = Char.chr
key in
2286 try conf
.scrollstep
<- int_of_string
s with exc
->
2287 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2289 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2294 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2295 if state
.autoscroll
<> None
2296 then state
.autoscroll
<- Some conf
.autoscrollstep
2298 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2300 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2305 let n, a, b = multicolumns_of_string
s in
2306 setcolumns mode
n a b;
2308 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2310 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2315 let zoom = float (int_of_string
s) /. 100.0 in
2318 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2320 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2325 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2327 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2328 begin match mode
with
2330 leavebirdseye beye
false;
2337 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2339 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2344 Some
(int_of_string
s)
2346 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2350 | Some angle
-> reqlayout angle conf
.fitmodel
2353 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2356 conf
.icase
<- not conf
.icase
;
2357 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2360 conf
.preload <- not conf
.preload;
2362 TEdone
("preload " ^
(btos conf
.preload))
2365 conf
.verbose
<- not conf
.verbose
;
2366 TEdone
("verbose " ^
(btos conf
.verbose
))
2369 conf
.debug
<- not conf
.debug
;
2370 TEdone
("debug " ^
(btos conf
.debug
))
2373 conf
.maxhfit
<- not conf
.maxhfit
;
2374 state
.maxy
<- calcheight
();
2375 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2378 conf
.crophack
<- not conf
.crophack
;
2379 TEdone
("crophack " ^
btos conf
.crophack
)
2383 match conf
.maxwait
with
2385 conf
.maxwait
<- Some infinity
;
2386 "always wait for page to complete"
2388 conf
.maxwait
<- None
;
2389 "show placeholder if page is not ready"
2394 conf
.underinfo
<- not conf
.underinfo
;
2395 TEdone
("underinfo " ^
btos conf
.underinfo
)
2398 conf
.savebmarks
<- not conf
.savebmarks
;
2399 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2405 match state
.layout with
2410 conf
.interpagespace
<- int_of_string
s;
2411 docolumns conf
.columns
;
2412 state
.maxy
<- calcheight
();
2413 let y = getpagey
pageno in
2416 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2418 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2422 match conf
.fitmodel
with
2423 | FitProportional
-> FitWidth
2424 | FitWidth
| FitPage
-> FitProportional
2426 reqlayout conf
.angle
fm;
2427 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2430 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2431 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2434 conf
.invert
<- not conf
.invert
;
2435 TEdone
("invert colors " ^
btos conf
.invert
)
2439 cbput state
.hists
.sel
s;
2442 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2443 textentry, ondone, true)
2447 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2448 else conf
.pax
<- None
;
2449 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2452 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2458 class type lvsource
= object
2459 method getitemcount
: int
2460 method getitem
: int -> (string * int)
2461 method hasaction
: int -> bool
2469 method getactive
: int
2470 method getfirst
: int
2472 method getminfo
: (int * int) array
2475 class virtual lvsourcebase
= object
2476 val mutable m_active
= 0
2477 val mutable m_first
= 0
2478 val mutable m_pan
= 0
2479 method getactive
= m_active
2480 method getfirst
= m_first
2481 method getpan
= m_pan
2482 method getminfo
: (int * int) array
= E.a
2485 let withoutlastutf8 s =
2486 let len = String.length
s in
2494 let b = Char.code
s.[pos] in
2495 if b land 0b11000000 = 0b11000000
2500 if Char.code
s.[len-1] land 0x80 = 0
2504 String.sub
s 0 first;
2507 let textentrykeyboard
2508 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2510 if key >= 0xffb0 && key <= 0xffb9
2511 then key - 0xffb0 + 48 else key
2514 state
.mode
<- Textentry
(te
, onleave
);
2517 G.postRedisplay "textentrykeyboard enttext";
2519 let histaction cmd
=
2522 | Some
(action, _) ->
2523 state
.mode
<- Textentry
(
2524 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2526 G.postRedisplay "textentry histaction"
2530 if emptystr
text && cancelonempty
2533 G.postRedisplay "textentrykeyboard after cancel";
2536 let s = withoutlastutf8 text in
2537 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2539 | @enter
| @kpenter
->
2542 G.postRedisplay "textentrykeyboard after confirm"
2544 | @up
| @kpup
-> histaction HCprev
2545 | @down
| @kpdown
-> histaction HCnext
2546 | @home
| @kphome
-> histaction HCfirst
2547 | @jend
| @kpend
-> histaction HClast
2552 begin match opthist
with
2554 | Some
(_, onhistcancel
) -> onhistcancel
()
2558 G.postRedisplay "textentrykeyboard after cancel2"
2561 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2564 | @delete
| @kpdelete
-> ()
2567 && key land 0xff00 != 0xff00 (* keyboard *)
2568 && key land 0xfe00 != 0xfe00 (* xkb *)
2569 && key land 0xfd00 != 0xfd00 (* 3270 *)
2571 begin match onkey
text key with
2575 G.postRedisplay "textentrykeyboard after confirm2";
2578 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2582 G.postRedisplay "textentrykeyboard after cancel3"
2585 state
.mode
<- Textentry
(te
, onleave
);
2586 G.postRedisplay "textentrykeyboard switch";
2590 vlog "unhandled key %s" (Wsi.keyname
key)
2593 let firstof first active
=
2594 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2595 then max
0 (active
- (fstate
.maxrows
/2))
2599 let calcfirst first active
=
2602 let rows = active
- first in
2603 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2607 let scrollph y maxy
=
2608 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2609 let sh = float state
.winh
/. sh in
2610 let sh = max
sh (float conf
.scrollh
) in
2612 let percent = float y /. float maxy
in
2613 let position = (float state
.winh
-. sh) *. percent in
2616 if position +. sh > float state
.winh
2617 then float state
.winh
-. sh
2623 let coe s = (s :> uioh
);;
2625 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2627 val m_pan
= source#getpan
2628 val m_first
= source#getfirst
2629 val m_active
= source#getactive
2631 val m_prev_uioh
= state
.uioh
2633 method private elemunder
y =
2637 let n = y / (fstate
.fontsize
+1) in
2638 if m_first
+ n < source#getitemcount
2640 if source#hasaction
(m_first
+ n)
2641 then Some
(m_first
+ n)
2648 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2649 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2650 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2651 GlDraw.color
(1., 1., 1.);
2652 Gl.enable `texture_2d
;
2653 let fs = fstate
.fontsize
in
2655 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2656 let ww = fstate
.wwidth
in
2657 let tabw = 17.0*.ww in
2658 let itemcount = source#getitemcount
in
2659 let minfo = source#getminfo
in
2662 then float (xadjsb ()), float (state
.winw
- 1)
2663 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2665 let xadj = xadjsb () in
2667 if (row - m_first
) > fstate
.maxrows
2670 if row >= 0 && row < itemcount
2672 let (s, level
) = source#getitem
row in
2673 let y = (row - m_first
) * nfs in
2675 (if conf
.leftscroll
then float xadj else 5.0)
2676 +. (float (level
+ m_pan
)) *. ww in
2679 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2683 Gl.disable `texture_2d
;
2684 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2685 GlDraw.color
(1., 1., 1.) ~
alpha;
2686 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2687 Gl.enable `texture_2d
;
2690 if zebra
&& row land 1 = 1
2694 GlDraw.color
(c,c,c);
2695 let drawtabularstring s =
2697 let x'
= truncate
(x0 +. x) in
2698 let pos = nindex
s '
\000'
in
2700 then drawstring1 fs x'
(y+nfs) s
2702 let s1 = String.sub
s 0 pos
2703 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2708 let s'
= withoutlastutf8 s in
2709 let s = s' ^
"@Uellipsis" in
2710 let w = measurestr
fs s in
2711 if float x'
+. w +. ww < float (hw + x'
)
2716 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2720 ignore
(drawstring1 fs x'
(y+nfs) s1);
2721 drawstring1 fs (hw + x'
) (y+nfs) s2
2725 let x = if helpmode
&& row > 0 then x +. ww else x in
2726 let tabpos = nindex
s '
\t'
in
2729 let len = String.length
s - tabpos - 1 in
2730 let s1 = String.sub
s 0 tabpos
2731 and s2
= String.sub
s (tabpos + 1) len in
2732 let nx = drawstr x s1 in
2734 let x = x +. (max
tabw sw) in
2737 let len = String.length
s - 2 in
2738 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2740 let s = String.sub
s 2 len in
2741 let x = if not helpmode
then x +. ww else x in
2742 GlDraw.color
(1.2, 1.2, 1.2);
2743 let vinc = drawstring1 (fs+fs/4)
2744 (truncate
(x -. ww)) (y+nfs) s in
2745 GlDraw.color
(1., 1., 1.);
2746 vinc +. (float fs *. 0.8)
2752 ignore
(drawtabularstring s);
2758 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2759 let xadj = float (xadjsb () + 5) in
2761 if (row - m_first
) > fstate
.maxrows
2764 if row >= 0 && row < itemcount
2766 let (s, level
) = source#getitem
row in
2767 let pos0 = nindex
s '
\000'
in
2768 let y = (row - m_first
) * nfs in
2769 let x = float (level
+ m_pan
) *. ww in
2770 let (first, last
) = minfo.(row) in
2772 if pos0 > 0 && first > pos0
2773 then String.sub
s (pos0+1) (first-pos0-1)
2774 else String.sub
s 0 first
2776 let suffix = String.sub
s first (last
- first) in
2777 let w1 = measurestr fstate
.fontsize
prefix in
2778 let w2 = measurestr fstate
.fontsize
suffix in
2779 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2780 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2782 and y0 = float (y+2) in
2784 and y1 = float (y+fs+3) in
2785 filledrect x0 y0 x1 y1;
2790 Gl.disable `texture_2d
;
2791 if Array.length
minfo > 0 then loop m_first
;
2794 method updownlevel incr
=
2795 let len = source#getitemcount
in
2797 if m_active
>= 0 && m_active
< len
2798 then snd
(source#getitem m_active
)
2802 if i
= len then i
-1 else if i
= -1 then 0 else
2803 let _, l = source#getitem i
in
2804 if l != curlevel then i
else flow (i
+incr
)
2806 let active = flow m_active
in
2807 let first = calcfirst m_first
active in
2808 G.postRedisplay "outline updownlevel";
2809 {< m_active
= active; m_first
= first >}
2811 method private key1
key mask
=
2812 let set1 active first qsearch
=
2813 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2815 let search active pattern incr
=
2816 let active = if active = -1 then m_first
else active in
2819 if n >= 0 && n < source#getitemcount
2821 let s, _ = source#getitem
n in
2823 (try ignore
(Str.search_forward
re s 0); true
2824 with Not_found
-> false)
2826 else loop (n + incr
)
2833 let re = Str.regexp_case_fold pattern
in
2839 let itemcount = source#getitemcount
in
2840 let find start incr
=
2842 if i
= -1 || i
= itemcount
2845 if source#hasaction i
2847 else find (i
+ incr
)
2852 let set active first =
2853 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2855 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2858 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2860 let incr1 = if incr
> 0 then 1 else -1 in
2861 if isvisible m_first m_active
2864 let next = m_active
+ incr
in
2866 if next < 0 || next >= itemcount
2868 else find next incr1
2870 if abs
(m_active
- next) > fstate
.maxrows
2876 let first = m_first
+ incr
in
2877 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2879 let next = m_active
+ incr
in
2880 let next = bound
next 0 (itemcount - 1) in
2887 if isvisible first next
2894 let first = min
next m_first
in
2896 if abs
(next - first) > fstate
.maxrows
2902 let first = m_first
+ incr
in
2903 let first = bound
first 0 (itemcount - 1) in
2905 let next = m_active
+ incr
in
2906 let next = bound
next 0 (itemcount - 1) in
2907 let next = find next incr1 in
2909 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2911 let active = if m_active
= -1 then next else m_active
in
2916 if isvisible first active
2922 G.postRedisplay "listview navigate";
2926 | (@r|@s) when Wsi.withctrl mask
->
2927 let incr = if key = @r then -1 else 1 in
2929 match search (m_active
+ incr) m_qsearch
incr with
2931 state
.text <- m_qsearch ^
" [not found]";
2934 state
.text <- m_qsearch
;
2935 active, firstof m_first
active
2937 G.postRedisplay "listview ctrl-r/s";
2938 set1 active first m_qsearch
;
2940 | @insert
when Wsi.withctrl mask
->
2941 if m_active
>= 0 && m_active
< source#getitemcount
2943 let s, _ = source#getitem m_active
in
2949 if emptystr m_qsearch
2952 let qsearch = withoutlastutf8 m_qsearch
in
2956 G.postRedisplay "listview empty qsearch";
2957 set1 m_active m_first
E.s;
2961 match search m_active
qsearch ~
-1 with
2963 state
.text <- qsearch ^
" [not found]";
2966 state
.text <- qsearch;
2967 active, firstof m_first
active
2969 G.postRedisplay "listview backspace qsearch";
2970 set1 active first qsearch
2973 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2974 let pattern = m_qsearch ^ toutf8
key in
2976 match search m_active
pattern 1 with
2978 state
.text <- pattern ^
" [not found]";
2981 state
.text <- pattern;
2982 active, firstof m_first
active
2984 G.postRedisplay "listview qsearch add";
2985 set1 active first pattern;
2989 if emptystr m_qsearch
2991 G.postRedisplay "list view escape";
2994 source#exit ~uioh
:(coe self
)
2995 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2997 | None
-> m_prev_uioh
3002 G.postRedisplay "list view kill qsearch";
3003 coe {< m_qsearch
= E.s >}
3006 | @enter
| @kpenter
->
3008 let self = {< m_qsearch
= E.s >} in
3010 G.postRedisplay "listview enter";
3011 if m_active
>= 0 && m_active
< source#getitemcount
3013 source#exit ~uioh
:(coe self) ~cancel
:false
3014 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3017 source#exit ~uioh
:(coe self) ~cancel
:true
3018 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3021 begin match opt with
3022 | None
-> m_prev_uioh
3026 | @delete
| @kpdelete
->
3029 | @up
| @kpup
-> navigate ~
-1
3030 | @down
| @kpdown
-> navigate 1
3031 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3032 | @next | @kpnext
-> navigate fstate
.maxrows
3034 | @right
| @kpright
->
3036 G.postRedisplay "listview right";
3037 coe {< m_pan
= m_pan
- 1 >}
3039 | @left | @kpleft
->
3041 G.postRedisplay "listview left";
3042 coe {< m_pan
= m_pan
+ 1 >}
3044 | @home
| @kphome
->
3045 let active = find 0 1 in
3046 G.postRedisplay "listview home";
3050 let first = max
0 (itemcount - fstate
.maxrows
) in
3051 let active = find (itemcount - 1) ~
-1 in
3052 G.postRedisplay "listview end";
3055 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3059 dolog
"listview unknown key %#x" key; coe self
3061 method key key mask
=
3062 match state
.mode
with
3063 | Textentry te
-> textentrykeyboard key mask te
; coe self
3066 | LinkNav
_ -> self#key1
key mask
3068 method button button down
x y _ =
3071 | 1 when x > state
.winw
- conf
.scrollbw
->
3072 G.postRedisplay "listview scroll";
3075 let _, position, sh = self#
scrollph in
3076 if y > truncate
position && y < truncate
(position +. sh)
3078 state
.mstate
<- Mscrolly
;
3082 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3083 let first = truncate
(s *. float source#getitemcount
) in
3084 let first = min source#getitemcount
first in
3085 Some
(coe {< m_first
= first; m_active
= first >})
3087 state
.mstate
<- Mnone
;
3091 begin match self#elemunder
y with
3093 G.postRedisplay "listview click";
3094 source#exit ~uioh
:(coe {< m_active
= n >})
3095 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3099 | n when (n == 4 || n == 5) && not down
->
3100 let len = source#getitemcount
in
3102 if n = 5 && m_first
+ fstate
.maxrows
>= len
3106 let first = m_first
+ (if n == 4 then -1 else 1) in
3107 bound
first 0 (len - 1)
3109 G.postRedisplay "listview wheel";
3110 Some
(coe {< m_first
= first >})
3111 | n when (n = 6 || n = 7) && not down
->
3112 let inc = if n = 7 then -1 else 1 in
3113 G.postRedisplay "listview hwheel";
3114 Some
(coe {< m_pan
= m_pan
+ inc >})
3119 | None
-> m_prev_uioh
3122 method multiclick
_ x y = self#button
1 true x y
3125 match state
.mstate
with
3127 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3128 let first = truncate
(s *. float source#getitemcount
) in
3129 let first = min source#getitemcount
first in
3130 G.postRedisplay "listview motion";
3131 coe {< m_first
= first; m_active
= first >}
3139 method pmotion
x y =
3140 if x < state
.winw
- conf
.scrollbw
3143 match self#elemunder
y with
3144 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3145 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3149 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3154 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3158 method infochanged
_ = ()
3160 method scrollpw
= (0, 0.0, 0.0)
3162 let nfs = fstate
.fontsize
+ 1 in
3163 let y = m_first
* nfs in
3164 let itemcount = source#getitemcount
in
3165 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3166 let maxy = maxi * nfs in
3167 let p, h = scrollph y maxy in
3170 method modehash
= modehash
3171 method eformsgs
= false
3172 method alwaysscrolly
= true
3175 class outlinelistview ~zebra ~source
=
3176 let settext autonarrow
s =
3179 let ss = source#statestr
in
3183 else "{" ^
ss ^
"} [" ^
s ^
"]"
3184 else state
.text <- s
3190 ~source
:(source
:> lvsource
)
3192 ~modehash
:(findkeyhash conf
"outline")
3195 val m_autonarrow
= false
3197 method! key key mask
=
3199 if emptystr state
.text
3201 else fstate
.maxrows - 2
3203 let calcfirst first active =
3206 let rows = active - first in
3207 if rows > maxrows then active - maxrows else first
3211 let active = m_active
+ incr in
3212 let active = bound
active 0 (source#getitemcount
- 1) in
3213 let first = calcfirst m_first
active in
3214 G.postRedisplay "outline navigate";
3215 coe {< m_active
= active; m_first
= first >}
3217 let navscroll first =
3219 let dist = m_active
- first in
3225 else first + maxrows
3228 G.postRedisplay "outline navscroll";
3229 coe {< m_first
= first; m_active
= active >}
3231 let ctrl = Wsi.withctrl mask
in
3236 then (source#denarrow
; E.s)
3238 let pattern = source#renarrow
in
3239 if nonemptystr m_qsearch
3240 then (source#narrow m_qsearch
; m_qsearch
)
3244 settext (not m_autonarrow
) text;
3245 G.postRedisplay "toggle auto narrowing";
3246 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3248 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3250 G.postRedisplay "toggle auto narrowing";
3251 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3254 source#narrow m_qsearch
;
3256 then source#add_narrow_pattern m_qsearch
;
3257 G.postRedisplay "outline ctrl-n";
3258 coe {< m_first
= 0; m_active
= 0 >}
3261 let active = source#calcactive
(getanchor
()) in
3262 let first = firstof m_first
active in
3263 G.postRedisplay "outline ctrl-s";
3264 coe {< m_first
= first; m_active
= active >}
3267 G.postRedisplay "outline ctrl-u";
3268 if m_autonarrow
&& nonemptystr m_qsearch
3270 ignore
(source#renarrow
);
3271 settext m_autonarrow
E.s;
3272 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3275 source#del_narrow_pattern
;
3276 let pattern = source#renarrow
in
3278 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3280 settext m_autonarrow
text;
3281 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3285 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3286 G.postRedisplay "outline ctrl-l";
3287 coe {< m_first
= first >}
3289 | @tab
when m_autonarrow
->
3290 if nonemptystr m_qsearch
3292 G.postRedisplay "outline list view tab";
3293 source#add_narrow_pattern m_qsearch
;
3295 coe {< m_qsearch
= E.s >}
3299 | @escape
when m_autonarrow
->
3300 if nonemptystr m_qsearch
3301 then source#add_narrow_pattern m_qsearch
;
3304 | @enter
| @kpenter
when m_autonarrow
->
3305 if nonemptystr m_qsearch
3306 then source#add_narrow_pattern m_qsearch
;
3309 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3310 let pattern = m_qsearch ^ toutf8
key in
3311 G.postRedisplay "outlinelistview autonarrow add";
3312 source#narrow
pattern;
3313 settext true pattern;
3314 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3316 | key when m_autonarrow
&& key = @backspace
->
3317 if emptystr m_qsearch
3320 let pattern = withoutlastutf8 m_qsearch
in
3321 G.postRedisplay "outlinelistview autonarrow backspace";
3322 ignore
(source#renarrow
);
3323 source#narrow
pattern;
3324 settext true pattern;
3325 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3327 | @delete
| @kpdelete
->
3328 source#remove m_active
;
3329 G.postRedisplay "outline delete";
3330 let active = max
0 (m_active
-1) in
3331 coe {< m_first
= firstof m_first
active;
3332 m_active
= active >}
3334 | @up
| @kpup
when ctrl ->
3335 navscroll (max
0 (m_first
- 1))
3337 | @down
| @kpdown
when ctrl ->
3338 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3340 | @up
| @kpup
-> navigate ~
-1
3341 | @down
| @kpdown
-> navigate 1
3342 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3343 | @next | @kpnext
-> navigate fstate
.maxrows
3345 | @right
| @kpright
->
3349 G.postRedisplay "outline ctrl right";
3350 {< m_pan
= m_pan
+ 1 >}
3352 else self#updownlevel
1
3356 | @left | @kpleft
->
3360 G.postRedisplay "outline ctrl left";
3361 {< m_pan
= m_pan
- 1 >}
3363 else self#updownlevel ~
-1
3367 | @home
| @kphome
->
3368 G.postRedisplay "outline home";
3369 coe {< m_first
= 0; m_active
= 0 >}
3372 let active = source#getitemcount
- 1 in
3373 let first = max
0 (active - fstate
.maxrows) in
3374 G.postRedisplay "outline end";
3375 coe {< m_active
= active; m_first
= first >}
3377 | _ -> super#
key key mask
3380 let genhistoutlines =
3381 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3383 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3384 | `path
-> compare p2 p1
3385 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3387 let e1 = emptystr c1
.title
3388 and e2
= emptystr c2
.title
in
3390 then compare
(Filename.basename p2
) (Filename.basename p1
)
3393 else compare c1
.title c2
.title
3395 let showfullpath = ref false in
3398 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3399 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3401 let list = ref [] in
3402 if Config.gethist
list
3406 (fun accu (path
, c, b, x, a) ->
3407 let hist = (path
, (c, b, x, a)) in
3408 let s = if !showfullpath then path
else Filename.basename path
in
3409 let base = mbtoutf8
s in
3410 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3412 [ setorty "Sort by time of last visit" `lastvisit
;
3413 setorty "Sort by file name" `file
;
3414 setorty "Sort by path" `path
;
3415 setorty "Sort by title" `title
;
3416 (if !showfullpath then "@Uradical "
3417 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3418 showfullpath := not
!showfullpath; reeenterhist := true)
3419 ] (List.sort
(order orderty
) !list)
3425 let gotohist (path
, (c, bookmarks
, x, anchor)) =
3426 Config.save
leavebirdseye;
3427 state
.anchor <- anchor;
3429 state
.bookmarks
<- bookmarks
;
3430 state
.origin
<- E.s;
3432 let x0, y0, x1, y1 = conf
.trimfuzz
in
3433 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3437 let makecheckers () =
3438 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3440 converted by Issac Trotts. July 25, 2002 *)
3441 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3442 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3443 let id = GlTex.gen_texture
() in
3444 GlTex.bind_texture ~target
:`texture_2d
id;
3445 GlPix.store
(`unpack_alignment
1);
3446 GlTex.image2d
image;
3447 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3448 [ `mag_filter `nearest
; `min_filter `nearest
];
3452 let setcheckers enabled
=
3453 match state
.checkerstexid
with
3455 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3457 | Some checkerstexid
->
3460 GlTex.delete_texture checkerstexid
;
3461 state
.checkerstexid
<- None
;
3465 let describe_location () =
3466 let fn = page_of_y state
.y in
3467 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3468 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3472 else (100. *. (float state
.y /. float maxy))
3476 Printf.sprintf
"page %d of %d [%.2f%%]"
3477 (fn+1) state
.pagecount
percent
3480 "pages %d-%d of %d [%.2f%%]"
3481 (fn+1) (ln+1) state
.pagecount
percent
3484 let setpresentationmode v
=
3485 let n = page_of_y state
.y in
3486 state
.anchor <- (n, 0.0, 1.0);
3487 conf
.presentation
<- v
;
3488 if conf
.fitmodel
= FitPage
3489 then reqlayout conf
.angle conf
.fitmodel
;
3494 let btos b = if b then "@Uradical" else E.s in
3495 let showextended = ref false in
3496 let leave mode
_ = state
.mode
<- mode
in
3499 val mutable m_first_time
= true
3500 val mutable m_l
= []
3501 val mutable m_a
= E.a
3502 val mutable m_prev_uioh
= nouioh
3503 val mutable m_prev_mode
= View
3505 inherit lvsourcebase
3507 method reset prev_mode prev_uioh
=
3508 m_a
<- Array.of_list
(List.rev m_l
);
3510 m_prev_mode
<- prev_mode
;
3511 m_prev_uioh
<- prev_uioh
;
3515 if n >= Array.length m_a
3519 | _, _, _, Action
_ -> m_active
<- n
3520 | _, _, _, Noaction
-> loop (n+1)
3523 m_first_time
<- false;
3526 method int name get
set =
3528 (name
, `
int get
, 1, Action
(
3531 try set (int_of_string
s)
3533 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3537 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3538 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3542 method int_with_suffix name get
set =
3544 (name
, `intws get
, 1, Action
(
3547 try set (int_of_string_with_suffix
s)
3549 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3554 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3556 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3560 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3562 (name
, `
bool (btos, get
), offset
, Action
(
3569 method color name get
set =
3571 (name
, `color get
, 1, Action
(
3573 let invalid = (nan
, nan
, nan
) in
3576 try color_of_string
s
3578 state
.text <- Printf.sprintf
"bad color `%s': %s"
3585 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3586 state
.text <- color_to_string
(get
());
3587 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3591 method string name get
set =
3593 (name
, `
string get
, 1, Action
(
3595 let ondone s = set s in
3596 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3597 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3601 method colorspace name get
set =
3603 (name
, `
string get
, 1, Action
(
3607 inherit lvsourcebase
3610 m_active
<- CSTE.to_int conf
.colorspace
;
3613 method getitemcount
=
3614 Array.length
CSTE.names
3617 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3618 ignore
(uioh
, first, pan
);
3619 if not cancel
then set active;
3621 method hasaction
_ = true
3625 let modehash = findkeyhash conf
"info" in
3626 coe (new listview ~zebra
:false ~helpmode
:false
3627 ~
source ~trusted
:true ~
modehash)
3630 method paxmark name get
set =
3632 (name
, `
string get
, 1, Action
(
3636 inherit lvsourcebase
3639 m_active
<- MTE.to_int conf
.paxmark
;
3642 method getitemcount
= Array.length
MTE.names
3643 method getitem
n = (MTE.names
.(n), 0)
3644 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3645 ignore
(uioh
, first, pan
);
3646 if not cancel
then set active;
3648 method hasaction
_ = true
3652 let modehash = findkeyhash conf
"info" in
3653 coe (new listview ~zebra
:false ~helpmode
:false
3654 ~
source ~trusted
:true ~
modehash)
3657 method fitmodel name get
set =
3659 (name
, `
string get
, 1, Action
(
3663 inherit lvsourcebase
3666 m_active
<- FMTE.to_int conf
.fitmodel
;
3669 method getitemcount
= Array.length
FMTE.names
3670 method getitem
n = (FMTE.names
.(n), 0)
3671 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3672 ignore
(uioh
, first, pan
);
3673 if not cancel
then set active;
3675 method hasaction
_ = true
3679 let modehash = findkeyhash conf
"info" in
3680 coe (new listview ~zebra
:false ~helpmode
:false
3681 ~
source ~trusted
:true ~
modehash)
3684 method caption
s offset
=
3685 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3687 method caption2
s f offset
=
3688 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3690 method getitemcount
= Array.length m_a
3693 let tostr = function
3694 | `
int f -> string_of_int
(f ())
3695 | `intws
f -> string_with_suffix_of_int
(f ())
3697 | `color
f -> color_to_string
(f ())
3698 | `
bool (btos, f) -> btos (f ())
3701 let name, t
, offset
, _ = m_a
.(n) in
3702 ((let s = tostr t
in
3704 then Printf.sprintf
"%s\t%s" name s
3708 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3713 match m_a
.(active) with
3714 | _, _, _, Action
f -> f uioh
3715 | _, _, _, Noaction
-> uioh
3726 method hasaction
n =
3728 | _, _, _, Action
_ -> true
3729 | _, _, _, Noaction
-> false
3732 let rec fillsrc prevmode prevuioh
=
3733 let sep () = src#caption
E.s 0 in
3734 let colorp name get
set =
3736 (fun () -> color_to_string
(get
()))
3739 let c = color_of_string
v in
3742 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3745 let oldmode = state
.mode
in
3746 let birdseye = isbirdseye state
.mode
in
3748 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3750 src#
bool "presentation mode"
3751 (fun () -> conf
.presentation
)
3752 (fun v -> setpresentationmode v);
3754 src#
bool "ignore case in searches"
3755 (fun () -> conf
.icase
)
3756 (fun v -> conf
.icase
<- v);
3759 (fun () -> conf
.preload)
3760 (fun v -> conf
.preload <- v);
3762 src#
bool "highlight links"
3763 (fun () -> conf
.hlinks
)
3764 (fun v -> conf
.hlinks
<- v);
3766 src#
bool "under info"
3767 (fun () -> conf
.underinfo
)
3768 (fun v -> conf
.underinfo
<- v);
3770 src#
bool "persistent bookmarks"
3771 (fun () -> conf
.savebmarks
)
3772 (fun v -> conf
.savebmarks
<- v);
3774 src#fitmodel
"fit model"
3775 (fun () -> FMTE.to_string conf
.fitmodel
)
3776 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3778 src#
bool "trim margins"
3779 (fun () -> conf
.trimmargins
)
3780 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3782 src#
bool "persistent location"
3783 (fun () -> conf
.jumpback
)
3784 (fun v -> conf
.jumpback
<- v);
3787 src#
int "inter-page space"
3788 (fun () -> conf
.interpagespace
)
3790 conf
.interpagespace
<- n;
3791 docolumns conf
.columns
;
3793 match state
.layout with
3798 state
.maxy <- calcheight
();
3799 let y = getpagey
pageno in
3804 (fun () -> conf
.pagebias
)
3805 (fun v -> conf
.pagebias
<- v);
3807 src#
int "scroll step"
3808 (fun () -> conf
.scrollstep
)
3809 (fun n -> conf
.scrollstep
<- n);
3811 src#
int "horizontal scroll step"
3812 (fun () -> conf
.hscrollstep
)
3813 (fun v -> conf
.hscrollstep
<- v);
3815 src#
int "auto scroll step"
3817 match state
.autoscroll
with
3819 | _ -> conf
.autoscrollstep
)
3821 let n = boundastep state
.winh
n in
3822 if state
.autoscroll
<> None
3823 then state
.autoscroll
<- Some
n;
3824 conf
.autoscrollstep
<- n);
3827 (fun () -> truncate
(conf
.zoom *. 100.))
3828 (fun v -> setzoom ((float v) /. 100.));
3831 (fun () -> conf
.angle
)
3832 (fun v -> reqlayout v conf
.fitmodel
);
3834 src#
int "scroll bar width"
3835 (fun () -> conf
.scrollbw
)
3838 reshape state
.winw state
.winh
;
3841 src#
int "scroll handle height"
3842 (fun () -> conf
.scrollh
)
3843 (fun v -> conf
.scrollh
<- v;);
3845 src#
int "thumbnail width"
3846 (fun () -> conf
.thumbw
)
3848 conf
.thumbw
<- min
4096 v;
3851 leavebirdseye beye
false;
3858 let mode = state
.mode in
3859 src#
string "columns"
3861 match conf
.columns
with
3863 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3864 | Csplit
(count
, _) -> "-" ^ string_of_int count
3867 let n, a, b = multicolumns_of_string
v in
3868 setcolumns mode n a b);
3871 src#caption
"Pixmap cache" 0;
3872 src#int_with_suffix
"size (advisory)"
3873 (fun () -> conf
.memlimit
)
3874 (fun v -> conf
.memlimit
<- v);
3877 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3878 (string_with_suffix_of_int state
.memused
)
3879 (Hashtbl.length state
.tilemap
)) 1;
3882 src#caption
"Layout" 0;
3883 src#caption2
"Dimension"
3885 Printf.sprintf
"%dx%d (virtual %dx%d)"
3886 state
.winw state
.winh
3891 src#caption2
"Position" (fun () ->
3892 Printf.sprintf
"%dx%d" state
.x state
.y
3895 src#caption2
"Position" (fun () -> describe_location ()) 1
3899 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3900 "Save these parameters as global defaults at exit"
3901 (fun () -> conf
.bedefault
)
3902 (fun v -> conf
.bedefault
<- v)
3906 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3907 src#
bool ~offset
:0 ~
btos "Extended parameters"
3908 (fun () -> !showextended)
3909 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3913 (fun () -> conf
.checkers
)
3914 (fun v -> conf
.checkers
<- v; setcheckers v);
3915 src#
bool "update cursor"
3916 (fun () -> conf
.updatecurs
)
3917 (fun v -> conf
.updatecurs
<- v);
3918 src#
bool "scroll-bar on the left"
3919 (fun () -> conf
.leftscroll
)
3920 (fun v -> conf
.leftscroll
<- v);
3922 (fun () -> conf
.verbose
)
3923 (fun v -> conf
.verbose
<- v);
3924 src#
bool "invert colors"
3925 (fun () -> conf
.invert
)
3926 (fun v -> conf
.invert
<- v);
3928 (fun () -> conf
.maxhfit
)
3929 (fun v -> conf
.maxhfit
<- v);
3930 src#
bool "redirect stderr"
3931 (fun () -> conf
.redirectstderr)
3932 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
3934 (fun () -> conf
.pax
!= None
)
3937 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3938 else conf
.pax
<- None
);
3939 src#
string "uri launcher"
3940 (fun () -> conf
.urilauncher
)
3941 (fun v -> conf
.urilauncher
<- v);
3942 src#
string "path launcher"
3943 (fun () -> conf
.pathlauncher
)
3944 (fun v -> conf
.pathlauncher
<- v);
3945 src#
string "tile size"
3946 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3949 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3950 conf
.tilew
<- max
64 w;
3951 conf
.tileh
<- max
64 h;
3954 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3957 src#
int "texture count"
3958 (fun () -> conf
.texcount
)
3961 then conf
.texcount
<- v
3962 else showtext '
!'
" Failed to set texture count please retry later"
3964 src#
int "slice height"
3965 (fun () -> conf
.sliceheight
)
3967 conf
.sliceheight
<- v;
3968 wcmd "sliceh %d" conf
.sliceheight
;
3970 src#
int "anti-aliasing level"
3971 (fun () -> conf
.aalevel
)
3973 conf
.aalevel
<- bound
v 0 8;
3974 state
.anchor <- getanchor
();
3975 opendoc state
.path state
.password
;
3977 src#
string "page scroll scaling factor"
3978 (fun () -> string_of_float conf
.pgscale)
3981 let s = float_of_string
v in
3984 state
.text <- Printf.sprintf
3985 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3988 src#
int "ui font size"
3989 (fun () -> fstate
.fontsize
)
3990 (fun v -> setfontsize (bound
v 5 100));
3991 src#
int "hint font size"
3992 (fun () -> conf
.hfsize
)
3993 (fun v -> conf
.hfsize
<- bound
v 5 100);
3994 colorp "background color"
3995 (fun () -> conf
.bgcolor
)
3996 (fun v -> conf
.bgcolor
<- v);
3997 src#
bool "crop hack"
3998 (fun () -> conf
.crophack
)
3999 (fun v -> conf
.crophack
<- v);
4000 src#
string "trim fuzz"
4001 (fun () -> irect_to_string conf
.trimfuzz
)
4004 conf
.trimfuzz
<- irect_of_string
v;
4006 then settrim true conf
.trimfuzz
;
4008 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4010 src#
string "throttle"
4012 match conf
.maxwait
with
4013 | None
-> "show place holder if page is not ready"
4016 then "wait for page to fully render"
4018 "wait " ^ string_of_float
time
4019 ^
" seconds before showing placeholder"
4023 let f = float_of_string
v in
4025 then conf
.maxwait
<- None
4026 else conf
.maxwait
<- Some
f
4028 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4030 src#
string "ghyll scroll"
4032 match conf
.ghyllscroll
with
4034 | Some nab
-> ghyllscroll_to_string nab
4037 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4039 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4041 src#
string "selection command"
4042 (fun () -> conf
.selcmd
)
4043 (fun v -> conf
.selcmd
<- v);
4044 src#
string "synctex command"
4045 (fun () -> conf
.stcmd
)
4046 (fun v -> conf
.stcmd
<- v);
4047 src#
string "pax command"
4048 (fun () -> conf
.paxcmd
)
4049 (fun v -> conf
.paxcmd
<- v);
4050 src#colorspace
"color space"
4051 (fun () -> CSTE.to_string conf
.colorspace
)
4053 conf
.colorspace
<- CSTE.of_int
v;
4057 src#paxmark
"pax mark method"
4058 (fun () -> MTE.to_string conf
.paxmark
)
4059 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4063 (fun () -> conf
.usepbo
)
4064 (fun v -> conf
.usepbo
<- v);
4065 src#
bool "mouse wheel scrolls pages"
4066 (fun () -> conf
.wheelbypage
)
4067 (fun v -> conf
.wheelbypage
<- v);
4068 src#
bool "open remote links in a new instance"
4069 (fun () -> conf
.riani
)
4070 (fun v -> conf
.riani
<- v);
4074 src#caption
"Document" 0;
4075 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4076 src#caption2
"Pages"
4077 (fun () -> string_of_int state
.pagecount
) 1;
4078 src#caption2
"Dimensions"
4079 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4083 src#caption
"Trimmed margins" 0;
4084 src#caption2
"Dimensions"
4085 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4089 src#caption
"OpenGL" 0;
4090 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4091 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4094 src#caption
"Location" 0;
4095 if nonemptystr state
.origin
4096 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4097 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4099 src#reset prevmode prevuioh
;
4104 let prevmode = state
.mode
4105 and prevuioh
= state
.uioh in
4106 fillsrc prevmode prevuioh
;
4107 let source = (src :> lvsource
) in
4108 let modehash = findkeyhash conf
"info" in
4109 state
.uioh <- coe (object (self)
4110 inherit listview ~zebra
:false ~helpmode
:false
4111 ~
source ~trusted
:true ~
modehash as super
4112 val mutable m_prevmemused
= 0
4113 method! infochanged
= function
4115 if m_prevmemused
!= state
.memused
4117 m_prevmemused
<- state
.memused
;
4118 G.postRedisplay "memusedchanged";
4120 | Pdim
-> G.postRedisplay "pdimchanged"
4121 | Docinfo
-> fillsrc prevmode prevuioh
4123 method! key key mask
=
4124 if not
(Wsi.withctrl mask
)
4127 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4128 | @right
| @kpright
-> coe (self#updownlevel
1)
4129 | _ -> super#
key key mask
4130 else super#
key key mask
4132 G.postRedisplay "info";
4138 inherit lvsourcebase
4139 method getitemcount
= Array.length state
.help
4141 let s, l, _ = state
.help
.(n) in
4144 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4148 match state
.help
.(active) with
4149 | _, _, Action
f -> Some
(f uioh)
4150 | _, _, Noaction
-> Some
uioh
4159 method hasaction
n =
4160 match state
.help
.(n) with
4161 | _, _, Action
_ -> true
4162 | _, _, Noaction
-> false
4168 let modehash = findkeyhash conf
"help" in
4170 state
.uioh <- coe (new listview
4171 ~zebra
:false ~helpmode
:true
4172 ~
source ~trusted
:true ~
modehash);
4173 G.postRedisplay "help";
4178 let re = Str.regexp
"[\r\n]" in
4180 inherit lvsourcebase
4181 val mutable m_items
= E.a
4183 method getitemcount
= 1 + Array.length m_items
4188 else m_items
.(n-1), 0
4190 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4195 then Buffer.clear state
.errmsgs
;
4202 method hasaction
n =
4206 state
.newerrmsgs
<- false;
4207 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4208 m_items
<- Array.of_list
l
4217 let source = (msgsource :> lvsource
) in
4218 let modehash = findkeyhash conf
"listview" in
4219 state
.uioh <- coe (object
4220 inherit listview ~zebra
:false ~helpmode
:false
4221 ~
source ~trusted
:false ~
modehash as super
4224 then msgsource#reset
;
4227 G.postRedisplay "msgs";
4230 let enterannotmode =
4233 inherit lvsourcebase
4234 val mutable m_text
= E.s
4235 val mutable m_items
= E.a
4237 method getitemcount
= 1 + Array.length m_items
4240 if n = 0 then "[Copy text to clipboard]", 0
4241 else m_items
.(n - 1), 0
4243 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4244 ignore
(uioh, first, pan
);
4245 if not cancel
&& active = 0
4246 then selstring m_text
;
4249 method hasaction
_ = true
4252 state
.newerrmsgs
<- false;
4253 let rec split accu b i
=
4255 if p = String.length
s
4256 then String.sub
s b (p-b) :: accu
4258 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4260 let ss = if i
= 0 then E.s else String.sub
s b i
in
4261 split (ss::accu) (p+1) 0
4266 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4275 let source = (msgsource :> lvsource
) in
4276 let modehash = findkeyhash conf
"listview" in
4277 state
.uioh <- coe (object
4278 inherit listview ~zebra
:false ~helpmode
:false
4279 ~
source ~trusted
:false ~
modehash
4281 G.postRedisplay "annot";
4284 let gotounder under =
4285 let getpath filename
=
4287 if nonemptystr filename
4289 if Filename.is_relative filename
4291 let dir = Filename.dirname state
.path in
4293 if Filename.is_implicit
dir
4294 then Filename.concat
(Sys.getcwd
()) dir
4297 Filename.concat
dir filename
4301 if Sys.file_exists
path
4306 | Ulinkgoto
(pageno, top) ->
4310 gotopage1 pageno top;
4316 | Uremote
(filename
, pageno) ->
4317 let path = getpath filename
in
4322 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4323 try popen
command []
4325 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
4328 let anchor = getanchor
() in
4329 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
4330 state
.origin
<- E.s;
4331 state
.anchor <- (pageno, 0.0, 0.0);
4332 state
.ranchors
<- ranchor :: state
.ranchors
;
4335 else showtext '
!'
("Could not find " ^ filename
)
4337 | Uremotedest
(filename
, destname
) ->
4338 let path = getpath filename
in
4343 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4344 try popen
command []
4347 "failed to execute `%s': %s\n" command (exntos exn
);
4350 let anchor = getanchor
() in
4351 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
4352 state
.origin
<- E.s;
4353 state
.nameddest
<- destname
;
4354 state
.ranchors
<- ranchor :: state
.ranchors
;
4357 else showtext '
!'
("Could not find " ^ filename
)
4359 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4360 | Uannotation annot
-> enterannotmode annot
4363 let gotooutline (_, _, kind
) =
4367 let (pageno, y, _) = anchor in
4369 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4373 | Ouri
uri -> gotounder (Ulinkuri
uri)
4374 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
4375 | Oremote remote
-> gotounder (Uremote remote
)
4376 | Ohistory
hist -> gotohist hist
4377 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
4381 let outlinesource sourcetype
=
4383 inherit lvsourcebase
4384 val mutable m_items
= E.a
4385 val mutable m_minfo
= E.a
4386 val mutable m_orig_items
= E.a
4387 val mutable m_orig_minfo
= E.a
4388 val mutable m_narrow_patterns
= []
4389 val mutable m_hadremovals
= false
4390 val mutable m_gen
= -1
4392 method getitemcount
=
4393 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4396 if n == Array.length m_items
&& m_hadremovals
4398 ("[Confirm removal]", 0)
4400 let s, n, _ = m_items
.(n) in
4403 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4404 ignore
(uioh, first);
4405 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4407 if m_narrow_patterns
= []
4408 then m_orig_items
, m_orig_minfo
4409 else m_items
, m_minfo
4413 if not
confrimremoval
4415 gotooutline m_items
.(active);
4420 state
.bookmarks
<- Array.to_list m_items
;
4421 m_orig_items
<- m_items
;
4422 m_orig_minfo
<- m_minfo
;
4432 method hasaction
_ = true
4435 if Array.length m_items
!= Array.length m_orig_items
4438 match m_narrow_patterns
with
4440 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4442 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4446 match m_narrow_patterns
with
4449 | head
:: _ -> "@Uellipsis" ^ head
4451 method narrow
pattern =
4452 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
4456 let rec loop accu minfo n =
4459 m_items
<- Array.of_list
accu;
4460 m_minfo
<- Array.of_list
minfo;
4463 let (s, _, t
) as o = m_items
.(n) in
4466 | Oaction
_ -> o :: accu, (0, 0) :: minfo
4467 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4468 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4470 try Str.search_forward
re s 0
4471 with Not_found
-> -1
4474 then o :: accu, (first, Str.match_end
()) :: minfo
4477 loop accu minfo (n-1)
4479 loop [] [] (Array.length m_items
- 1)
4481 method! getminfo
= m_minfo
4485 match sourcetype
with
4486 | `bookmarks
-> Array.of_list state
.bookmarks
4487 | `outlines
-> state
.outlines
4488 | `history
-> genhistoutlines !Config.historder
4490 m_minfo
<- m_orig_minfo
;
4491 m_items
<- m_orig_items
4494 if sourcetype
= `bookmarks
4496 if m >= 0 && m < Array.length m_items
4498 m_hadremovals
<- true;
4499 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4500 let n = if n >= m then n+1 else n in
4505 method add_narrow_pattern
pattern =
4506 m_narrow_patterns
<- pattern :: m_narrow_patterns
4508 method del_narrow_pattern
=
4509 match m_narrow_patterns
with
4510 | _ :: rest
-> m_narrow_patterns
<- rest
4515 match m_narrow_patterns
with
4516 | pattern :: [] -> self#narrow
pattern; pattern
4518 List.fold_left
(fun accu pattern ->
4519 self#narrow
pattern;
4520 pattern ^
"@Uellipsis" ^
accu) E.s list
4522 method calcactive
anchor =
4523 let rely = getanchory anchor in
4524 let rec loop n best bestd
=
4525 if n = Array.length m_items
4528 let _, _, kind
= m_items
.(n) in
4531 let orely = getanchory anchor in
4532 let d = abs
(orely - rely) in
4535 else loop (n+1) best bestd
4536 | Onone
| Oremote
_ | Olaunch
_
4537 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
4538 loop (n+1) best bestd
4542 method reset
anchor items =
4543 m_hadremovals
<- false;
4544 if state
.gen
!= m_gen
4546 m_orig_items
<- items;
4548 m_narrow_patterns
<- [];
4550 m_orig_minfo
<- E.a;
4554 if items != m_orig_items
4556 m_orig_items
<- items;
4557 if m_narrow_patterns
== []
4558 then m_items
<- items;
4561 let active = self#calcactive
anchor in
4563 m_first
<- firstof m_first
active
4567 let enterselector sourcetype
=
4569 let source = outlinesource sourcetype
in
4572 match sourcetype
with
4573 | `bookmarks
-> Array.of_list state
.bookmarks
4574 | `
outlines -> state
.outlines
4575 | `history
-> genhistoutlines !Config.historder
4577 if Array.length
outlines = 0
4579 showtext ' ' errmsg
;
4582 state
.text <- source#greetmsg
;
4583 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4584 let anchor = getanchor
() in
4585 source#reset
anchor outlines;
4587 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4588 G.postRedisplay "enter selector";
4592 let enteroutlinemode =
4593 let f = enterselector `
outlines in
4594 fun () -> f "Document has no outline";
4597 let enterbookmarkmode =
4598 let f = enterselector `bookmarks
in
4599 fun () -> f "Document has no bookmarks (yet)";
4602 let enterhistmode () = enterselector `history
"No history (yet)";;
4604 let quickbookmark ?title
() =
4605 match state
.layout with
4611 let tm = Unix.localtime
(now
()) in
4612 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4616 (tm.Unix.tm_year
+ 1900)
4619 | Some
title -> title
4621 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4624 let setautoscrollspeed step goingdown
=
4625 let incr = max
1 ((abs step
) / 2) in
4626 let incr = if goingdown
then incr else -incr in
4627 let astep = boundastep state
.winh
(step
+ incr) in
4628 state
.autoscroll
<- Some
astep;
4632 match conf
.columns
with
4634 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4637 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4639 let existsinrow pageno (columns
, coverA
, coverB
) p =
4640 let last = ((pageno - coverA
) mod columns
) + columns
in
4641 let rec any = function
4644 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4648 then (if l.pageno = last then false else any rest
)
4656 match state
.layout with
4658 let pageno = page_of_y state
.y in
4659 gotoghyll (getpagey
(pageno+1))
4661 match conf
.columns
with
4663 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4665 let y = clamp (pgscale state
.winh
) in
4668 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4669 gotoghyll (getpagey
pageno)
4670 | Cmulti
((c, _, _) as cl, _) ->
4671 if conf
.presentation
4672 && (existsinrow l.pageno cl
4673 (fun l -> l.pageh
> l.pagey + l.pagevh))
4675 let y = clamp (pgscale state
.winh
) in
4678 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4679 gotoghyll (getpagey
pageno)
4681 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4683 let pagey, pageh
= getpageyh
l.pageno in
4684 let pagey = pagey + pageh
* l.pagecol
in
4685 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4686 gotoghyll (pagey + pageh
+ ips)
4690 match state
.layout with
4692 let pageno = page_of_y state
.y in
4693 gotoghyll (getpagey
(pageno-1))
4695 match conf
.columns
with
4697 if conf
.presentation
&& l.pagey != 0
4699 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4701 let pageno = max
0 (l.pageno-1) in
4702 gotoghyll (getpagey
pageno)
4703 | Cmulti
((c, _, coverB
) as cl, _) ->
4704 if conf
.presentation
&&
4705 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4707 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4710 if l.pageno = state
.pagecount
- coverB
4714 let pageno = max
0 (l.pageno-decr) in
4715 gotoghyll (getpagey
pageno)
4723 let pageno = max
0 (l.pageno-1) in
4724 let pagey, pageh
= getpageyh
pageno in
4727 let pagey, pageh
= getpageyh
l.pageno in
4728 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4733 let viewkeyboard key mask
=
4735 let mode = state
.mode in
4736 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4739 G.postRedisplay "view:enttext"
4741 let ctrl = Wsi.withctrl mask
in
4743 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4748 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4750 state
.mode <- LinkNav
(Ltgendir
0);
4753 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4756 begin match state
.mstate
with
4759 G.postRedisplay "kill zoom rect";
4762 | Mscrolly
| Mscrollx
4765 begin match state
.mode with
4768 G.postRedisplay "esc leave linknav"
4772 match state
.ranchors
with
4774 | (path, password
, anchor, origin
) :: rest
->
4775 state
.ranchors
<- rest
;
4776 state
.anchor <- anchor;
4777 state
.origin
<- origin
;
4778 state
.nameddest
<- E.s;
4779 opendoc path password
4784 gotoghyll (getnav ~
-1)
4795 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4796 G.postRedisplay "dehighlight";
4798 | @slash
| @question
->
4799 let ondone isforw
s =
4800 cbput state
.hists
.pat
s;
4801 state
.searchpattern
<- s;
4804 let s = String.make
1 (Char.chr
key) in
4805 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4806 textentry, ondone (key = @slash
), true)
4808 | @plus
| @kpplus
| @equals
when ctrl ->
4809 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4810 setzoom (conf
.zoom +. incr)
4812 | @plus
| @kpplus
->
4815 try int_of_string
s with exc
->
4816 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4822 state
.text <- "page bias is now " ^ string_of_int
n;
4825 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4827 | @minus
| @kpminus
when ctrl ->
4828 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4829 setzoom (max
0.01 (conf
.zoom -. decr))
4831 | @minus
| @kpminus
->
4832 let ondone msg
= state
.text <- msg
in
4834 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4835 optentry state
.mode, ondone, true
4846 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4848 match conf
.columns
with
4849 | Csingle
_ | Cmulti
_ -> 1
4850 | Csplit
(n, _) -> n
4852 let h = state
.winh
-
4853 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4855 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4856 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4861 match conf
.fitmodel
with
4862 | FitWidth
-> FitProportional
4863 | FitProportional
-> FitPage
4864 | FitPage
-> FitWidth
4866 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4867 reqlayout conf
.angle
fm
4875 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4876 when not
ctrl -> (* 0..9 *)
4879 try int_of_string
s with exc
->
4880 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4886 cbput state
.hists
.pag
(string_of_int
n);
4887 gotopage1 (n + conf
.pagebias
- 1) 0;
4890 let pageentry text key =
4891 match Char.unsafe_chr
key with
4892 | '
g'
-> TEdone
text
4893 | _ -> intentry text key
4895 let text = String.make
1 (Char.chr
key) in
4896 enttext (":", text, Some
(onhist state
.hists
.pag
),
4897 pageentry, ondone, true)
4900 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4901 reshape state
.winw state
.winh
;
4904 state
.bzoom
<- not state
.bzoom
;
4906 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4909 conf
.hlinks
<- not conf
.hlinks
;
4910 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4911 G.postRedisplay "toggle highlightlinks";
4914 state
.glinks
<- true;
4915 let mode = state
.mode in
4916 state
.mode <- Textentry
(
4917 (":", E.s, None
, linknentry, linkndone gotounder, false),
4919 state
.glinks
<- false;
4923 G.postRedisplay "view:linkent(F)"
4926 state
.glinks
<- true;
4927 let mode = state
.mode in
4928 state
.mode <- Textentry
(
4930 ":", E.s, None
, linknentry, linkndone (fun under ->
4931 selstring (undertext under);
4935 state
.glinks
<- false;
4939 G.postRedisplay "view:linkent"
4942 begin match state
.autoscroll
with
4944 conf
.autoscrollstep
<- step
;
4945 state
.autoscroll
<- None
4947 if conf
.autoscrollstep
= 0
4948 then state
.autoscroll
<- Some
1
4949 else state
.autoscroll
<- Some conf
.autoscrollstep
4956 setpresentationmode (not conf
.presentation
);
4957 showtext ' '
("presentation mode " ^
4958 if conf
.presentation
then "on" else "off");
4961 if List.mem
Wsi.Fullscreen state
.winstate
4962 then Wsi.reshape conf
.cwinw conf
.cwinh
4963 else Wsi.fullscreen
()
4966 search state
.searchpattern
false
4969 search state
.searchpattern
true
4972 begin match state
.layout with
4975 gotoghyll (getpagey
l.pageno)
4981 | @delete
| @kpdelete
-> (* delete *)
4985 showtext ' '
(describe_location ());
4988 begin match state
.layout with
4991 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4996 enterbookmarkmode ()
5004 | @e when Buffer.length state
.errmsgs
> 0 ->
5009 match state
.layout with
5014 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5017 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5021 showtext ' '
"Quick bookmark added";
5024 begin match state
.layout with
5026 let rect = getpdimrect
l.pagedimno
in
5030 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5031 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5033 (truncate
(rect.(1) -. rect.(0)),
5034 truncate
(rect.(3) -. rect.(0)))
5036 let w = truncate
((float w)*.conf
.zoom)
5037 and h = truncate
((float h)*.conf
.zoom) in
5040 state
.anchor <- getanchor
();
5041 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5043 G.postRedisplay "z";
5048 | @x -> state
.roam
()
5051 reqlayout (conf
.angle
+
5052 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5056 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5058 G.postRedisplay "brightness";
5060 | @c when state
.mode = View
->
5065 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5067 gotoy_and_clear_text state
.y
5071 match state
.prevcolumns
with
5072 | None
-> (1, 0, 0), 1.0
5073 | Some
(columns
, z
) ->
5076 | Csplit
(c, _) -> -c, 0, 0
5077 | Cmulti
((c, a, b), _) -> c, a, b
5078 | Csingle
_ -> 1, 0, 0
5082 setcolumns View
c a b;
5085 | @down
| @up
when ctrl && Wsi.withshift mask
->
5086 let zoom, x = state
.prevzoom
in
5090 | @k
| @up
| @kpup
->
5091 begin match state
.autoscroll
with
5093 begin match state
.mode with
5094 | Birdseye beye
-> upbirdseye 1 beye
5099 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5101 if not
(Wsi.withshift mask
) && conf
.presentation
5103 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5107 setautoscrollspeed n false
5110 | @j
| @down
| @kpdown
->
5111 begin match state
.autoscroll
with
5113 begin match state
.mode with
5114 | Birdseye beye
-> downbirdseye 1 beye
5119 then gotoy_and_clear_text (clamp (state
.winh
/2))
5121 if not
(Wsi.withshift mask
) && conf
.presentation
5123 else gotoghyll1 true (clamp (conf
.scrollstep
))
5127 setautoscrollspeed n true
5130 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5136 else conf
.hscrollstep
5138 let dx = if key = @left || key = @kpleft
then dx else -dx in
5139 state
.x <- panbound (state
.x + dx);
5140 gotoy_and_clear_text state
.y
5143 G.postRedisplay "left/right"
5146 | @prior
| @kpprior
->
5150 match state
.layout with
5152 | l :: _ -> state
.y - l.pagey
5154 clamp (pgscale (-state
.winh
))
5158 | @next | @kpnext
->
5162 match List.rev state
.layout with
5164 | l :: _ -> getpagey
l.pageno
5166 clamp (pgscale state
.winh
)
5170 | @g | @home
| @kphome
->
5173 | @G
| @jend
| @kpend
->
5175 gotoghyll (clamp state
.maxy)
5177 | @right
| @kpright
when Wsi.withalt mask
->
5178 gotoghyll (getnav 1)
5179 | @left | @kpleft
when Wsi.withalt mask
->
5180 gotoghyll (getnav ~
-1)
5185 | @v when conf
.debug
->
5188 match getopaque l.pageno with
5191 let x0, y0, x1, y1 = pagebbox
opaque in
5192 let a,b = float x0, float y0 in
5193 let c,d = float x1, float y0 in
5194 let e,f = float x1, float y1 in
5195 let h,j
= float x0, float y1 in
5196 let rect = (a,b,c,d,e,f,h,j
) in
5198 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5200 G.postRedisplay "v";
5203 let mode = state
.mode in
5204 let cmd = ref E.s in
5205 let onleave = function
5206 | Cancel
-> state
.mode <- mode
5209 match getopaque l.pageno with
5210 | Some
opaque -> pipesel opaque !cmd
5211 | None
-> ()) state
.layout;
5215 cbput state
.hists
.sel
s;
5219 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5221 G.postRedisplay "|";
5222 state
.mode <- Textentry
(te, onleave);
5225 vlog "huh? %s" (Wsi.keyname
key)
5228 let linknavkeyboard key mask
linknav =
5229 let getpage pageno =
5230 let rec loop = function
5232 | l :: _ when l.pageno = pageno -> Some
l
5233 | _ :: rest
-> loop rest
5234 in loop state
.layout
5236 let doexact (pageno, n) =
5237 match getopaque pageno, getpage pageno with
5238 | Some
opaque, Some
l ->
5239 if key = @enter
|| key = @kpenter
5241 let under = getlink
opaque n in
5242 G.postRedisplay "link gotounder";
5249 Some
(findlink
opaque LDfirst
), -1
5252 Some
(findlink
opaque LDlast
), 1
5255 Some
(findlink
opaque (LDleft
n)), -1
5258 Some
(findlink
opaque (LDright
n)), 1
5261 Some
(findlink
opaque (LDup
n)), -1
5264 Some
(findlink
opaque (LDdown
n)), 1
5269 begin match findpwl
l.pageno dir with
5273 state
.mode <- LinkNav
(Ltgendir
dir);
5274 let y, h = getpageyh
pageno in
5277 then y + h - state
.winh
5282 begin match getopaque pageno, getpage pageno with
5283 | Some
opaque, Some
_ ->
5285 let ld = if dir > 0 then LDfirst
else LDlast
in
5288 begin match link with
5290 showlinktype (getlink
opaque m);
5291 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5292 G.postRedisplay "linknav jpage";
5293 | Lnotfound
-> notfound dir
5299 begin match opt with
5300 | Some Lnotfound
-> pwl l dir;
5301 | Some
(Lfound
m) ->
5305 let _, y0, _, y1 = getlinkrect
opaque m in
5307 then gotopage1 l.pageno y0
5309 let d = fstate
.fontsize
+ 1 in
5310 if y1 - l.pagey > l.pagevh - d
5311 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5312 else G.postRedisplay "linknav";
5314 showlinktype (getlink
opaque m);
5315 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5318 | None
-> viewkeyboard key mask
5320 | _ -> viewkeyboard key mask
5325 G.postRedisplay "leave linknav"
5329 | Ltgendir
_ -> viewkeyboard key mask
5330 | Ltexact exact
-> doexact exact
5333 let keyboard key mask
=
5334 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5335 then wcmd "interrupt"
5336 else state
.uioh <- state
.uioh#
key key mask
5339 let birdseyekeyboard key mask
5340 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5342 match conf
.columns
with
5344 | Cmulti
((c, _, _), _) -> c
5345 | Csplit
_ -> failwith
"bird's eye split mode"
5347 let pgh layout = List.fold_left
5348 (fun m l -> max
l.pageh
m) state
.winh
layout in
5350 | @l when Wsi.withctrl mask
->
5351 let y, h = getpageyh
pageno in
5352 let top = (state
.winh
- h) / 2 in
5353 gotoy (max
0 (y - top))
5354 | @enter
| @kpenter
-> leavebirdseye beye
false
5355 | @escape
-> leavebirdseye beye
true
5356 | @up
-> upbirdseye incr beye
5357 | @down
-> downbirdseye incr beye
5358 | @left -> upbirdseye 1 beye
5359 | @right
-> downbirdseye 1 beye
5362 begin match state
.layout with
5366 state
.mode <- Birdseye
(
5367 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5369 gotopage1 l.pageno 0;
5372 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5374 | [] -> gotoy (clamp (-state
.winh
))
5376 state
.mode <- Birdseye
(
5377 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5379 gotopage1 l.pageno 0
5382 | [] -> gotoy (clamp (-state
.winh
))
5386 begin match List.rev state
.layout with
5388 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5389 begin match layout with
5391 let incr = l.pageh
- l.pagevh in
5396 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5398 G.postRedisplay "birdseye pagedown";
5400 else gotoy (clamp (incr + conf
.interpagespace
*2));
5404 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5405 gotopage1 l.pageno 0;
5408 | [] -> gotoy (clamp state
.winh
)
5412 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5416 let pageno = state
.pagecount
- 1 in
5417 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5418 if not
(pagevisible state
.layout pageno)
5421 match List.rev state
.pdims
with
5423 | (_, _, h, _) :: _ -> h
5425 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5426 else G.postRedisplay "birdseye end";
5428 | _ -> viewkeyboard key mask
5433 match state
.mode with
5434 | Textentry
_ -> scalecolor 0.4
5436 | View
-> scalecolor 1.0
5437 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5438 if l.pageno = hooverpageno
5441 if l.pageno = pageno
5443 let c = scalecolor 1.0 in
5445 GlDraw.line_width
3.0;
5446 let dispx = xadjsb () + l.pagedispx in
5448 (float (dispx-1)) (float (l.pagedispy-1))
5449 (float (dispx+l.pagevw+1))
5450 (float (l.pagedispy+l.pagevh+1))
5452 GlDraw.line_width
1.0;
5461 let postdrawpage l linkindexbase
=
5462 match getopaque l.pageno with
5464 if tileready l l.pagex
l.pagey
5466 let x = l.pagedispx - l.pagex
+ xadjsb ()
5467 and y = l.pagedispy - l.pagey in
5469 match conf
.columns
with
5470 | Csingle
_ | Cmulti
_ ->
5471 (if conf
.hlinks
then 1 else 0)
5473 && not
(isbirdseye state
.mode) then 2 else 0)
5477 match state
.mode with
5478 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5484 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5489 let scrollindicator () =
5490 let sbw, ph
, sh = state
.uioh#
scrollph in
5491 let sbh, pw, sw = state
.uioh#scrollpw
in
5496 else ((state
.winw
- sbw), state
.winw
, 0)
5499 GlDraw.color (0.64, 0.64, 0.64);
5500 filledrect (float x0) 0. (float x1) (float state
.winh
);
5502 (float hx0
) (float (state
.winh
- sbh))
5503 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5505 GlDraw.color (0.0, 0.0, 0.0);
5507 filledrect (float x0) ph
(float x1) (ph
+. sh);
5508 let pw = pw +. float hx0
in
5509 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5513 match state
.mstate
with
5514 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5517 | Msel
((x0, y0), (x1, y1)) ->
5518 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5519 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5520 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5521 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5524 let showrects = function [] -> () | rects
->
5526 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5527 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5529 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5531 if l.pageno = pageno
5533 let dx = float (l.pagedispx - l.pagex
) in
5534 let dy = float (l.pagedispy - l.pagey) in
5535 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5536 Raw.sets_float state
.vraw ~
pos:0
5541 GlArray.vertex `two state
.vraw
;
5542 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5551 GlClear.color (scalecolor2 conf
.bgcolor
);
5552 GlClear.clear
[`
color];
5553 List.iter
drawpage state
.layout;
5555 match state
.mode with
5556 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5557 begin match getopaque pageno with
5559 let dx = xadjsb () in
5560 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5561 let x0 = x0 + dx and x1 = x1 + dx in
5568 | None
-> state
.rects
5570 | LinkNav
(Ltgendir
_)
5573 | View
-> state
.rects
5576 let rec postloop linkindexbase
= function
5578 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5579 postloop linkindexbase rest
5583 postloop 0 state
.layout;
5585 begin match state
.mstate
with
5586 | Mzoomrect
((x0, y0), (x1, y1)) ->
5588 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5589 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5590 filledrect (float x0) (float y0) (float x1) (float y1);
5594 | Mscrolly
| Mscrollx
5603 let zoomrect x y x1 y1 =
5606 and y0 = min
y y1 in
5607 gotoy (state
.y + y0);
5608 state
.anchor <- getanchor
();
5609 let zoom = (float state
.w) /. float (x1 - x0) in
5612 let adjw = wadjsb () + state
.winw
in
5614 then (adjw - state
.w) / 2
5617 match conf
.fitmodel
with
5618 | FitWidth
| FitProportional
-> simple ()
5620 match conf
.columns
with
5622 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5623 | Cmulti
_ | Csingle
_ -> simple ()
5625 state
.x <- (state
.x + margin) - x0;
5631 let g opaque l px py =
5632 match rectofblock
opaque px py with
5634 let x0 = a.(0) -. 20. in
5635 let x1 = a.(1) +. 20. in
5636 let y0 = a.(2) -. 20. in
5637 let zoom = (float state
.w) /. (x1 -. x0) in
5638 let pagey = getpagey
l.pageno in
5639 gotoy_and_clear_text (pagey + truncate
y0);
5640 state
.anchor <- getanchor
();
5641 let margin = (state
.w - l.pagew
)/2 in
5642 state
.x <- -truncate
x0 - margin;
5647 match conf
.columns
with
5649 showtext '
!'
"block zooming does not work properly in split columns mode"
5650 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5654 let winw = wadjsb () + state
.winw - 1 in
5655 let s = float x /. float winw in
5656 let destx = truncate
(float (state
.w + winw) *. s) in
5657 state
.x <- winw - destx;
5658 gotoy_and_clear_text state
.y;
5659 state
.mstate
<- Mscrollx
;
5663 let s = float y /. float state
.winh
in
5664 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5665 gotoy_and_clear_text desty;
5666 state
.mstate
<- Mscrolly
;
5669 let viewmulticlick clicks
x y mask
=
5670 let g opaque l px py =
5678 if markunder
opaque px py mark
5682 match getopaque l.pageno with
5684 | Some
opaque -> pipesel opaque cmd
5686 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5687 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5692 G.postRedisplay "viewmulticlick";
5693 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5697 match conf
.columns
with
5699 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5702 let viewmouse button down
x y mask
=
5704 | n when (n == 4 || n == 5) && not down
->
5705 if Wsi.withctrl mask
5707 match state
.mstate
with
5708 | Mzoom
(oldn
, i
) ->
5716 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5718 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5720 let zoom = conf
.zoom -. incr in
5722 state
.mstate
<- Mzoom
(n, 0);
5724 state
.mstate
<- Mzoom
(n, i
+1);
5726 else state
.mstate
<- Mzoom
(n, 0)
5730 | Mscrolly
| Mscrollx
5732 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5735 match state
.autoscroll
with
5736 | Some step
-> setautoscrollspeed step
(n=4)
5738 if conf
.wheelbypage
|| conf
.presentation
5747 then -conf
.scrollstep
5748 else conf
.scrollstep
5750 let incr = incr * 2 in
5751 let y = clamp incr in
5752 gotoy_and_clear_text y
5755 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5757 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5758 gotoy_and_clear_text state
.y
5760 | 1 when Wsi.withshift mask
->
5761 state
.mstate
<- Mnone
;
5764 match unproject x y with
5765 | Some
(pageno, ux
, uy
) ->
5766 let cmd = Printf.sprintf
5768 conf
.stcmd state
.path pageno ux uy
5774 | 1 when Wsi.withctrl mask
->
5777 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5778 state
.mstate
<- Mpan
(x, y)
5781 state
.mstate
<- Mnone
5786 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5788 state
.mstate
<- Mzoomrect
(p, p)
5791 match state
.mstate
with
5792 | Mzoomrect
((x0, y0), _) ->
5793 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5794 then zoomrect x0 y0 x y
5797 G.postRedisplay "kill accidental zoom rect";
5801 | Mscrolly
| Mscrollx
5807 | 1 when x > state
.winw - vscrollw () ->
5810 let _, position, sh = state
.uioh#
scrollph in
5811 if y > truncate
position && y < truncate
(position +. sh)
5812 then state
.mstate
<- Mscrolly
5815 state
.mstate
<- Mnone
5817 | 1 when y > state
.winh
- hscrollh () ->
5820 let _, position, sw = state
.uioh#scrollpw
in
5821 if x > truncate
position && x < truncate
(position +. sw)
5822 then state
.mstate
<- Mscrollx
5825 state
.mstate
<- Mnone
5827 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5830 let dest = if down
then getunder x y else Unone
in
5831 begin match dest with
5834 | Uremote
_ | Uremotedest
_
5835 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5838 | Unone
when down
->
5839 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5840 state
.mstate
<- Mpan
(x, y);
5842 | Uannotation contents
-> enterannotmode contents
5844 | Unone
| Utext
_ ->
5849 state
.mstate
<- Msel
((x, y), (x, y));
5850 G.postRedisplay "mouse select";
5854 match state
.mstate
with
5857 | Mzoom
_ | Mscrollx
| Mscrolly
->
5858 state
.mstate
<- Mnone
5860 | Mzoomrect
((x0, y0), _) ->
5864 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5865 state
.mstate
<- Mnone
5867 | Msel
((x0, y0), (x1, y1)) ->
5868 let rec loop = function
5872 let a0 = l.pagedispy in
5873 let a1 = a0 + l.pagevh in
5874 let b0 = l.pagedispx in
5875 let b1 = b0 + l.pagevw in
5876 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5877 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5881 match getopaque l.pageno with
5884 match Unix.pipe
() with
5888 "can not create sel pipe: %s"
5892 Ne.clo fd
(fun msg
->
5893 dolog
"%s close failed: %s" what msg
)
5896 try popen
cmd [r, 0; w, -1]; true
5898 dolog
"can not execute %S: %s"
5905 G.postRedisplay "copysel";
5907 else clo "Msel pipe/w" w;
5908 clo "Msel pipe/r" r;
5910 dosel conf
.selcmd
();
5911 state
.roam
<- dosel conf
.paxcmd
;
5923 let birdseyemouse button down
x y mask
5924 (conf
, leftx
, _, hooverpageno
, anchor) =
5927 let rec loop = function
5930 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5931 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5933 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5939 | _ -> viewmouse button down
x y mask
5945 method key key mask
=
5946 begin match state
.mode with
5947 | Textentry
textentry -> textentrykeyboard key mask
textentry
5948 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5949 | View
-> viewkeyboard key mask
5950 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5954 method button button bstate
x y mask
=
5955 begin match state
.mode with
5957 | View
-> viewmouse button bstate
x y mask
5958 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5963 method multiclick clicks
x y mask
=
5964 begin match state
.mode with
5966 | View
-> viewmulticlick clicks
x y mask
5973 begin match state
.mode with
5975 | View
| Birdseye
_ | LinkNav
_ ->
5976 match state
.mstate
with
5977 | Mzoom
_ | Mnone
-> ()
5982 state
.mstate
<- Mpan
(x, y);
5984 then state
.x <- panbound (state
.x + dx);
5986 gotoy_and_clear_text y
5989 state
.mstate
<- Msel
(a, (x, y));
5990 G.postRedisplay "motion select";
5993 let y = min state
.winh
(max
0 y) in
5997 let x = min state
.winw (max
0 x) in
6000 | Mzoomrect
(p0
, _) ->
6001 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6002 G.postRedisplay "motion zoomrect";
6006 method pmotion
x y =
6007 begin match state
.mode with
6008 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6009 let rec loop = function
6011 if hooverpageno
!= -1
6013 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6014 G.postRedisplay "pmotion birdseye no hoover";
6017 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6018 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6020 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6021 G.postRedisplay "pmotion birdseye hoover";
6031 match state
.mstate
with
6032 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
6041 let past, _, _ = !r in
6043 let delta = now -. past in
6046 else r := (now, x, y)
6050 method infochanged
_ = ()
6053 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6056 then 0.0, float state
.winh
6057 else scrollph state
.y maxy
6062 let winw = wadjsb () + state
.winw in
6063 let fwinw = float winw in
6065 let sw = fwinw /. float state
.w in
6066 let sw = fwinw *. sw in
6067 max
sw (float conf
.scrollh
)
6070 let maxx = state
.w + winw in
6071 let x = winw - state
.x in
6072 let percent = float x /. float maxx in
6073 (fwinw -. sw) *. percent
6075 hscrollh (), position, sw
6079 match state
.mode with
6080 | LinkNav
_ -> "links"
6081 | Textentry
_ -> "textentry"
6082 | Birdseye
_ -> "birdseye"
6085 findkeyhash conf
modename
6087 method eformsgs
= true
6088 method alwaysscrolly
= false
6091 let adderrmsg src msg
=
6092 Buffer.add_string state
.errmsgs msg
;
6093 state
.newerrmsgs
<- true;
6097 let adderrfmt src fmt
=
6098 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6102 let cl = splitatspace cmds
in
6104 try Scanf.sscanf
s fmt
f
6106 adderrfmt "remote exec"
6107 "error processing '%S': %s\n" cmds
(exntos exn
)
6110 | "reload" :: [] -> reload ()
6111 | "goto" :: args
:: [] ->
6112 scan args
"%u %f %f"
6114 let cmd, _ = state
.geomcmds
in
6116 then gotopagexy pageno x y
6119 gotopagexy pageno x y;
6122 state
.reprf
<- f state
.reprf
6124 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6125 | "gotor" :: args
:: [] ->
6127 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6128 | "gotord" :: args
:: [] ->
6130 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6131 | "rect" :: args
:: [] ->
6132 scan args
"%u %u %f %f %f %f"
6133 (fun pageno color x0 y0 x1 y1 ->
6134 onpagerect pageno (fun w h ->
6135 let _,w1,h1
,_ = getpagedim
pageno in
6136 let sw = float w1 /. float w
6137 and sh = float h1
/. float h in
6141 and y1s
= y1 *. sh in
6142 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6144 state
.rects <- (pageno, color, rect) :: state
.rects;
6145 G.postRedisplay "rect";
6148 | "activatewin" :: [] -> Wsi.activatewin
()
6149 | "quit" :: [] -> raise Quit
6151 adderrfmt "remote command"
6152 "error processing remote command: %S\n" cmds
;
6156 let scratch = Bytes.create
80 in
6157 let buf = Buffer.create
80 in
6160 try Some
(Unix.read fd
scratch 0 80)
6162 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6163 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6166 match tempfr () with
6172 if Buffer.length
buf > 0
6174 let s = Buffer.contents
buf in
6184 let pos = Bytes.index_from
scratch ppos '
\n'
in
6185 if pos >= n then -1 else pos
6186 with Not_found
-> -1
6190 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6191 let s = Buffer.contents
buf in
6197 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6203 let remoteopen path =
6204 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6206 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6211 let gcconfig = ref E.s in
6212 let trimcachepath = ref E.s in
6213 let rcmdpath = ref E.s in
6214 let pageno = ref None
in
6215 let rootwid = ref 0 in
6216 let openlast = ref false in
6217 let nofc = ref false in
6218 selfexec := Sys.executable_name
;
6221 [("-p", Arg.String
(fun s -> state
.password
<- s),
6222 "<password> Set password");
6226 Config.fontpath
:= s;
6227 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6229 "<path> Set path to the user interface font");
6233 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6234 Config.confpath
:= s),
6235 "<path> Set path to the configuration file");
6237 ("-last", Arg.Set
openlast, " Open last document");
6239 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6240 "<page-number> Jump to page");
6242 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6243 "<path> Set path to the trim cache file");
6245 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6246 "<named-destination> Set named destination");
6248 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6249 ("-cxack", Arg.Set
cxack, " Cut corners");
6251 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6252 "<path> Set path to the remote commands source");
6254 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6255 "<original-path> Set original path");
6257 ("-gc", Arg.Set_string
gcconfig,
6258 "<script-path> Collect garbage with the help of a script");
6260 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6262 ("-v", Arg.Unit
(fun () ->
6264 "%s\nconfiguration path: %s\n"
6268 exit
0), " Print version and exit");
6270 ("-embed", Arg.Set_int
rootwid,
6271 "<window-id> Embed into window")
6274 (fun s -> state
.path <- s)
6275 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6278 then selfexec := !selfexec ^
" -wtmode";
6280 let histmode = emptystr state
.path && not
!openlast in
6282 if not
(Config.load !openlast)
6283 then prerr_endline
"failed to load configuration";
6284 begin match !pageno with
6285 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6289 if not
(emptystr
!gcconfig)
6292 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6294 error
"gc socketpair failed: %s" (exntos exn
)
6297 match popen
!gcconfig [(c, 0); (c, 1)] with
6302 error
"failed to popen gc script: %s" (exntos exn
);
6305 let wsfd, winw, winh
= Wsi.init
(object (self)
6306 val mutable m_clicks
= 0
6307 val mutable m_click_x
= 0
6308 val mutable m_click_y
= 0
6309 val mutable m_lastclicktime
= infinity
6311 method private cleanup
=
6312 state
.roam
<- noroam
;
6313 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6314 method expose
= G.postRedisplay"expose"
6318 | Wsi.Unobscured
-> "unobscured"
6319 | Wsi.PartiallyObscured
-> "partiallyobscured"
6320 | Wsi.FullyObscured
-> "fullyobscured"
6322 vlog "visibility change %s" name
6323 method display = display ()
6324 method map mapped
= vlog "mappped %b" mapped
6325 method reshape w h =
6328 method mouse
b d x y m =
6329 if d && canselect ()
6331 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6337 if abs
x - m_click_x
> 10
6338 || abs
y - m_click_y
> 10
6339 || abs_float
(t -. m_lastclicktime
) > 0.3
6341 m_clicks
<- m_clicks
+ 1;
6342 m_lastclicktime
<- t;
6346 G.postRedisplay "cleanup";
6347 state
.uioh <- state
.uioh#button
b d x y m;
6349 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6354 m_lastclicktime
<- infinity
;
6355 state
.uioh <- state
.uioh#button
b d x y m
6359 state
.uioh <- state
.uioh#button
b d x y m
6362 state
.mpos
<- (x, y);
6363 state
.uioh <- state
.uioh#motion
x y
6364 method pmotion
x y =
6365 state
.mpos
<- (x, y);
6366 state
.uioh <- state
.uioh#pmotion
x y
6368 let mascm = m land (
6369 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6372 let x = state
.x and y = state
.y in
6374 if x != state
.x || y != state
.y then self#cleanup
6376 match state
.keystate
with
6378 let km = k
, mascm in
6381 let modehash = state
.uioh#
modehash in
6382 try Hashtbl.find modehash km
6384 try Hashtbl.find (findkeyhash conf
"global") km
6385 with Not_found
-> KMinsrt
(k
, m)
6387 | KMinsrt
(k
, m) -> keyboard k
m
6388 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6389 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6391 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6392 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6393 state
.keystate
<- KSnone
6394 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6395 state
.keystate
<- KSinto
(keys
, insrt
)
6396 | KSinto
_ -> state
.keystate
<- KSnone
6399 state
.mpos
<- (x, y);
6400 state
.uioh <- state
.uioh#pmotion
x y
6401 method leave = state
.mpos
<- (-1, -1)
6402 method winstate wsl
= state
.winstate
<- wsl
6403 method quit
= raise Quit
6404 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6409 List.exists
GlMisc.check_extension
6410 [ "GL_ARB_texture_rectangle"
6411 ; "GL_EXT_texture_recangle"
6412 ; "GL_NV_texture_rectangle" ]
6414 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6417 let r = GlMisc.get_string `renderer
in
6418 let p = "Mesa DRI Intel(" in
6419 let l = String.length
p in
6420 String.length
r > l && String.sub
r 0 l = p
6423 defconf
.sliceheight
<- 1024;
6424 defconf
.texcount
<- 32;
6425 defconf
.usepbo
<- true;
6429 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6431 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6439 setcheckers conf
.checkers
;
6441 if conf
.redirectstderr
6445 (Buffer.to_bytes state
.errmsgs
)
6446 (match state
.errfd
with
6448 let s = Bytes.create
(80*24) in
6451 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6453 then Unix.read fd
s 0 (Bytes.length
s)
6459 else Bytes.sub
s 0 n
6463 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6464 with exn
-> print_endline
(exntos exn
)
6469 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6470 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6471 !Config.fontpath
, !trimcachepath,
6472 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6475 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6481 Wsi.settitle
"llpp (history)";
6485 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6486 opendoc state
.path state
.password
;
6491 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6494 if nonemptystr
!rcmdpath
6495 then remoteopen !rcmdpath
6500 let rec loop deadline
=
6502 match state
.errfd
with
6503 | None
-> [state
.ss; state
.wsfd]
6504 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6509 | Some fd
-> fd
:: r
6513 state
.redisplay
<- false;
6520 if deadline
= infinity
6522 else max
0.0 (deadline
-. now)
6527 try Unix.select
r [] [] timeout
6528 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6534 if state
.ghyll
== noghyll
6536 match state
.autoscroll
with
6537 | Some step
when step
!= 0 ->
6538 let y = state
.y + step
in
6542 else if y >= state
.maxy then 0 else y
6545 if state
.mode = View
6546 then state
.text <- E.s;
6549 else deadline
+. 0.01
6554 let rec checkfds = function
6556 | fd
:: rest
when fd
= state
.ss ->
6557 let cmd = readcmd state
.ss in
6561 | fd
:: rest
when fd
= state
.wsfd ->
6565 | fd
:: rest
when Some fd
= !optrfd ->
6566 begin match remote fd
with
6567 | None
-> optrfd := remoteopen !rcmdpath;
6568 | opt -> optrfd := opt
6573 let s = Bytes.create
80 in
6574 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6575 if conf
.redirectstderr
6577 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6578 state
.newerrmsgs
<- true;
6579 state
.redisplay
<- true;
6582 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6588 if !reeenterhist then (
6590 reeenterhist := false;
6594 if deadline
= infinity
6598 match state
.autoscroll
with
6599 | Some step
when step
!= 0 -> deadline1
6600 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6608 Config.save
leavebirdseye;