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#hashscrollb
100 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
106 if not state
.uioh#hasvscrollb
111 let wadjsb w
= w
- vscrollw ();;
112 let xadjsb x
= if conf
.leftscroll
then x
+ vscrollw () else x
;;
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 rec fold accu
n =
510 if n = Array.length
b
513 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
516 || n = state
.pagecount
- coverB
517 || (n - coverA
) mod columns
= columns
- 1)
523 let pagey = max
0 (y - vy
) in
524 let pagedispy = if pagey > 0 then 0 else vy
- y in
525 let pagedispx, pagex
=
527 if n = coverA
- 1 || n = state
.pagecount
- coverB
528 then state
.x + (wadjsb state
.winw
- w
) / 2
529 else dx + xoff
+ state
.x
536 let vw = wadjsb state
.winw
- pagedispx in
537 let pw = w
- pagex
in
540 let pagevh = min
(h
- pagey) (sh - pagedispy) in
541 if pagevw > 0 && pagevh > 0
552 ; pagedispx = pagedispx
553 ; pagedispy = pagedispy
565 if Array.length
b = 0
567 else List.rev
(fold [] (page_of_y
y))
570 let layoutS (columns
, b) y sh =
571 let sh = sh - hscrollh () in
572 let rec fold accu n =
573 if n = Array.length
b
576 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
583 let x = xoff
+ state
.x in
584 let pagey = max
0 (y - vy
) in
585 let pagedispy = if pagey > 0 then 0 else vy
- y in
586 let pagedispx, pagex
=
600 let pagecolw = pagew
/columns
in
602 if pagecolw < state
.winw
603 then pagedispx + ((wadjsb state
.winw
- pagecolw) / 2)
607 let vw = wadjsb state
.winw
- pagedispx in
608 let pw = pagew
- pagex
in
611 let pagevw = min
pagevw pagecolw in
612 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
613 if pagevw > 0 && pagevh > 0
624 ; pagedispx = pagedispx
625 ; pagedispy = pagedispy
626 ; pagecol
= n mod columns
641 if nogeomcmds state
.geomcmds
643 match conf
.columns
with
644 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
645 | Cmulti
c -> layoutN c y sh
646 | Csplit
s -> layoutS s y sh
651 let y = state
.y + incr
in
653 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
658 let tilex = l.pagex
mod conf
.tilew
in
659 let tiley = l.pagey mod conf
.tileh
in
661 let col = l.pagex
/ conf
.tilew
in
662 let row = l.pagey / conf
.tileh
in
664 let rec rowloop row y0 dispy h
=
668 let dh = conf
.tileh
- y0 in
670 let rec colloop col x0 dispx w
=
674 let dw = conf
.tilew
- x0 in
676 let dispx'
= xadjsb dispx in
677 f col row dispx' dispy
x0 y0 dw dh;
678 colloop (col+1) 0 (dispx+dw) (w
-dw)
681 colloop col tilex l.pagedispx l.pagevw;
682 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
685 if l.pagevw > 0 && l.pagevh > 0
686 then rowloop row tiley l.pagedispy l.pagevh;
689 let gettileopaque l col row =
691 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
693 try Some
(Hashtbl.find state
.tilemap
key)
694 with Not_found
-> None
697 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
698 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
699 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
702 let filledrect x0 y0 x1 y1 =
703 GlArray.disable `texture_coord
;
704 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
705 GlArray.vertex `two state
.vraw
;
706 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
707 GlArray.enable `texture_coord
;
710 let linerect x0 y0 x1 y1 =
711 GlArray.disable `texture_coord
;
712 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
713 GlArray.vertex `two state
.vraw
;
714 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
715 GlArray.enable `texture_coord
;
718 let drawtiles l color
=
721 let f col row x y tilex tiley w h
=
722 match gettileopaque l col row with
723 | Some
(opaque
, _
, t
) ->
724 let params = x, y, w
, h
, tilex, tiley in
726 then GlTex.env
(`mode `blend
);
727 drawtile
params opaque
;
729 then GlTex.env
(`mode `modulate
);
733 let s = Printf.sprintf
737 let w = measurestr fstate
.fontsize
s in
738 GlDraw.color
(0.0, 0.0, 0.0);
739 filledrect (float (x-2))
742 (float (y + fstate
.fontsize
+ 2));
743 GlDraw.color
(1.0, 1.0, 1.0);
744 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
754 let lw = wadjsb state
.winw
- x in
757 let lh = state
.winh
- y in
761 then GlTex.env
(`mode `blend
);
762 begin match state
.checkerstexid
with
764 Gl.enable `texture_2d
;
765 GlTex.bind_texture ~target
:`texture_2d id
;
769 and y1 = float (y+h
) in
771 let tw = float w /. 16.0
772 and th
= float h
/. 16.0 in
773 let tx0 = float tilex /. 16.0
774 and ty0
= float tiley /. 16.0 in
776 and ty1
= ty0
+. th
in
777 Raw.sets_float state
.vraw ~pos
:0
778 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
779 Raw.sets_float state
.traw ~pos
:0
780 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
781 GlArray.vertex `two state
.vraw
;
782 GlArray.tex_coord `two state
.traw
;
783 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
784 Gl.disable `texture_2d
;
787 GlDraw.color
(1.0, 1.0, 1.0);
788 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
791 then GlTex.env
(`mode `modulate
);
792 if w > 128 && h
> fstate
.fontsize
+ 10
794 let c = if conf
.invert
then 1.0 else 0.0 in
795 GlDraw.color
(c, c, c);
798 then (col*conf
.tilew
, row*conf
.tileh
)
801 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
810 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
812 let tilevisible1 l x y =
814 and ax1
= l.pagex
+ l.pagevw
816 and ay1
= l.pagey + l.pagevh in
820 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
821 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
823 let rx0 = max
ax0 bx0
824 and ry0
= max ay0 by0
825 and rx1
= min ax1
bx1
826 and ry1
= min ay1 by1
in
828 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
832 let tilevisible layout n x y =
833 let rec findpageinlayout m
= function
834 | l :: rest
when l.pageno
= n ->
835 tilevisible1 l x y || (
836 match conf
.columns
with
837 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
842 | _
:: rest
-> findpageinlayout 0 rest
845 findpageinlayout 0 layout;
848 let tileready l x y =
849 tilevisible1 l x y &&
850 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
853 let tilepage n p
layout =
854 let rec loop = function
858 let f col row _ _ _ _ _ _
=
859 if state
.currently
= Idle
861 match gettileopaque l col row with
864 let x = col*conf
.tilew
865 and y = row*conf
.tileh
in
867 let w = l.pagew
- x in
871 let h = l.pageh
- y in
876 then getpbo
w h conf
.colorspace
879 wcmd "tile %s %d %d %d %d %s"
880 (~
> p
) x y w h (~
> pbo);
883 l, p
, conf
.colorspace
, conf
.angle
,
884 state
.gen
, col, row, conf
.tilew
, conf
.tileh
893 if nogeomcmds state
.geomcmds
897 let preloadlayout y =
898 let y = if y < state
.winh
then 0 else y - state
.winh
in
899 let h = state
.winh
*3 in
905 if state
.currently
!= Idle
910 begin match getopaque l.pageno
with
912 wcmd "page %d %d" l.pageno
l.pagedimno
;
913 state
.currently
<- Loading
(l, state
.gen
);
915 tilepage l.pageno opaque pages
;
920 if nogeomcmds state
.geomcmds
926 if conf
.preload && state
.currently
= Idle
927 then load (preloadlayout state
.y);
930 let layoutready layout =
931 let rec fold all ls
=
934 let seen = ref false in
935 let allvisible = ref true in
936 let foo col row _ _ _ _ _ _
=
938 allvisible := !allvisible &&
939 begin match gettileopaque l col row with
945 fold (!seen && !allvisible) rest
948 let alltilesvisible = fold true layout in
953 let y = bound
y 0 state
.maxy
in
954 let y, layout, proceed
=
955 match conf
.maxwait
with
956 | Some time
when state
.ghyll
== noghyll
->
957 begin match state
.throttle
with
959 let layout = layout y state
.winh
in
960 let ready = layoutready layout in
964 state
.throttle
<- Some
(layout, y, now
());
966 else G.postRedisplay "gotoy showall (None)";
968 | Some
(_
, _
, started
) ->
969 let dt = now
() -. started
in
972 state
.throttle
<- None
;
973 let layout = layout y state
.winh
in
975 G.postRedisplay "maxwait";
982 let layout = layout y state
.winh
in
983 if not
!wtmode || layoutready layout
984 then G.postRedisplay "gotoy ready";
990 state
.layout <- layout;
991 begin match state
.mode
with
994 | Ltexact
(pageno
, linkno
) ->
995 let rec loop = function
997 state
.mode
<- LinkNav
(Ltgendir
0)
998 | l :: _
when l.pageno
= pageno
->
999 begin match getopaque pageno
with
1001 state
.mode
<- LinkNav
(Ltgendir
0)
1003 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1004 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1005 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1006 then state
.mode
<- LinkNav
(Ltgendir
0)
1008 | _
:: rest
-> loop rest
1017 begin match state
.mode
with
1018 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1019 if not
(pagevisible layout pageno
)
1021 match state
.layout with
1024 state
.mode
<- Birdseye
(
1025 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1032 let rec loop = function
1035 match getopaque l.pageno
with
1041 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1043 if dir
> 0 then LDfirst
else LDlast
1049 | Lnotfound
-> loop rest
1051 showlinktype (getlink opaque
n);
1052 Ltexact
(l.pageno
, n)
1056 state
.mode
<- LinkNav
linknav
1064 state
.ghyll
<- noghyll
;
1067 let mx, my
= state
.mpos
in
1072 let conttiling pageno opaque
=
1073 tilepage pageno opaque
1074 (if conf
.preload then preloadlayout state
.y else state
.layout)
1077 let gotoy_and_clear_text y =
1078 if not conf
.verbose
then state
.text <- E.s;
1082 let getanchory (n, top
, dtop
) =
1083 let y, h = getpageyh
n in
1084 if conf
.presentation
1086 let ips = calcips
h in
1087 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1089 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1092 let gotoanchor anchor
=
1093 gotoy (getanchory anchor
);
1097 cbput state
.hists
.nav
(getanchor
());
1101 let anchor = cbgetc state
.hists
.nav dir
in
1105 let gotoghyll1 single
y =
1106 let scroll f n a
b =
1107 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1109 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1111 then s (float f /. float a
)
1114 then 1.0 -. s ((float (f-b) /. float (n-b)))
1120 let ins = float a
*. 0.5
1121 and outs
= float (n-b) *. 0.5 in
1123 ins +. outs
+. float ones
1125 let rec set nab
y sy
=
1126 let (_N
, _A
, _B
), y =
1129 let scl = if y > sy
then 2 else -2 in
1130 let _N, _
, _
= nab
in
1131 (_N,0,_N), y+conf
.scrollstep
*scl
1133 let sum = summa
_N _A _B
in
1134 let dy = float (y - sy
) in
1138 then state
.ghyll
<- noghyll
1141 let s = scroll n _N _A _B
in
1142 let y1 = y1 +. ((s *. dy) /. sum) in
1143 gotoy_and_clear_text (truncate
y1);
1144 state
.ghyll
<- gf (n+1) y1;
1148 | Some
y'
when single
-> set nab
y' state
.y
1149 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1151 gf 0 (float state
.y)
1154 match conf
.ghyllscroll
with
1155 | Some nab
when not conf
.presentation
->
1156 if state
.ghyll
== noghyll
1157 then set nab
y state
.y
1158 else state
.ghyll
(Some
y)
1160 gotoy_and_clear_text y
1163 let gotoghyll = gotoghyll1 false;;
1165 let gotopage n top
=
1166 let y, h = getpageyh
n in
1167 let y = y + (truncate
(top
*. float h)) in
1171 let gotopage1 n top
=
1172 let y = getpagey
n in
1177 let invalidate s f =
1182 match state
.geomcmds
with
1183 | ps
, [] when emptystr ps
->
1185 state
.geomcmds
<- s, [];
1188 state
.geomcmds
<- ps
, [s, f];
1190 | ps
, (s'
, _
) :: rest
when s'
= s ->
1191 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1194 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1198 Hashtbl.iter
(fun _ opaque
->
1199 wcmd "freepage %s" (~
> opaque
);
1201 Hashtbl.clear state
.pagemap
;
1205 if not
(Queue.is_empty state
.tilelru
)
1207 Queue.iter
(fun (k
, p
, s) ->
1208 wcmd "freetile %s" (~
> p
);
1209 state
.memused
<- state
.memused
- s;
1210 Hashtbl.remove state
.tilemap k
;
1212 state
.uioh#infochanged Memused
;
1213 Queue.clear state
.tilelru
;
1219 let h = truncate
(float h*.conf
.zoom
) in
1220 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1224 let opendoc path password
=
1226 state
.password
<- password
;
1227 state
.gen
<- state
.gen
+ 1;
1228 state
.docinfo
<- [];
1229 state
.outlines
<- [||];
1232 setaalevel conf
.aalevel
;
1234 if emptystr state
.origin
1238 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1239 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1240 invalidate "reqlayout"
1242 wcmd "reqlayout %d %d %d %s\000"
1243 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1244 (stateh state
.winh
) state
.nameddest
1249 state
.anchor <- getanchor
();
1250 opendoc state
.path state
.password
;
1254 let c = c *. conf
.colorscale
in
1258 let scalecolor2 (r
, g, b) =
1259 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1262 let docolumns = function
1264 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1265 let rec loop pageno
pdimno pdim
y ph pdims
=
1266 if pageno
= state
.pagecount
1269 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1271 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1272 pdimno+1, pdim
, rest
1276 let x = max
0 (((wadjsb state
.winw
- w) / 2) - xoff
) in
1278 (if conf
.presentation
1279 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1280 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1283 a.(pageno
) <- (pdimno, x, y, pdim
);
1284 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1286 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1287 conf
.columns
<- Csingle
a;
1289 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1290 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1291 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1292 let rec fixrow m
= if m
= pageno
then () else
1293 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1296 let y = y + (rowh
- h) / 2 in
1297 a.(m
) <- (pdimno, x, y, pdim
);
1301 if pageno
= state
.pagecount
1302 then fixrow (((pageno
- 1) / columns
) * columns
)
1304 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1306 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1307 pdimno+1, pdim
, rest
1312 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1314 let x = (wadjsb state
.winw
- w) / 2 in
1316 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1317 x, y + ips + rowh
, h
1320 if (pageno
- coverA
) mod columns
= 0
1322 let x = max
0 (wadjsb state
.winw
- state
.w) / 2 in
1324 if conf
.presentation
1326 let ips = calcips
h in
1327 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1329 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1333 else x, y, max rowh
h
1337 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1340 if pageno
= columns
&& conf
.presentation
1342 let ips = calcips rowh
in
1343 for i
= 0 to pred columns
1345 let (pdimno, x, y, pdim
) = a.(i
) in
1346 a.(i
) <- (pdimno, x, y+ips, pdim
)
1352 fixrow (pageno
- columns
);
1357 a.(pageno
) <- (pdimno, x, y, pdim
);
1358 let x = x + w + xoff
*2 + conf
.interpagespace
in
1359 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1361 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1362 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1365 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1366 let rec loop pageno
pdimno pdim
y pdims
=
1367 if pageno
= state
.pagecount
1370 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1372 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1373 pdimno+1, pdim
, rest
1378 let rec loop1 n x y =
1379 if n = c then y else (
1380 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1381 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1384 let y = loop1 0 0 y in
1385 loop (pageno
+1) pdimno pdim
y pdims
1387 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1388 conf
.columns
<- Csplit
(c, a);
1392 docolumns conf
.columns
;
1393 state
.maxy
<- calcheight
();
1394 if state
.reprf
== noreprf
1396 match state
.mode
with
1397 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1398 let y, h = getpageyh pageno
in
1399 let top = (state
.winh
- h) / 2 in
1400 gotoy (max
0 (y - top))
1403 | LinkNav _
-> gotoanchor state
.anchor
1407 state
.reprf
<- noreprf
;
1412 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1413 let firsttime = state
.geomcmds
== firstgeomcmds
in
1414 if not
firsttime && nogeomcmds state
.geomcmds
1415 then state
.anchor <- getanchor
();
1418 let w = wadjsb (truncate
(float w *. conf
.zoom
)) in
1421 setfontsize fstate
.fontsize
;
1422 GlMat.mode `modelview
;
1423 GlMat.load_identity
();
1425 GlMat.mode `projection
;
1426 GlMat.load_identity
();
1427 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1428 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1429 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1434 else float state
.x /. float state
.w
1436 invalidate "geometry"
1440 then state
.x <- truncate
(relx *. float w);
1442 match conf
.columns
with
1444 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1445 | Csplit
(c, _
) -> w * c
1447 wcmd "geometry %d %d %d"
1448 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1453 let len = String.length state
.text in
1454 let x0 = xadjsb 0 in
1457 match state
.mode
with
1458 | Textentry _
| View
| LinkNav _
->
1459 let h, _
, _
= state
.uioh#scrollpw
in
1464 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1465 (x+.w) (float (state
.winh
- hscrollh))
1468 let w = float (wadjsb state
.winw
- 1) in
1469 if state
.progress
>= 0.0 && state
.progress
< 1.0
1471 GlDraw.color
(0.3, 0.3, 0.3);
1472 let w1 = w *. state
.progress
in
1474 GlDraw.color
(0.0, 0.0, 0.0);
1475 rect (float x0+.w1) (float x0+.w-.w1)
1478 GlDraw.color
(0.0, 0.0, 0.0);
1482 GlDraw.color
(1.0, 1.0, 1.0);
1483 drawstring fstate
.fontsize
1484 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1485 (state
.winh
- hscrollh - 5) s;
1488 match state
.mode
with
1489 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1493 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1495 Printf.sprintf
"%s%s_" prefix
text
1501 | LinkNav _
-> state
.text
1506 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1508 let s1 = "(press 'e' to review error messasges)" in
1509 if nonemptystr
s then s ^
" " ^
s1 else s1
1519 let len = Queue.length state
.tilelru
in
1521 match state
.throttle
with
1524 then preloadlayout state
.y
1526 | Some
(layout, _
, _
) ->
1530 if state
.memused
<= conf
.memlimit
1535 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1536 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1537 let (_
, pw, ph
, _
) = getpagedim
n in
1540 && colorspace
= conf
.colorspace
1541 && angle
= conf
.angle
1545 let x = col*conf
.tilew
1546 and y = row*conf
.tileh
in
1547 tilevisible (Lazy.force_val
layout) n x y
1549 then Queue.push lruitem state
.tilelru
1552 wcmd "freetile %s" (~
> p
);
1553 state
.memused
<- state
.memused
- s;
1554 state
.uioh#infochanged Memused
;
1555 Hashtbl.remove state
.tilemap k
;
1563 let logcurrently = function
1564 | Idle
-> dolog
"Idle"
1565 | Loading
(l, gen
) ->
1566 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1567 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1569 "Tiling %d[%d,%d] page=%s cs=%s angle"
1570 l.pageno
col row (~
> pageopaque
)
1571 (CSTE.to_string colorspace
)
1573 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1574 angle gen conf
.angle state
.gen
1576 conf
.tilew conf
.tileh
1583 let r = Str.regexp
" " in
1584 fun s -> Str.bounded_split
r s 2;
1587 let onpagerect pageno
f =
1589 match conf
.columns
with
1590 | Cmulti
(_
, b) -> b
1592 | Csplit
(_
, b) -> b
1594 if pageno
>= 0 && pageno
< Array.length
b
1596 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1600 let gotopagexy1 pageno
x y =
1601 let _,w1,h1
,leftx
= getpagedim pageno
in
1602 let top = y /. (float h1
) in
1603 let left = x /. (float w1) in
1604 let py, w, h = getpageywh pageno
in
1605 let wh = state
.winh
- hscrollh () in
1606 let x = left *. (float w) in
1607 let x = leftx
+ state
.x + truncate
x in
1609 if x < 0 || x >= wadjsb state
.winw
1613 let pdy = truncate
(top *. float h) in
1614 let y'
= py + pdy in
1615 let dy = y'
- state
.y in
1617 if x != state
.x || not
(dy > 0 && dy < wh)
1619 if conf
.presentation
1621 if abs
(py - y'
) > wh
1628 if state
.x != sx || state
.y != sy
1633 let ww = wadjsb state
.winw
in
1635 and qy
= pdy / wh in
1637 and y = py + qy
* wh in
1638 let x = if -x + ww > w1 then -(w1-ww) else x
1639 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1641 if conf
.presentation
1643 if abs
(py - y'
) > wh
1653 gotoy_and_clear_text y;
1655 else gotoy_and_clear_text state
.y;
1658 let gotopagexy pageno
x y =
1659 match state
.mode
with
1660 | Birdseye
_ -> gotopage pageno
0.0
1663 | LinkNav
_ -> gotopagexy1 pageno
x y
1667 (* dolog "%S" cmds; *)
1668 let cl = splitatspace cmds
in
1670 try Scanf.sscanf
s fmt
f
1672 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1675 let addoutline outline
=
1676 match state
.currently
with
1677 | Outlining outlines
->
1678 state
.currently
<- Outlining
(outline
:: outlines
)
1679 | Idle
-> state
.currently
<- Outlining
[outline
]
1682 dolog
"invalid outlining state";
1683 logcurrently state
.currently
1687 state
.uioh#infochanged Pdim
;
1690 | "clearrects" :: [] ->
1691 state
.rects
<- state
.rects1
;
1692 G.postRedisplay "clearrects";
1694 | "continue" :: args
:: [] ->
1695 let n = scan args
"%u" (fun n -> n) in
1696 state
.pagecount
<- n;
1697 begin match state
.currently
with
1699 state
.currently
<- Idle
;
1700 state
.outlines
<- Array.of_list
(List.rev
l)
1706 let cur, cmds
= state
.geomcmds
in
1708 then failwith
"umpossible";
1710 begin match List.rev cmds
with
1712 state
.geomcmds
<- E.s, [];
1713 state
.throttle
<- None
;
1717 state
.geomcmds
<- s, List.rev rest
;
1719 if conf
.maxwait
= None
&& not
!wtmode
1720 then G.postRedisplay "continue";
1722 | "msg" :: args
:: [] ->
1725 | "vmsg" :: args
:: [] ->
1727 then showtext ' ' args
1729 | "emsg" :: args
:: [] ->
1730 Buffer.add_string state
.errmsgs args
;
1731 state
.newerrmsgs
<- true;
1732 G.postRedisplay "error message"
1734 | "progress" :: args
:: [] ->
1735 let progress, text =
1738 f, String.sub args pos
(String.length args
- pos
))
1741 state
.progress <- progress;
1742 G.postRedisplay "progress"
1744 | "firstmatch" :: args
:: [] ->
1745 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1746 scan args
"%u %d %f %f %f %f %f %f %f %f"
1747 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1748 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1750 let xoff = float (xadjsb 0) in
1754 and x3
= x3
+. xoff in
1755 let y = (getpagey
pageno) + truncate
y0 in
1758 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1760 | "match" :: args
:: [] ->
1761 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1762 scan args
"%u %d %f %f %f %f %f %f %f %f"
1763 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1764 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1766 let xoff = float (xadjsb 0) in
1770 and x3
= x3
+. xoff in
1772 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1774 | "page" :: args
:: [] ->
1775 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1776 let pageopaque = ~
< pageopaques in
1777 begin match state
.currently
with
1778 | Loading
(l, gen
) ->
1779 vlog "page %d took %f sec" l.pageno t
;
1780 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1781 begin match state
.throttle
with
1783 let preloadedpages =
1785 then preloadlayout state
.y
1790 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1791 IntSet.empty
preloadedpages
1794 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1795 if not
(IntSet.mem
pageno set)
1797 wcmd "freepage %s" (~
> opaque
);
1803 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1806 state
.currently
<- Idle
;
1809 tilepage l.pageno pageopaque state
.layout;
1811 load preloadedpages;
1812 if pagevisible state
.layout l.pageno
1813 && layoutready state
.layout
1814 then G.postRedisplay "page";
1817 | Some
(layout, _, _) ->
1818 state
.currently
<- Idle
;
1819 tilepage l.pageno pageopaque layout;
1826 dolog
"Inconsistent loading state";
1827 logcurrently state
.currently
;
1831 | "tile" :: args
:: [] ->
1832 let (x, y, opaques
, size
, t
) =
1833 scan args
"%u %u %s %u %f"
1834 (fun x y p size t
-> (x, y, p
, size
, t
))
1836 let opaque = ~
< opaques
in
1837 begin match state
.currently
with
1838 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1839 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1842 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1844 wcmd "freetile %s" (~
> opaque);
1845 state
.currently
<- Idle
;
1849 puttileopaque l col row gen cs angle
opaque size t
;
1850 state
.memused
<- state
.memused
+ size
;
1851 state
.uioh#infochanged Memused
;
1853 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1854 opaque, size
) state
.tilelru
;
1857 match state
.throttle
with
1858 | None
-> state
.layout
1859 | Some
(layout, _, _) -> layout
1862 state
.currently
<- Idle
;
1864 && conf
.colorspace
= cs
1865 && conf
.angle
= angle
1866 && tilevisible layout l.pageno x y
1867 then conttiling l.pageno pageopaque;
1869 begin match state
.throttle
with
1871 preload state
.layout;
1873 && conf
.colorspace
= cs
1874 && conf
.angle
= angle
1875 && tilevisible state
.layout l.pageno x y
1876 && (not
!wtmode || layoutready state
.layout)
1877 then G.postRedisplay "tile nothrottle";
1879 | Some
(layout, y, _) ->
1880 let ready = layoutready layout in
1884 state
.layout <- layout;
1885 state
.throttle
<- None
;
1886 G.postRedisplay "throttle";
1895 dolog
"Inconsistent tiling state";
1896 logcurrently state
.currently
;
1900 | "pdim" :: args
:: [] ->
1901 let (n, w, h, _) as pdim
=
1902 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1905 match conf
.fitmodel
with
1907 | FitPage
| FitProportional
->
1908 match conf
.columns
with
1909 | Csplit
_ -> (n, w, h, 0)
1910 | Csingle
_ | Cmulti
_ -> pdim
1912 state
.uioh#infochanged Pdim
;
1913 state
.pdims
<- pdim :: state
.pdims
1915 | "o" :: args
:: [] ->
1916 let (l, n, t
, h, pos
) =
1917 scan args
"%u %u %d %u %n"
1918 (fun l n t
h pos
-> l, n, t
, h, pos
)
1920 let s = String.sub args pos
(String.length args
- pos
) in
1921 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1923 | "ou" :: args
:: [] ->
1924 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1925 let s = String.sub args pos
len in
1926 let pos2 = pos
+ len + 1 in
1927 let uri = String.sub args
pos2 (String.length args
- pos2) in
1928 addoutline (s, l, Ouri
uri)
1930 | "on" :: args
:: [] ->
1931 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1932 let s = String.sub args pos
(String.length args
- pos
) in
1933 addoutline (s, l, Onone
)
1935 | "a" :: args
:: [] ->
1937 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1939 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1941 | "info" :: args
:: [] ->
1942 let pos = nindex args '
\t'
in
1943 if pos >= 0 && String.sub args
0 pos = "Title"
1945 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1948 state
.docinfo
<- (1, args
) :: state
.docinfo
1950 | "infoend" :: [] ->
1951 state
.uioh#infochanged Docinfo
;
1952 state
.docinfo
<- List.rev state
.docinfo
1955 error
"unknown cmd `%S'" cmds
1960 let action = function
1961 | HCprev
-> cbget cb ~
-1
1962 | HCnext
-> cbget cb
1
1963 | HCfirst
-> cbget cb ~
-(cb
.rc)
1964 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1965 and cancel
() = cb
.rc <- rc
1969 let search pattern forward
=
1970 match conf
.columns
with
1972 showtext '
!'
"searching does not work properly in split columns mode"
1975 if nonemptystr pattern
1978 match state
.layout with
1981 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1983 wcmd "search %d %d %d %d,%s\000"
1984 (btod conf
.icase
) pn py (btod forward
) pattern
;
1987 let intentry text key =
1989 if key >= 32 && key < 127
1995 let text = addchar text c in
1999 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2003 let linknentry text key =
2005 if key >= 32 && key < 127
2011 let text = addchar text c in
2015 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2023 let l = String.length
s in
2024 let rec loop pos n = if pos = l then n else
2025 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2026 loop (pos+1) (n*26 + m)
2029 let rec loop n = function
2032 match getopaque l.pageno with
2033 | None
-> loop n rest
2035 let m = getlinkcount
opaque in
2038 let under = getlink
opaque n in
2041 else loop (n-m) rest
2043 loop n state
.layout;
2047 let textentry text key =
2048 if key land 0xff00 = 0xff00
2050 else TEcont
(text ^ toutf8
key)
2053 let reqlayout angle fitmodel
=
2054 match state
.throttle
with
2056 if nogeomcmds state
.geomcmds
2057 then state
.anchor <- getanchor
();
2058 conf
.angle
<- angle
mod 360;
2061 match state
.mode
with
2062 | LinkNav
_ -> state
.mode
<- View
2067 conf
.fitmodel
<- fitmodel
;
2068 invalidate "reqlayout"
2070 wcmd "reqlayout %d %d %d"
2071 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2076 let settrim trimmargins trimfuzz
=
2077 if nogeomcmds state
.geomcmds
2078 then state
.anchor <- getanchor
();
2079 conf
.trimmargins
<- trimmargins
;
2080 conf
.trimfuzz
<- trimfuzz
;
2081 let x0, y0, x1, y1 = trimfuzz
in
2082 invalidate "settrim"
2084 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2089 match state
.throttle
with
2091 let zoom = max
0.0001 zoom in
2092 if zoom <> conf
.zoom
2094 state
.prevzoom
<- (conf
.zoom, state
.x);
2096 reshape state
.winw state
.winh
;
2097 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2100 | Some
(layout, y, started
) ->
2102 match conf
.maxwait
with
2106 let dt = now
() -. started
in
2114 let setcolumns mode columns coverA coverB
=
2115 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2119 then showtext '
!'
"split mode doesn't work in bird's eye"
2121 conf
.columns
<- Csplit
(-columns
, E.a);
2129 conf
.columns
<- Csingle
E.a;
2134 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2138 reshape state
.winw state
.winh
;
2141 let resetmstate () =
2142 state
.mstate
<- Mnone
;
2143 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2146 let enterbirdseye () =
2147 let zoom = float conf
.thumbw
/. float state
.winw
in
2148 let birdseyepageno =
2149 let cy = state
.winh
/ 2 in
2153 let rec fold best
= function
2156 let d = cy - (l.pagedispy + l.pagevh/2)
2157 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2158 if abs
d < abs dbest
2165 state
.mode
<- Birdseye
(
2166 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2170 conf
.presentation
<- false;
2171 conf
.interpagespace
<- 10;
2172 conf
.hlinks
<- false;
2173 conf
.fitmodel
<- FitPage
;
2175 conf
.maxwait
<- None
;
2177 match conf
.beyecolumns
with
2180 Cmulti
((c, 0, 0), E.a)
2181 | None
-> Csingle
E.a
2185 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2190 reshape state
.winw state
.winh
;
2193 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2195 conf
.zoom <- c.zoom;
2196 conf
.presentation
<- c.presentation
;
2197 conf
.interpagespace
<- c.interpagespace
;
2198 conf
.maxwait
<- c.maxwait
;
2199 conf
.hlinks
<- c.hlinks
;
2200 conf
.fitmodel
<- c.fitmodel
;
2201 conf
.beyecolumns
<- (
2202 match conf
.columns
with
2203 | Cmulti
((c, _, _), _) -> Some
c
2205 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2208 match c.columns
with
2209 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2210 | Csingle
_ -> Csingle
E.a
2211 | Csplit
(c, _) -> Csplit
(c, E.a)
2215 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2218 reshape state
.winw state
.winh
;
2219 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2223 let togglebirdseye () =
2224 match state
.mode
with
2225 | Birdseye vals
-> leavebirdseye vals
true
2226 | View
-> enterbirdseye ()
2231 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2232 let pageno = max
0 (pageno - incr
) in
2233 let rec loop = function
2234 | [] -> gotopage1 pageno 0
2235 | l :: _ when l.pageno = pageno ->
2236 if l.pagedispy >= 0 && l.pagey = 0
2237 then G.postRedisplay "upbirdseye"
2238 else gotopage1 pageno 0
2239 | _ :: rest
-> loop rest
2243 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2246 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2247 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2248 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2249 let rec loop = function
2251 let y, h = getpageyh
pageno in
2252 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2254 | l :: _ when l.pageno = pageno ->
2255 if l.pagevh != l.pageh
2256 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2257 else G.postRedisplay "downbirdseye"
2258 | _ :: rest
-> loop rest
2264 let boundastep h step
=
2266 then bound step ~
-h 0
2270 let optentry mode
_ key =
2271 let btos b = if b then "on" else "off" in
2272 if key >= 32 && key < 127
2274 let c = Char.chr
key in
2278 try conf
.scrollstep
<- int_of_string
s with exc
->
2279 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2281 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2286 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2287 if state
.autoscroll
<> None
2288 then state
.autoscroll
<- Some conf
.autoscrollstep
2290 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2292 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2297 let n, a, b = multicolumns_of_string
s in
2298 setcolumns mode
n a b;
2300 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2302 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2307 let zoom = float (int_of_string
s) /. 100.0 in
2310 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2312 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2317 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2319 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2320 begin match mode
with
2322 leavebirdseye beye
false;
2329 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2331 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2336 Some
(int_of_string
s)
2338 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2342 | Some angle
-> reqlayout angle conf
.fitmodel
2345 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2348 conf
.icase
<- not conf
.icase
;
2349 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2352 conf
.preload <- not conf
.preload;
2354 TEdone
("preload " ^
(btos conf
.preload))
2357 conf
.verbose
<- not conf
.verbose
;
2358 TEdone
("verbose " ^
(btos conf
.verbose
))
2361 conf
.debug
<- not conf
.debug
;
2362 TEdone
("debug " ^
(btos conf
.debug
))
2365 conf
.maxhfit
<- not conf
.maxhfit
;
2366 state
.maxy
<- calcheight
();
2367 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2370 conf
.crophack
<- not conf
.crophack
;
2371 TEdone
("crophack " ^
btos conf
.crophack
)
2375 match conf
.maxwait
with
2377 conf
.maxwait
<- Some infinity
;
2378 "always wait for page to complete"
2380 conf
.maxwait
<- None
;
2381 "show placeholder if page is not ready"
2386 conf
.underinfo
<- not conf
.underinfo
;
2387 TEdone
("underinfo " ^
btos conf
.underinfo
)
2390 conf
.savebmarks
<- not conf
.savebmarks
;
2391 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2397 match state
.layout with
2402 conf
.interpagespace
<- int_of_string
s;
2403 docolumns conf
.columns
;
2404 state
.maxy
<- calcheight
();
2405 let y = getpagey
pageno in
2408 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2410 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2414 match conf
.fitmodel
with
2415 | FitProportional
-> FitWidth
2416 | FitWidth
| FitPage
-> FitProportional
2418 reqlayout conf
.angle
fm;
2419 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2422 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2423 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2426 conf
.invert
<- not conf
.invert
;
2427 TEdone
("invert colors " ^
btos conf
.invert
)
2431 cbput state
.hists
.sel
s;
2434 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2435 textentry, ondone, true)
2439 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2440 else conf
.pax
<- None
;
2441 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2444 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2450 class type lvsource
= object
2451 method getitemcount
: int
2452 method getitem
: int -> (string * int)
2453 method hasaction
: int -> bool
2461 method getactive
: int
2462 method getfirst
: int
2464 method getminfo
: (int * int) array
2467 class virtual lvsourcebase
= object
2468 val mutable m_active
= 0
2469 val mutable m_first
= 0
2470 val mutable m_pan
= 0
2471 method getactive
= m_active
2472 method getfirst
= m_first
2473 method getpan
= m_pan
2474 method getminfo
: (int * int) array
= E.a
2477 let withoutlastutf8 s =
2478 let len = String.length
s in
2486 let b = Char.code
s.[pos] in
2487 if b land 0b11000000 = 0b11000000
2492 if Char.code
s.[len-1] land 0x80 = 0
2496 String.sub
s 0 first;
2499 let textentrykeyboard
2500 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2502 if key >= 0xffb0 && key <= 0xffb9
2503 then key - 0xffb0 + 48 else key
2506 state
.mode
<- Textentry
(te
, onleave
);
2509 G.postRedisplay "textentrykeyboard enttext";
2511 let histaction cmd
=
2514 | Some
(action, _) ->
2515 state
.mode
<- Textentry
(
2516 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2518 G.postRedisplay "textentry histaction"
2522 if emptystr
text && cancelonempty
2525 G.postRedisplay "textentrykeyboard after cancel";
2528 let s = withoutlastutf8 text in
2529 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2531 | @enter
| @kpenter
->
2534 G.postRedisplay "textentrykeyboard after confirm"
2536 | @up
| @kpup
-> histaction HCprev
2537 | @down
| @kpdown
-> histaction HCnext
2538 | @home
| @kphome
-> histaction HCfirst
2539 | @jend
| @kpend
-> histaction HClast
2544 begin match opthist
with
2546 | Some
(_, onhistcancel
) -> onhistcancel
()
2550 G.postRedisplay "textentrykeyboard after cancel2"
2553 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2556 | @delete
| @kpdelete
-> ()
2559 && key land 0xff00 != 0xff00 (* keyboard *)
2560 && key land 0xfe00 != 0xfe00 (* xkb *)
2561 && key land 0xfd00 != 0xfd00 (* 3270 *)
2563 begin match onkey
text key with
2567 G.postRedisplay "textentrykeyboard after confirm2";
2570 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2574 G.postRedisplay "textentrykeyboard after cancel3"
2577 state
.mode
<- Textentry
(te
, onleave
);
2578 G.postRedisplay "textentrykeyboard switch";
2582 vlog "unhandled key %s" (Wsi.keyname
key)
2585 let firstof first active
=
2586 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2587 then max
0 (active
- (fstate
.maxrows
/2))
2591 let calcfirst first active
=
2594 let rows = active
- first in
2595 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2599 let scrollph y maxy
=
2600 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2601 let sh = float state
.winh
/. sh in
2602 let sh = max
sh (float conf
.scrollh
) in
2604 let percent = float y /. float maxy
in
2605 let position = (float state
.winh
-. sh) *. percent in
2608 if position +. sh > float state
.winh
2609 then float state
.winh
-. sh
2615 let coe s = (s :> uioh
);;
2617 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2619 val m_pan
= source#getpan
2620 val m_first
= source#getfirst
2621 val m_active
= source#getactive
2623 val m_prev_uioh
= state
.uioh
2625 method private elemunder
y =
2629 let n = y / (fstate
.fontsize
+1) in
2630 if m_first
+ n < source#getitemcount
2632 if source#hasaction
(m_first
+ n)
2633 then Some
(m_first
+ n)
2640 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2641 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2642 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2643 GlDraw.color
(1., 1., 1.);
2644 Gl.enable `texture_2d
;
2645 let fs = fstate
.fontsize
in
2647 let hw = (wadjsb (xadjsb state
.winw
))/3 in
2648 let ww = fstate
.wwidth
in
2649 let tabw = 17.0*.ww in
2650 let itemcount = source#getitemcount
in
2651 let minfo = source#getminfo
in
2654 then float (xadjsb 0), float (state
.winw
- 1)
2655 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2658 if (row - m_first
) > fstate
.maxrows
2661 if row >= 0 && row < itemcount
2663 let (s, level
) = source#getitem
row in
2664 let y = (row - m_first
) * nfs in
2666 (if conf
.leftscroll
then float (xadjsb 0) else 5.0)
2667 +. (float (level
+ m_pan
)) *. ww in
2670 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2674 Gl.disable `texture_2d
;
2675 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2676 GlDraw.color
(1., 1., 1.) ~
alpha;
2677 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2678 Gl.enable `texture_2d
;
2681 if zebra
&& row land 1 = 1
2685 GlDraw.color
(c,c,c);
2686 let drawtabularstring s =
2688 let x'
= truncate
(x0 +. x) in
2689 let pos = nindex
s '
\000'
in
2691 then drawstring1 fs x'
(y+nfs) s
2693 let s1 = String.sub
s 0 pos
2694 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2699 let s'
= withoutlastutf8 s in
2700 let s = s' ^
"@Uellipsis" in
2701 let w = measurestr
fs s in
2702 if float x'
+. w +. ww < float (hw + x'
)
2707 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2711 ignore
(drawstring1 fs x'
(y+nfs) s1);
2712 drawstring1 fs (hw + x'
) (y+nfs) s2
2716 let x = if helpmode
&& row > 0 then x +. ww else x in
2717 let tabpos = nindex
s '
\t'
in
2720 let len = String.length
s - tabpos - 1 in
2721 let s1 = String.sub
s 0 tabpos
2722 and s2
= String.sub
s (tabpos + 1) len in
2723 let nx = drawstr x s1 in
2725 let x = x +. (max
tabw sw) in
2728 let len = String.length
s - 2 in
2729 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2731 let s = String.sub
s 2 len in
2732 let x = if not helpmode
then x +. ww else x in
2733 GlDraw.color
(1.2, 1.2, 1.2);
2734 let vinc = drawstring1 (fs+fs/4)
2735 (truncate
(x -. ww)) (y+nfs) s in
2736 GlDraw.color
(1., 1., 1.);
2737 vinc +. (float fs *. 0.8)
2743 ignore
(drawtabularstring s);
2749 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2751 if (row - m_first
) > fstate
.maxrows
2754 if row >= 0 && row < itemcount
2756 let (s, level
) = source#getitem
row in
2757 let pos0 = nindex
s '
\000'
in
2758 let y = (row - m_first
) * nfs in
2759 let x = float (level
+ m_pan
) *. ww in
2760 let (first, last
) = minfo.(row) in
2762 if pos0 > 0 && first > pos0
2763 then String.sub
s (pos0+1) (first-pos0-1)
2764 else String.sub
s 0 first
2766 let suffix = String.sub
s first (last
- first) in
2767 let w1 = measurestr fstate
.fontsize
prefix in
2768 let w2 = measurestr fstate
.fontsize
suffix in
2769 let x = x +. if conf
.leftscroll
then float (xadjsb 5) else 5.0 in
2770 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2772 and y0 = float (y+2) in
2774 and y1 = float (y+fs+3) in
2775 filledrect x0 y0 x1 y1;
2780 Gl.disable `texture_2d
;
2781 if Array.length
minfo > 0 then loop m_first
;
2784 method updownlevel incr
=
2785 let len = source#getitemcount
in
2787 if m_active
>= 0 && m_active
< len
2788 then snd
(source#getitem m_active
)
2792 if i
= len then i
-1 else if i
= -1 then 0 else
2793 let _, l = source#getitem i
in
2794 if l != curlevel then i
else flow (i
+incr
)
2796 let active = flow m_active
in
2797 let first = calcfirst m_first
active in
2798 G.postRedisplay "outline updownlevel";
2799 {< m_active
= active; m_first
= first >}
2801 method private key1
key mask
=
2802 let set1 active first qsearch
=
2803 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2805 let search active pattern incr
=
2806 let active = if active = -1 then m_first
else active in
2809 if n >= 0 && n < source#getitemcount
2811 let s, _ = source#getitem
n in
2813 (try ignore
(Str.search_forward
re s 0); true
2814 with Not_found
-> false)
2816 else loop (n + incr
)
2823 let re = Str.regexp_case_fold pattern
in
2829 let itemcount = source#getitemcount
in
2830 let find start incr
=
2832 if i
= -1 || i
= itemcount
2835 if source#hasaction i
2837 else find (i
+ incr
)
2842 let set active first =
2843 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2845 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2848 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2850 let incr1 = if incr
> 0 then 1 else -1 in
2851 if isvisible m_first m_active
2854 let next = m_active
+ incr
in
2856 if next < 0 || next >= itemcount
2858 else find next incr1
2860 if abs
(m_active
- next) > fstate
.maxrows
2866 let first = m_first
+ incr
in
2867 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2869 let next = m_active
+ incr
in
2870 let next = bound
next 0 (itemcount - 1) in
2877 if isvisible first next
2884 let first = min
next m_first
in
2886 if abs
(next - first) > fstate
.maxrows
2892 let first = m_first
+ incr
in
2893 let first = bound
first 0 (itemcount - 1) in
2895 let next = m_active
+ incr
in
2896 let next = bound
next 0 (itemcount - 1) in
2897 let next = find next incr1 in
2899 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2901 let active = if m_active
= -1 then next else m_active
in
2906 if isvisible first active
2912 G.postRedisplay "listview navigate";
2916 | (@r|@s) when Wsi.withctrl mask
->
2917 let incr = if key = @r then -1 else 1 in
2919 match search (m_active
+ incr) m_qsearch
incr with
2921 state
.text <- m_qsearch ^
" [not found]";
2924 state
.text <- m_qsearch
;
2925 active, firstof m_first
active
2927 G.postRedisplay "listview ctrl-r/s";
2928 set1 active first m_qsearch
;
2930 | @insert
when Wsi.withctrl mask
->
2931 if m_active
>= 0 && m_active
< source#getitemcount
2933 let s, _ = source#getitem m_active
in
2939 if emptystr m_qsearch
2942 let qsearch = withoutlastutf8 m_qsearch
in
2946 G.postRedisplay "listview empty qsearch";
2947 set1 m_active m_first
E.s;
2951 match search m_active
qsearch ~
-1 with
2953 state
.text <- qsearch ^
" [not found]";
2956 state
.text <- qsearch;
2957 active, firstof m_first
active
2959 G.postRedisplay "listview backspace qsearch";
2960 set1 active first qsearch
2963 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2964 let pattern = m_qsearch ^ toutf8
key in
2966 match search m_active
pattern 1 with
2968 state
.text <- pattern ^
" [not found]";
2971 state
.text <- pattern;
2972 active, firstof m_first
active
2974 G.postRedisplay "listview qsearch add";
2975 set1 active first pattern;
2979 if emptystr m_qsearch
2981 G.postRedisplay "list view escape";
2984 source#exit ~uioh
:(coe self
)
2985 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2987 | None
-> m_prev_uioh
2992 G.postRedisplay "list view kill qsearch";
2993 coe {< m_qsearch
= E.s >}
2996 | @enter
| @kpenter
->
2998 let self = {< m_qsearch
= E.s >} in
3000 G.postRedisplay "listview enter";
3001 if m_active
>= 0 && m_active
< source#getitemcount
3003 source#exit ~uioh
:(coe self) ~cancel
:false
3004 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3007 source#exit ~uioh
:(coe self) ~cancel
:true
3008 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3011 begin match opt with
3012 | None
-> m_prev_uioh
3016 | @delete
| @kpdelete
->
3019 | @up
| @kpup
-> navigate ~
-1
3020 | @down
| @kpdown
-> navigate 1
3021 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3022 | @next | @kpnext
-> navigate fstate
.maxrows
3024 | @right
| @kpright
->
3026 G.postRedisplay "listview right";
3027 coe {< m_pan
= m_pan
- 1 >}
3029 | @left | @kpleft
->
3031 G.postRedisplay "listview left";
3032 coe {< m_pan
= m_pan
+ 1 >}
3034 | @home
| @kphome
->
3035 let active = find 0 1 in
3036 G.postRedisplay "listview home";
3040 let first = max
0 (itemcount - fstate
.maxrows
) in
3041 let active = find (itemcount - 1) ~
-1 in
3042 G.postRedisplay "listview end";
3045 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3049 dolog
"listview unknown key %#x" key; coe self
3051 method key key mask
=
3052 match state
.mode
with
3053 | Textentry te
-> textentrykeyboard key mask te
; coe self
3056 | LinkNav
_ -> self#key1
key mask
3058 method button button down
x y _ =
3061 | 1 when x > state
.winw
- conf
.scrollbw
->
3062 G.postRedisplay "listview scroll";
3065 let _, position, sh = self#
scrollph in
3066 if y > truncate
position && y < truncate
(position +. sh)
3068 state
.mstate
<- Mscrolly
;
3072 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3073 let first = truncate
(s *. float source#getitemcount
) in
3074 let first = min source#getitemcount
first in
3075 Some
(coe {< m_first
= first; m_active
= first >})
3077 state
.mstate
<- Mnone
;
3081 begin match self#elemunder
y with
3083 G.postRedisplay "listview click";
3084 source#exit ~uioh
:(coe {< m_active
= n >})
3085 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3089 | n when (n == 4 || n == 5) && not down
->
3090 let len = source#getitemcount
in
3092 if n = 5 && m_first
+ fstate
.maxrows
>= len
3096 let first = m_first
+ (if n == 4 then -1 else 1) in
3097 bound
first 0 (len - 1)
3099 G.postRedisplay "listview wheel";
3100 Some
(coe {< m_first
= first >})
3101 | n when (n = 6 || n = 7) && not down
->
3102 let inc = if n = 7 then -1 else 1 in
3103 G.postRedisplay "listview hwheel";
3104 Some
(coe {< m_pan
= m_pan
+ inc >})
3109 | None
-> m_prev_uioh
3112 method multiclick
_ x y = self#button
1 true x y
3115 match state
.mstate
with
3117 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3118 let first = truncate
(s *. float source#getitemcount
) in
3119 let first = min source#getitemcount
first in
3120 G.postRedisplay "listview motion";
3121 coe {< m_first
= first; m_active
= first >}
3129 method pmotion
x y =
3130 if x < state
.winw
- conf
.scrollbw
3133 match self#elemunder
y with
3134 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3135 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3139 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3144 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3148 method infochanged
_ = ()
3150 method scrollpw
= (0, 0.0, 0.0)
3152 let nfs = fstate
.fontsize
+ 1 in
3153 let y = m_first
* nfs in
3154 let itemcount = source#getitemcount
in
3155 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3156 let maxy = maxi * nfs in
3157 let p, h = scrollph y maxy in
3160 method modehash
= modehash
3161 method eformsgs
= false
3162 method hasvscrollb
= true
3163 method hashscrollb
= true
3166 class outlinelistview ~zebra ~source
=
3167 let settext autonarrow
s =
3170 let ss = source#statestr
in
3174 else "{" ^
ss ^
"} [" ^
s ^
"]"
3175 else state
.text <- s
3181 ~source
:(source
:> lvsource
)
3183 ~modehash
:(findkeyhash conf
"outline")
3186 val m_autonarrow
= false
3188 method! key key mask
=
3190 if emptystr state
.text
3192 else fstate
.maxrows - 2
3194 let calcfirst first active =
3197 let rows = active - first in
3198 if rows > maxrows then active - maxrows else first
3202 let active = m_active
+ incr in
3203 let active = bound
active 0 (source#getitemcount
- 1) in
3204 let first = calcfirst m_first
active in
3205 G.postRedisplay "outline navigate";
3206 coe {< m_active
= active; m_first
= first >}
3208 let navscroll first =
3210 let dist = m_active
- first in
3216 else first + maxrows
3219 G.postRedisplay "outline navscroll";
3220 coe {< m_first
= first; m_active
= active >}
3222 let ctrl = Wsi.withctrl mask
in
3227 then (source#denarrow
; E.s)
3229 let pattern = source#renarrow
in
3230 if nonemptystr m_qsearch
3231 then (source#narrow m_qsearch
; m_qsearch
)
3235 settext (not m_autonarrow
) text;
3236 G.postRedisplay "toggle auto narrowing";
3237 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3239 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3241 G.postRedisplay "toggle auto narrowing";
3242 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3245 source#narrow m_qsearch
;
3247 then source#add_narrow_pattern m_qsearch
;
3248 G.postRedisplay "outline ctrl-n";
3249 coe {< m_first
= 0; m_active
= 0 >}
3252 let active = source#calcactive
(getanchor
()) in
3253 let first = firstof m_first
active in
3254 G.postRedisplay "outline ctrl-s";
3255 coe {< m_first
= first; m_active
= active >}
3258 G.postRedisplay "outline ctrl-u";
3259 if m_autonarrow
&& nonemptystr m_qsearch
3261 ignore
(source#renarrow
);
3262 settext m_autonarrow
E.s;
3263 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3266 source#del_narrow_pattern
;
3267 let pattern = source#renarrow
in
3269 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3271 settext m_autonarrow
text;
3272 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3276 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3277 G.postRedisplay "outline ctrl-l";
3278 coe {< m_first
= first >}
3280 | @tab
when m_autonarrow
->
3281 if nonemptystr m_qsearch
3283 G.postRedisplay "outline list view tab";
3284 source#add_narrow_pattern m_qsearch
;
3286 coe {< m_qsearch
= E.s >}
3290 | @escape
when m_autonarrow
->
3291 if nonemptystr m_qsearch
3292 then source#add_narrow_pattern m_qsearch
;
3295 | @enter
| @kpenter
when m_autonarrow
->
3296 if nonemptystr m_qsearch
3297 then source#add_narrow_pattern m_qsearch
;
3300 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3301 let pattern = m_qsearch ^ toutf8
key in
3302 G.postRedisplay "outlinelistview autonarrow add";
3303 source#narrow
pattern;
3304 settext true pattern;
3305 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3307 | key when m_autonarrow
&& key = @backspace
->
3308 if emptystr m_qsearch
3311 let pattern = withoutlastutf8 m_qsearch
in
3312 G.postRedisplay "outlinelistview autonarrow backspace";
3313 ignore
(source#renarrow
);
3314 source#narrow
pattern;
3315 settext true pattern;
3316 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3318 | @delete
| @kpdelete
->
3319 source#remove m_active
;
3320 G.postRedisplay "outline delete";
3321 let active = max
0 (m_active
-1) in
3322 coe {< m_first
= firstof m_first
active;
3323 m_active
= active >}
3325 | @up
| @kpup
when ctrl ->
3326 navscroll (max
0 (m_first
- 1))
3328 | @down
| @kpdown
when ctrl ->
3329 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3331 | @up
| @kpup
-> navigate ~
-1
3332 | @down
| @kpdown
-> navigate 1
3333 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3334 | @next | @kpnext
-> navigate fstate
.maxrows
3336 | @right
| @kpright
->
3340 G.postRedisplay "outline ctrl right";
3341 {< m_pan
= m_pan
+ 1 >}
3343 else self#updownlevel
1
3347 | @left | @kpleft
->
3351 G.postRedisplay "outline ctrl left";
3352 {< m_pan
= m_pan
- 1 >}
3354 else self#updownlevel ~
-1
3358 | @home
| @kphome
->
3359 G.postRedisplay "outline home";
3360 coe {< m_first
= 0; m_active
= 0 >}
3363 let active = source#getitemcount
- 1 in
3364 let first = max
0 (active - fstate
.maxrows) in
3365 G.postRedisplay "outline end";
3366 coe {< m_active
= active; m_first
= first >}
3368 | _ -> super#
key key mask
3371 let gotounder under =
3372 let getpath filename
=
3374 if nonemptystr filename
3376 if Filename.is_relative filename
3378 let dir = Filename.dirname state
.path in
3380 if Filename.is_implicit
dir
3381 then Filename.concat
(Sys.getcwd
()) dir
3384 Filename.concat
dir filename
3388 if Sys.file_exists
path
3393 | Ulinkgoto
(pageno, top) ->
3397 gotopage1 pageno top;
3403 | Uremote
(filename
, pageno) ->
3404 let path = getpath filename
in
3409 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
3410 try popen
command []
3412 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
3415 let anchor = getanchor
() in
3416 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3417 state
.origin
<- E.s;
3418 state
.anchor <- (pageno, 0.0, 0.0);
3419 state
.ranchors
<- ranchor :: state
.ranchors
;
3422 else showtext '
!'
("Could not find " ^ filename
)
3424 | Uremotedest
(filename
, destname
) ->
3425 let path = getpath filename
in
3430 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
3431 try popen
command []
3434 "failed to execute `%s': %s\n" command (exntos exn
);
3437 let anchor = getanchor
() in
3438 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3439 state
.origin
<- E.s;
3440 state
.nameddest
<- destname
;
3441 state
.ranchors
<- ranchor :: state
.ranchors
;
3444 else showtext '
!'
("Could not find " ^ filename
)
3446 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
3447 | Uannotation
_ -> ()
3450 let gotohist (path, (c, bookmarks
, x, anchor)) =
3451 Config.save
leavebirdseye;
3452 state
.anchor <- anchor;
3454 state
.bookmarks
<- bookmarks
;
3455 state
.origin
<- E.s;
3457 let x0, y0, x1, y1 = conf
.trimfuzz
in
3458 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3462 let gotooutline (_, _, kind
) =
3466 let (pageno, y, _) = anchor in
3468 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3472 | Ouri
uri -> gotounder (Ulinkuri
uri)
3473 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3474 | Oremote remote
-> gotounder (Uremote remote
)
3475 | Ohistory hist
-> gotohist hist
3476 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3480 let genhistoutlines =
3481 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3483 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3484 | `
path -> compare p2 p1
3485 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3487 let e1 = emptystr c1
.title
3488 and e2
= emptystr c2
.title
in
3490 then compare
(Filename.basename p2
) (Filename.basename p1
)
3493 else compare c1
.title c2
.title
3495 let showfullpath = ref false in
3498 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3499 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3501 let list = ref [] in
3502 if Config.gethist
list
3506 (fun accu (path, c, b, x, a) ->
3507 let hist = (path, (c, b, x, a)) in
3508 let s = if !showfullpath then path else Filename.basename
path in
3509 let base = mbtoutf8
s in
3510 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3512 [ setorty "Sort by time of last visit" `lastvisit
;
3513 setorty "Sort by file name" `file
;
3514 setorty "Sort by path" `
path;
3515 setorty "Sort by title" `title
;
3516 (if !showfullpath then "@Uradical "
3517 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3518 showfullpath := not
!showfullpath; reeenterhist := true)
3519 ] (List.sort
(order orderty
) !list)
3525 let outlinesource sourcetype
=
3527 inherit lvsourcebase
3528 val mutable m_items
= E.a
3529 val mutable m_minfo
= E.a
3530 val mutable m_orig_items
= E.a
3531 val mutable m_orig_minfo
= E.a
3532 val mutable m_narrow_patterns
= []
3533 val mutable m_hadremovals
= false
3534 val mutable m_gen
= -1
3536 method getitemcount
=
3537 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3540 if n == Array.length m_items
&& m_hadremovals
3542 ("[Confirm removal]", 0)
3544 let s, n, _ = m_items
.(n) in
3547 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3548 ignore
(uioh
, first);
3549 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3551 if m_narrow_patterns
= []
3552 then m_orig_items
, m_orig_minfo
3553 else m_items
, m_minfo
3557 if not
confrimremoval
3559 gotooutline m_items
.(active);
3564 state
.bookmarks
<- Array.to_list m_items
;
3565 m_orig_items
<- m_items
;
3566 m_orig_minfo
<- m_minfo
;
3576 method hasaction
_ = true
3579 if Array.length m_items
!= Array.length m_orig_items
3582 match m_narrow_patterns
with
3584 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3586 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3590 match m_narrow_patterns
with
3593 | head
:: _ -> "@Uellipsis" ^ head
3595 method narrow
pattern =
3596 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3600 let rec loop accu minfo n =
3603 m_items
<- Array.of_list
accu;
3604 m_minfo
<- Array.of_list
minfo;
3607 let (s, _, t
) as o = m_items
.(n) in
3610 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3611 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3612 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3614 try Str.search_forward
re s 0
3615 with Not_found
-> -1
3618 then o :: accu, (first, Str.match_end
()) :: minfo
3621 loop accu minfo (n-1)
3623 loop [] [] (Array.length m_items
- 1)
3625 method! getminfo
= m_minfo
3629 match sourcetype
with
3630 | `bookmarks
-> Array.of_list state
.bookmarks
3631 | `outlines
-> state
.outlines
3632 | `history
-> genhistoutlines !Config.historder
3634 m_minfo
<- m_orig_minfo
;
3635 m_items
<- m_orig_items
3638 if sourcetype
= `bookmarks
3640 if m >= 0 && m < Array.length m_items
3642 m_hadremovals
<- true;
3643 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3644 let n = if n >= m then n+1 else n in
3649 method add_narrow_pattern
pattern =
3650 m_narrow_patterns
<- pattern :: m_narrow_patterns
3652 method del_narrow_pattern
=
3653 match m_narrow_patterns
with
3654 | _ :: rest
-> m_narrow_patterns
<- rest
3659 match m_narrow_patterns
with
3660 | pattern :: [] -> self#narrow
pattern; pattern
3662 List.fold_left
(fun accu pattern ->
3663 self#narrow
pattern;
3664 pattern ^
"@Uellipsis" ^
accu) E.s list
3666 method calcactive
anchor =
3667 let rely = getanchory anchor in
3668 let rec loop n best bestd
=
3669 if n = Array.length m_items
3672 let _, _, kind
= m_items
.(n) in
3675 let orely = getanchory anchor in
3676 let d = abs
(orely - rely) in
3679 else loop (n+1) best bestd
3680 | Onone
| Oremote
_ | Olaunch
_
3681 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3682 loop (n+1) best bestd
3686 method reset
anchor items =
3687 m_hadremovals
<- false;
3688 if state
.gen
!= m_gen
3690 m_orig_items
<- items;
3692 m_narrow_patterns
<- [];
3694 m_orig_minfo
<- E.a;
3698 if items != m_orig_items
3700 m_orig_items
<- items;
3701 if m_narrow_patterns
== []
3702 then m_items
<- items;
3705 let active = self#calcactive
anchor in
3707 m_first
<- firstof m_first
active
3711 let enterselector sourcetype
=
3713 let source = outlinesource sourcetype
in
3716 match sourcetype
with
3717 | `bookmarks
-> Array.of_list state
.bookmarks
3718 | `
outlines -> state
.outlines
3719 | `history
-> genhistoutlines !Config.historder
3721 if Array.length
outlines = 0
3723 showtext ' ' errmsg
;
3726 state
.text <- source#greetmsg
;
3727 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3728 let anchor = getanchor
() in
3729 source#reset
anchor outlines;
3731 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3732 G.postRedisplay "enter selector";
3736 let enteroutlinemode =
3737 let f = enterselector `
outlines in
3738 fun () -> f "Document has no outline";
3741 let enterbookmarkmode =
3742 let f = enterselector `bookmarks
in
3743 fun () -> f "Document has no bookmarks (yet)";
3746 let enterhistmode () = enterselector `history
"No history (yet)";;
3748 let makecheckers () =
3749 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3751 converted by Issac Trotts. July 25, 2002 *)
3752 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3753 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3754 let id = GlTex.gen_texture
() in
3755 GlTex.bind_texture ~target
:`texture_2d
id;
3756 GlPix.store
(`unpack_alignment
1);
3757 GlTex.image2d
image;
3758 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3759 [ `mag_filter `nearest
; `min_filter `nearest
];
3763 let setcheckers enabled
=
3764 match state
.checkerstexid
with
3766 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3768 | Some checkerstexid
->
3771 GlTex.delete_texture checkerstexid
;
3772 state
.checkerstexid
<- None
;
3776 let describe_location () =
3777 let fn = page_of_y state
.y in
3778 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3779 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3783 else (100. *. (float state
.y /. float maxy))
3787 Printf.sprintf
"page %d of %d [%.2f%%]"
3788 (fn+1) state
.pagecount
percent
3791 "pages %d-%d of %d [%.2f%%]"
3792 (fn+1) (ln+1) state
.pagecount
percent
3795 let setpresentationmode v
=
3796 let n = page_of_y state
.y in
3797 state
.anchor <- (n, 0.0, 1.0);
3798 conf
.presentation
<- v
;
3799 if conf
.fitmodel
= FitPage
3800 then reqlayout conf
.angle conf
.fitmodel
;
3805 let btos b = if b then "@Uradical" else E.s in
3806 let showextended = ref false in
3807 let leave mode
_ = state
.mode
<- mode
in
3810 val mutable m_first_time
= true
3811 val mutable m_l
= []
3812 val mutable m_a
= E.a
3813 val mutable m_prev_uioh
= nouioh
3814 val mutable m_prev_mode
= View
3816 inherit lvsourcebase
3818 method reset prev_mode prev_uioh
=
3819 m_a
<- Array.of_list
(List.rev m_l
);
3821 m_prev_mode
<- prev_mode
;
3822 m_prev_uioh
<- prev_uioh
;
3826 if n >= Array.length m_a
3830 | _, _, _, Action
_ -> m_active
<- n
3831 | _, _, _, Noaction
-> loop (n+1)
3834 m_first_time
<- false;
3837 method int name get
set =
3839 (name
, `
int get
, 1, Action
(
3842 try set (int_of_string
s)
3844 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3848 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3849 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3853 method int_with_suffix name get
set =
3855 (name
, `intws get
, 1, Action
(
3858 try set (int_of_string_with_suffix
s)
3860 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3865 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3867 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3871 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3873 (name
, `
bool (btos, get
), offset
, Action
(
3880 method color name get
set =
3882 (name
, `color get
, 1, Action
(
3884 let invalid = (nan
, nan
, nan
) in
3887 try color_of_string
s
3889 state
.text <- Printf.sprintf
"bad color `%s': %s"
3896 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3897 state
.text <- color_to_string
(get
());
3898 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3902 method string name get
set =
3904 (name
, `
string get
, 1, Action
(
3906 let ondone s = set s in
3907 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3908 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3912 method colorspace name get
set =
3914 (name
, `
string get
, 1, Action
(
3918 inherit lvsourcebase
3921 m_active
<- CSTE.to_int conf
.colorspace
;
3924 method getitemcount
=
3925 Array.length
CSTE.names
3928 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3929 ignore
(uioh
, first, pan
);
3930 if not cancel
then set active;
3932 method hasaction
_ = true
3936 let modehash = findkeyhash conf
"info" in
3937 coe (new listview ~zebra
:false ~helpmode
:false
3938 ~
source ~trusted
:true ~
modehash)
3941 method paxmark name get
set =
3943 (name
, `
string get
, 1, Action
(
3947 inherit lvsourcebase
3950 m_active
<- MTE.to_int conf
.paxmark
;
3953 method getitemcount
= Array.length
MTE.names
3954 method getitem
n = (MTE.names
.(n), 0)
3955 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3956 ignore
(uioh
, first, pan
);
3957 if not cancel
then set active;
3959 method hasaction
_ = true
3963 let modehash = findkeyhash conf
"info" in
3964 coe (new listview ~zebra
:false ~helpmode
:false
3965 ~
source ~trusted
:true ~
modehash)
3968 method fitmodel name get
set =
3970 (name
, `
string get
, 1, Action
(
3974 inherit lvsourcebase
3977 m_active
<- FMTE.to_int conf
.fitmodel
;
3980 method getitemcount
= Array.length
FMTE.names
3981 method getitem
n = (FMTE.names
.(n), 0)
3982 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3983 ignore
(uioh
, first, pan
);
3984 if not cancel
then set active;
3986 method hasaction
_ = true
3990 let modehash = findkeyhash conf
"info" in
3991 coe (new listview ~zebra
:false ~helpmode
:false
3992 ~
source ~trusted
:true ~
modehash)
3995 method caption
s offset
=
3996 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3998 method caption2
s f offset
=
3999 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
4001 method getitemcount
= Array.length m_a
4004 let tostr = function
4005 | `
int f -> string_of_int
(f ())
4006 | `intws
f -> string_with_suffix_of_int
(f ())
4008 | `color
f -> color_to_string
(f ())
4009 | `
bool (btos, f) -> btos (f ())
4012 let name, t
, offset
, _ = m_a
.(n) in
4013 ((let s = tostr t
in
4015 then Printf.sprintf
"%s\t%s" name s
4019 method exit ~uioh ~cancel ~
active ~
first ~pan
=
4024 match m_a
.(active) with
4025 | _, _, _, Action
f -> f uioh
4026 | _, _, _, Noaction
-> uioh
4037 method hasaction
n =
4039 | _, _, _, Action
_ -> true
4040 | _, _, _, Noaction
-> false
4043 let rec fillsrc prevmode prevuioh
=
4044 let sep () = src#caption
E.s 0 in
4045 let colorp name get
set =
4047 (fun () -> color_to_string
(get
()))
4050 let c = color_of_string
v in
4053 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
4056 let oldmode = state
.mode
in
4057 let birdseye = isbirdseye state
.mode
in
4059 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4061 src#
bool "presentation mode"
4062 (fun () -> conf
.presentation
)
4063 (fun v -> setpresentationmode v);
4065 src#
bool "ignore case in searches"
4066 (fun () -> conf
.icase
)
4067 (fun v -> conf
.icase
<- v);
4070 (fun () -> conf
.preload)
4071 (fun v -> conf
.preload <- v);
4073 src#
bool "highlight links"
4074 (fun () -> conf
.hlinks
)
4075 (fun v -> conf
.hlinks
<- v);
4077 src#
bool "under info"
4078 (fun () -> conf
.underinfo
)
4079 (fun v -> conf
.underinfo
<- v);
4081 src#
bool "persistent bookmarks"
4082 (fun () -> conf
.savebmarks
)
4083 (fun v -> conf
.savebmarks
<- v);
4085 src#fitmodel
"fit model"
4086 (fun () -> FMTE.to_string conf
.fitmodel
)
4087 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4089 src#
bool "trim margins"
4090 (fun () -> conf
.trimmargins
)
4091 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4093 src#
bool "persistent location"
4094 (fun () -> conf
.jumpback
)
4095 (fun v -> conf
.jumpback
<- v);
4098 src#
int "inter-page space"
4099 (fun () -> conf
.interpagespace
)
4101 conf
.interpagespace
<- n;
4102 docolumns conf
.columns
;
4104 match state
.layout with
4109 state
.maxy <- calcheight
();
4110 let y = getpagey
pageno in
4115 (fun () -> conf
.pagebias
)
4116 (fun v -> conf
.pagebias
<- v);
4118 src#
int "scroll step"
4119 (fun () -> conf
.scrollstep
)
4120 (fun n -> conf
.scrollstep
<- n);
4122 src#
int "horizontal scroll step"
4123 (fun () -> conf
.hscrollstep
)
4124 (fun v -> conf
.hscrollstep
<- v);
4126 src#
int "auto scroll step"
4128 match state
.autoscroll
with
4130 | _ -> conf
.autoscrollstep
)
4132 let n = boundastep state
.winh
n in
4133 if state
.autoscroll
<> None
4134 then state
.autoscroll
<- Some
n;
4135 conf
.autoscrollstep
<- n);
4138 (fun () -> truncate
(conf
.zoom *. 100.))
4139 (fun v -> setzoom ((float v) /. 100.));
4142 (fun () -> conf
.angle
)
4143 (fun v -> reqlayout v conf
.fitmodel
);
4145 src#
int "scroll bar width"
4146 (fun () -> conf
.scrollbw
)
4149 reshape state
.winw state
.winh
;
4152 src#
int "scroll handle height"
4153 (fun () -> conf
.scrollh
)
4154 (fun v -> conf
.scrollh
<- v;);
4156 src#
int "thumbnail width"
4157 (fun () -> conf
.thumbw
)
4159 conf
.thumbw
<- min
4096 v;
4162 leavebirdseye beye
false;
4169 let mode = state
.mode in
4170 src#
string "columns"
4172 match conf
.columns
with
4174 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4175 | Csplit
(count
, _) -> "-" ^ string_of_int count
4178 let n, a, b = multicolumns_of_string
v in
4179 setcolumns mode n a b);
4182 src#caption
"Pixmap cache" 0;
4183 src#int_with_suffix
"size (advisory)"
4184 (fun () -> conf
.memlimit
)
4185 (fun v -> conf
.memlimit
<- v);
4188 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4189 (string_with_suffix_of_int state
.memused
)
4190 (Hashtbl.length state
.tilemap
)) 1;
4193 src#caption
"Layout" 0;
4194 src#caption2
"Dimension"
4196 Printf.sprintf
"%dx%d (virtual %dx%d)"
4197 state
.winw state
.winh
4202 src#caption2
"Position" (fun () ->
4203 Printf.sprintf
"%dx%d" state
.x state
.y
4206 src#caption2
"Position" (fun () -> describe_location ()) 1
4210 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4211 "Save these parameters as global defaults at exit"
4212 (fun () -> conf
.bedefault
)
4213 (fun v -> conf
.bedefault
<- v)
4217 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4218 src#
bool ~offset
:0 ~
btos "Extended parameters"
4219 (fun () -> !showextended)
4220 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4224 (fun () -> conf
.checkers
)
4225 (fun v -> conf
.checkers
<- v; setcheckers v);
4226 src#
bool "update cursor"
4227 (fun () -> conf
.updatecurs
)
4228 (fun v -> conf
.updatecurs
<- v);
4229 src#
bool "scroll-bar on the left"
4230 (fun () -> conf
.leftscroll
)
4231 (fun v -> conf
.leftscroll
<- v);
4233 (fun () -> conf
.verbose
)
4234 (fun v -> conf
.verbose
<- v);
4235 src#
bool "invert colors"
4236 (fun () -> conf
.invert
)
4237 (fun v -> conf
.invert
<- v);
4239 (fun () -> conf
.maxhfit
)
4240 (fun v -> conf
.maxhfit
<- v);
4241 src#
bool "redirect stderr"
4242 (fun () -> conf
.redirectstderr)
4243 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4245 (fun () -> conf
.pax
!= None
)
4248 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4249 else conf
.pax
<- None
);
4250 src#
string "uri launcher"
4251 (fun () -> conf
.urilauncher
)
4252 (fun v -> conf
.urilauncher
<- v);
4253 src#
string "path launcher"
4254 (fun () -> conf
.pathlauncher
)
4255 (fun v -> conf
.pathlauncher
<- v);
4256 src#
string "tile size"
4257 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4260 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4261 conf
.tilew
<- max
64 w;
4262 conf
.tileh
<- max
64 h;
4265 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4268 src#
int "texture count"
4269 (fun () -> conf
.texcount
)
4272 then conf
.texcount
<- v
4273 else showtext '
!'
" Failed to set texture count please retry later"
4275 src#
int "slice height"
4276 (fun () -> conf
.sliceheight
)
4278 conf
.sliceheight
<- v;
4279 wcmd "sliceh %d" conf
.sliceheight
;
4281 src#
int "anti-aliasing level"
4282 (fun () -> conf
.aalevel
)
4284 conf
.aalevel
<- bound
v 0 8;
4285 state
.anchor <- getanchor
();
4286 opendoc state
.path state
.password
;
4288 src#
string "page scroll scaling factor"
4289 (fun () -> string_of_float conf
.pgscale)
4292 let s = float_of_string
v in
4295 state
.text <- Printf.sprintf
4296 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4299 src#
int "ui font size"
4300 (fun () -> fstate
.fontsize
)
4301 (fun v -> setfontsize (bound
v 5 100));
4302 src#
int "hint font size"
4303 (fun () -> conf
.hfsize
)
4304 (fun v -> conf
.hfsize
<- bound
v 5 100);
4305 colorp "background color"
4306 (fun () -> conf
.bgcolor
)
4307 (fun v -> conf
.bgcolor
<- v);
4308 src#
bool "crop hack"
4309 (fun () -> conf
.crophack
)
4310 (fun v -> conf
.crophack
<- v);
4311 src#
string "trim fuzz"
4312 (fun () -> irect_to_string conf
.trimfuzz
)
4315 conf
.trimfuzz
<- irect_of_string
v;
4317 then settrim true conf
.trimfuzz
;
4319 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4321 src#
string "throttle"
4323 match conf
.maxwait
with
4324 | None
-> "show place holder if page is not ready"
4327 then "wait for page to fully render"
4329 "wait " ^ string_of_float
time
4330 ^
" seconds before showing placeholder"
4334 let f = float_of_string
v in
4336 then conf
.maxwait
<- None
4337 else conf
.maxwait
<- Some
f
4339 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4341 src#
string "ghyll scroll"
4343 match conf
.ghyllscroll
with
4345 | Some nab
-> ghyllscroll_to_string nab
4348 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4350 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4352 src#
string "selection command"
4353 (fun () -> conf
.selcmd
)
4354 (fun v -> conf
.selcmd
<- v);
4355 src#
string "synctex command"
4356 (fun () -> conf
.stcmd
)
4357 (fun v -> conf
.stcmd
<- v);
4358 src#
string "pax command"
4359 (fun () -> conf
.paxcmd
)
4360 (fun v -> conf
.paxcmd
<- v);
4361 src#colorspace
"color space"
4362 (fun () -> CSTE.to_string conf
.colorspace
)
4364 conf
.colorspace
<- CSTE.of_int
v;
4368 src#paxmark
"pax mark method"
4369 (fun () -> MTE.to_string conf
.paxmark
)
4370 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4374 (fun () -> conf
.usepbo
)
4375 (fun v -> conf
.usepbo
<- v);
4376 src#
bool "mouse wheel scrolls pages"
4377 (fun () -> conf
.wheelbypage
)
4378 (fun v -> conf
.wheelbypage
<- v);
4379 src#
bool "open remote links in a new instance"
4380 (fun () -> conf
.riani
)
4381 (fun v -> conf
.riani
<- v);
4385 src#caption
"Document" 0;
4386 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4387 src#caption2
"Pages"
4388 (fun () -> string_of_int state
.pagecount
) 1;
4389 src#caption2
"Dimensions"
4390 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4394 src#caption
"Trimmed margins" 0;
4395 src#caption2
"Dimensions"
4396 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4400 src#caption
"OpenGL" 0;
4401 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4402 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4405 src#caption
"Location" 0;
4406 if nonemptystr state
.origin
4407 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4408 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4410 src#reset prevmode prevuioh
;
4415 let prevmode = state
.mode
4416 and prevuioh
= state
.uioh in
4417 fillsrc prevmode prevuioh
;
4418 let source = (src :> lvsource
) in
4419 let modehash = findkeyhash conf
"info" in
4420 state
.uioh <- coe (object (self)
4421 inherit listview ~zebra
:false ~helpmode
:false
4422 ~
source ~trusted
:true ~
modehash as super
4423 val mutable m_prevmemused
= 0
4424 method! infochanged
= function
4426 if m_prevmemused
!= state
.memused
4428 m_prevmemused
<- state
.memused
;
4429 G.postRedisplay "memusedchanged";
4431 | Pdim
-> G.postRedisplay "pdimchanged"
4432 | Docinfo
-> fillsrc prevmode prevuioh
4434 method! key key mask
=
4435 if not
(Wsi.withctrl mask
)
4438 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4439 | @right
| @kpright
-> coe (self#updownlevel
1)
4440 | _ -> super#
key key mask
4441 else super#
key key mask
4443 G.postRedisplay "info";
4449 inherit lvsourcebase
4450 method getitemcount
= Array.length state
.help
4452 let s, l, _ = state
.help
.(n) in
4455 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4459 match state
.help
.(active) with
4460 | _, _, Action
f -> Some
(f uioh)
4461 | _, _, Noaction
-> Some
uioh
4470 method hasaction
n =
4471 match state
.help
.(n) with
4472 | _, _, Action
_ -> true
4473 | _, _, Noaction
-> false
4479 let modehash = findkeyhash conf
"help" in
4481 state
.uioh <- coe (new listview
4482 ~zebra
:false ~helpmode
:true
4483 ~
source ~trusted
:true ~
modehash);
4484 G.postRedisplay "help";
4489 let re = Str.regexp
"[\r\n]" in
4491 inherit lvsourcebase
4492 val mutable m_items
= E.a
4494 method getitemcount
= 1 + Array.length m_items
4499 else m_items
.(n-1), 0
4501 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4506 then Buffer.clear state
.errmsgs
;
4513 method hasaction
n =
4517 state
.newerrmsgs
<- false;
4518 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4519 m_items
<- Array.of_list
l
4528 let source = (msgsource :> lvsource
) in
4529 let modehash = findkeyhash conf
"listview" in
4530 state
.uioh <- coe (object
4531 inherit listview ~zebra
:false ~helpmode
:false
4532 ~
source ~trusted
:false ~
modehash as super
4535 then msgsource#reset
;
4538 G.postRedisplay "msgs";
4541 let enterannotmode =
4544 inherit lvsourcebase
4545 val mutable m_items
= E.a
4547 method getitemcount
= Array.length m_items
4552 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4553 ignore
(uioh, cancel
, active, first, pan
);
4556 method hasaction
_ = true
4559 state
.newerrmsgs
<- false;
4560 let rec split accu b i
=
4562 if p = String.length
s
4563 then String.sub
s b (p-b) :: accu
4565 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4567 let ss = if i
= 0 then E.s else String.sub
s b i
in
4568 split (ss::accu) (p+1) 0
4572 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4581 let source = (msgsource :> lvsource
) in
4582 let modehash = findkeyhash conf
"listview" in
4583 state
.uioh <- coe (object
4584 inherit listview ~zebra
:false ~helpmode
:false
4585 ~
source ~trusted
:false ~
modehash
4587 G.postRedisplay "annot";
4590 let quickbookmark ?title
() =
4591 match state
.layout with
4597 let tm = Unix.localtime
(now
()) in
4598 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4602 (tm.Unix.tm_year
+ 1900)
4605 | Some
title -> title
4607 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4610 let setautoscrollspeed step goingdown
=
4611 let incr = max
1 ((abs step
) / 2) in
4612 let incr = if goingdown
then incr else -incr in
4613 let astep = boundastep state
.winh
(step
+ incr) in
4614 state
.autoscroll
<- Some
astep;
4618 match conf
.columns
with
4620 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4623 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4625 let existsinrow pageno (columns
, coverA
, coverB
) p =
4626 let last = ((pageno - coverA
) mod columns
) + columns
in
4627 let rec any = function
4630 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4634 then (if l.pageno = last then false else any rest
)
4642 match state
.layout with
4644 let pageno = page_of_y state
.y in
4645 gotoghyll (getpagey
(pageno+1))
4647 match conf
.columns
with
4649 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4651 let y = clamp (pgscale state
.winh
) in
4654 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4655 gotoghyll (getpagey
pageno)
4656 | Cmulti
((c, _, _) as cl, _) ->
4657 if conf
.presentation
4658 && (existsinrow l.pageno cl
4659 (fun l -> l.pageh
> l.pagey + l.pagevh))
4661 let y = clamp (pgscale state
.winh
) in
4664 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4665 gotoghyll (getpagey
pageno)
4667 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4669 let pagey, pageh
= getpageyh
l.pageno in
4670 let pagey = pagey + pageh
* l.pagecol
in
4671 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4672 gotoghyll (pagey + pageh
+ ips)
4676 match state
.layout with
4678 let pageno = page_of_y state
.y in
4679 gotoghyll (getpagey
(pageno-1))
4681 match conf
.columns
with
4683 if conf
.presentation
&& l.pagey != 0
4685 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4687 let pageno = max
0 (l.pageno-1) in
4688 gotoghyll (getpagey
pageno)
4689 | Cmulti
((c, _, coverB
) as cl, _) ->
4690 if conf
.presentation
&&
4691 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4693 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4696 if l.pageno = state
.pagecount
- coverB
4700 let pageno = max
0 (l.pageno-decr) in
4701 gotoghyll (getpagey
pageno)
4709 let pageno = max
0 (l.pageno-1) in
4710 let pagey, pageh
= getpageyh
pageno in
4713 let pagey, pageh
= getpageyh
l.pageno in
4714 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4719 let viewkeyboard key mask
=
4721 let mode = state
.mode in
4722 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4725 G.postRedisplay "view:enttext"
4727 let ctrl = Wsi.withctrl mask
in
4729 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4734 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4736 state
.mode <- LinkNav
(Ltgendir
0);
4739 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4742 begin match state
.mstate
with
4745 G.postRedisplay "kill zoom rect";
4748 | Mscrolly
| Mscrollx
4751 begin match state
.mode with
4754 G.postRedisplay "esc leave linknav"
4758 match state
.ranchors
with
4760 | (path, password
, anchor, origin
) :: rest
->
4761 state
.ranchors
<- rest
;
4762 state
.anchor <- anchor;
4763 state
.origin
<- origin
;
4764 state
.nameddest
<- E.s;
4765 opendoc path password
4770 gotoghyll (getnav ~
-1)
4781 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4782 G.postRedisplay "dehighlight";
4784 | @slash
| @question
->
4785 let ondone isforw
s =
4786 cbput state
.hists
.pat
s;
4787 state
.searchpattern
<- s;
4790 let s = String.make
1 (Char.chr
key) in
4791 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4792 textentry, ondone (key = @slash
), true)
4794 | @plus
| @kpplus
| @equals
when ctrl ->
4795 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4796 setzoom (conf
.zoom +. incr)
4798 | @plus
| @kpplus
->
4801 try int_of_string
s with exc
->
4802 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4808 state
.text <- "page bias is now " ^ string_of_int
n;
4811 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4813 | @minus
| @kpminus
when ctrl ->
4814 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4815 setzoom (max
0.01 (conf
.zoom -. decr))
4817 | @minus
| @kpminus
->
4818 let ondone msg
= state
.text <- msg
in
4820 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4821 optentry state
.mode, ondone, true
4832 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4834 match conf
.columns
with
4835 | Csingle
_ | Cmulti
_ -> 1
4836 | Csplit
(n, _) -> n
4838 let h = state
.winh
-
4839 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4841 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4842 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4847 match conf
.fitmodel
with
4848 | FitWidth
-> FitProportional
4849 | FitProportional
-> FitPage
4850 | FitPage
-> FitWidth
4852 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4853 reqlayout conf
.angle
fm
4861 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4862 when not
ctrl -> (* 0..9 *)
4865 try int_of_string
s with exc
->
4866 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4872 cbput state
.hists
.pag
(string_of_int
n);
4873 gotopage1 (n + conf
.pagebias
- 1) 0;
4876 let pageentry text key =
4877 match Char.unsafe_chr
key with
4878 | '
g'
-> TEdone
text
4879 | _ -> intentry text key
4881 let text = String.make
1 (Char.chr
key) in
4882 enttext (":", text, Some
(onhist state
.hists
.pag
),
4883 pageentry, ondone, true)
4886 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4887 reshape state
.winw state
.winh
;
4890 state
.bzoom
<- not state
.bzoom
;
4892 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4895 conf
.hlinks
<- not conf
.hlinks
;
4896 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4897 G.postRedisplay "toggle highlightlinks";
4900 state
.glinks
<- true;
4901 let mode = state
.mode in
4902 state
.mode <- Textentry
(
4903 (":", E.s, None
, linknentry, linkndone gotounder, false),
4905 state
.glinks
<- false;
4909 G.postRedisplay "view:linkent(F)"
4912 state
.glinks
<- true;
4913 let mode = state
.mode in
4914 state
.mode <- Textentry
(
4916 ":", E.s, None
, linknentry, linkndone (fun under ->
4917 selstring (undertext under);
4921 state
.glinks
<- false;
4925 G.postRedisplay "view:linkent"
4928 begin match state
.autoscroll
with
4930 conf
.autoscrollstep
<- step
;
4931 state
.autoscroll
<- None
4933 if conf
.autoscrollstep
= 0
4934 then state
.autoscroll
<- Some
1
4935 else state
.autoscroll
<- Some conf
.autoscrollstep
4942 setpresentationmode (not conf
.presentation
);
4943 showtext ' '
("presentation mode " ^
4944 if conf
.presentation
then "on" else "off");
4947 if List.mem
Wsi.Fullscreen state
.winstate
4948 then Wsi.reshape conf
.cwinw conf
.cwinh
4949 else Wsi.fullscreen
()
4952 search state
.searchpattern
false
4955 search state
.searchpattern
true
4958 begin match state
.layout with
4961 gotoghyll (getpagey
l.pageno)
4967 | @delete
| @kpdelete
-> (* delete *)
4971 showtext ' '
(describe_location ());
4974 begin match state
.layout with
4977 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4982 enterbookmarkmode ()
4990 | @e when Buffer.length state
.errmsgs
> 0 ->
4995 match state
.layout with
5000 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5003 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5007 showtext ' '
"Quick bookmark added";
5010 begin match state
.layout with
5012 let rect = getpdimrect
l.pagedimno
in
5016 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5017 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5019 (truncate
(rect.(1) -. rect.(0)),
5020 truncate
(rect.(3) -. rect.(0)))
5022 let w = truncate
((float w)*.conf
.zoom)
5023 and h = truncate
((float h)*.conf
.zoom) in
5026 state
.anchor <- getanchor
();
5027 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5029 G.postRedisplay "z";
5034 | @x -> state
.roam
()
5037 reqlayout (conf
.angle
+
5038 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5042 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5044 G.postRedisplay "brightness";
5046 | @c when state
.mode = View
->
5051 let m = (wadjsb state
.winw
- state
.w) / 2 in
5053 gotoy_and_clear_text state
.y
5057 match state
.prevcolumns
with
5058 | None
-> (1, 0, 0), 1.0
5059 | Some
(columns
, z
) ->
5062 | Csplit
(c, _) -> -c, 0, 0
5063 | Cmulti
((c, a, b), _) -> c, a, b
5064 | Csingle
_ -> 1, 0, 0
5068 setcolumns View
c a b;
5071 | @down
| @up
when ctrl && Wsi.withshift mask
->
5072 let zoom, x = state
.prevzoom
in
5076 | @k
| @up
| @kpup
->
5077 begin match state
.autoscroll
with
5079 begin match state
.mode with
5080 | Birdseye beye
-> upbirdseye 1 beye
5085 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5087 if not
(Wsi.withshift mask
) && conf
.presentation
5089 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5093 setautoscrollspeed n false
5096 | @j
| @down
| @kpdown
->
5097 begin match state
.autoscroll
with
5099 begin match state
.mode with
5100 | Birdseye beye
-> downbirdseye 1 beye
5105 then gotoy_and_clear_text (clamp (state
.winh
/2))
5107 if not
(Wsi.withshift mask
) && conf
.presentation
5109 else gotoghyll1 true (clamp (conf
.scrollstep
))
5113 setautoscrollspeed n true
5116 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5122 else conf
.hscrollstep
5124 let dx = if key = @left || key = @kpleft
then dx else -dx in
5125 state
.x <- panbound (state
.x + dx);
5126 gotoy_and_clear_text state
.y
5129 G.postRedisplay "left/right"
5132 | @prior
| @kpprior
->
5136 match state
.layout with
5138 | l :: _ -> state
.y - l.pagey
5140 clamp (pgscale (-state
.winh
))
5144 | @next | @kpnext
->
5148 match List.rev state
.layout with
5150 | l :: _ -> getpagey
l.pageno
5152 clamp (pgscale state
.winh
)
5156 | @g | @home
| @kphome
->
5159 | @G
| @jend
| @kpend
->
5161 gotoghyll (clamp state
.maxy)
5163 | @right
| @kpright
when Wsi.withalt mask
->
5164 gotoghyll (getnav 1)
5165 | @left | @kpleft
when Wsi.withalt mask
->
5166 gotoghyll (getnav ~
-1)
5171 | @v when conf
.debug
->
5174 match getopaque l.pageno with
5177 let x0, y0, x1, y1 = pagebbox
opaque in
5178 let a,b = float x0, float y0 in
5179 let c,d = float x1, float y0 in
5180 let e,f = float x1, float y1 in
5181 let h,j
= float x0, float y1 in
5182 let rect = (a,b,c,d,e,f,h,j
) in
5184 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5186 G.postRedisplay "v";
5189 let mode = state
.mode in
5190 let cmd = ref E.s in
5191 let onleave = function
5192 | Cancel
-> state
.mode <- mode
5195 match getopaque l.pageno with
5196 | Some
opaque -> pipesel opaque !cmd
5197 | None
-> ()) state
.layout;
5201 cbput state
.hists
.sel
s;
5205 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5207 G.postRedisplay "|";
5208 state
.mode <- Textentry
(te, onleave);
5211 vlog "huh? %s" (Wsi.keyname
key)
5214 let linknavkeyboard key mask
linknav =
5215 let getpage pageno =
5216 let rec loop = function
5218 | l :: _ when l.pageno = pageno -> Some
l
5219 | _ :: rest
-> loop rest
5220 in loop state
.layout
5222 let doexact (pageno, n) =
5223 match getopaque pageno, getpage pageno with
5224 | Some
opaque, Some
l ->
5225 if key = @enter
|| key = @kpenter
5227 let under = getlink
opaque n in
5228 G.postRedisplay "link gotounder";
5235 Some
(findlink
opaque LDfirst
), -1
5238 Some
(findlink
opaque LDlast
), 1
5241 Some
(findlink
opaque (LDleft
n)), -1
5244 Some
(findlink
opaque (LDright
n)), 1
5247 Some
(findlink
opaque (LDup
n)), -1
5250 Some
(findlink
opaque (LDdown
n)), 1
5255 begin match findpwl
l.pageno dir with
5259 state
.mode <- LinkNav
(Ltgendir
dir);
5260 let y, h = getpageyh
pageno in
5263 then y + h - state
.winh
5268 begin match getopaque pageno, getpage pageno with
5269 | Some
opaque, Some
_ ->
5271 let ld = if dir > 0 then LDfirst
else LDlast
in
5274 begin match link with
5276 showlinktype (getlink
opaque m);
5277 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5278 G.postRedisplay "linknav jpage";
5279 | Lnotfound
-> notfound dir
5285 begin match opt with
5286 | Some Lnotfound
-> pwl l dir;
5287 | Some
(Lfound
m) ->
5291 let _, y0, _, y1 = getlinkrect
opaque m in
5293 then gotopage1 l.pageno y0
5295 let d = fstate
.fontsize
+ 1 in
5296 if y1 - l.pagey > l.pagevh - d
5297 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5298 else G.postRedisplay "linknav";
5300 showlinktype (getlink
opaque m);
5301 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5304 | None
-> viewkeyboard key mask
5306 | _ -> viewkeyboard key mask
5311 G.postRedisplay "leave linknav"
5315 | Ltgendir
_ -> viewkeyboard key mask
5316 | Ltexact exact
-> doexact exact
5319 let keyboard key mask
=
5320 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5321 then wcmd "interrupt"
5322 else state
.uioh <- state
.uioh#
key key mask
5325 let birdseyekeyboard key mask
5326 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5328 match conf
.columns
with
5330 | Cmulti
((c, _, _), _) -> c
5331 | Csplit
_ -> failwith
"bird's eye split mode"
5333 let pgh layout = List.fold_left
5334 (fun m l -> max
l.pageh
m) state
.winh
layout in
5336 | @l when Wsi.withctrl mask
->
5337 let y, h = getpageyh
pageno in
5338 let top = (state
.winh
- h) / 2 in
5339 gotoy (max
0 (y - top))
5340 | @enter
| @kpenter
-> leavebirdseye beye
false
5341 | @escape
-> leavebirdseye beye
true
5342 | @up
-> upbirdseye incr beye
5343 | @down
-> downbirdseye incr beye
5344 | @left -> upbirdseye 1 beye
5345 | @right
-> downbirdseye 1 beye
5348 begin match state
.layout with
5352 state
.mode <- Birdseye
(
5353 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5355 gotopage1 l.pageno 0;
5358 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5360 | [] -> gotoy (clamp (-state
.winh
))
5362 state
.mode <- Birdseye
(
5363 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5365 gotopage1 l.pageno 0
5368 | [] -> gotoy (clamp (-state
.winh
))
5372 begin match List.rev state
.layout with
5374 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5375 begin match layout with
5377 let incr = l.pageh
- l.pagevh in
5382 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5384 G.postRedisplay "birdseye pagedown";
5386 else gotoy (clamp (incr + conf
.interpagespace
*2));
5390 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5391 gotopage1 l.pageno 0;
5394 | [] -> gotoy (clamp state
.winh
)
5398 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5402 let pageno = state
.pagecount
- 1 in
5403 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5404 if not
(pagevisible state
.layout pageno)
5407 match List.rev state
.pdims
with
5409 | (_, _, h, _) :: _ -> h
5411 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5412 else G.postRedisplay "birdseye end";
5414 | _ -> viewkeyboard key mask
5419 match state
.mode with
5420 | Textentry
_ -> scalecolor 0.4
5422 | View
-> scalecolor 1.0
5423 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5424 if l.pageno = hooverpageno
5427 if l.pageno = pageno
5429 let c = scalecolor 1.0 in
5431 GlDraw.line_width
3.0;
5432 let dispx = xadjsb l.pagedispx in
5434 (float (dispx-1)) (float (l.pagedispy-1))
5435 (float (dispx+l.pagevw+1))
5436 (float (l.pagedispy+l.pagevh+1))
5438 GlDraw.line_width
1.0;
5447 let postdrawpage l linkindexbase
=
5448 match getopaque l.pageno with
5450 if tileready l l.pagex
l.pagey
5452 let x = l.pagedispx - l.pagex
+ xadjsb 0
5453 and y = l.pagedispy - l.pagey in
5455 match conf
.columns
with
5456 | Csingle
_ | Cmulti
_ ->
5457 (if conf
.hlinks
then 1 else 0)
5459 && not
(isbirdseye state
.mode) then 2 else 0)
5463 match state
.mode with
5464 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5470 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5475 let scrollindicator () =
5476 let sbw, ph
, sh = state
.uioh#
scrollph in
5477 let sbh, pw, sw = state
.uioh#scrollpw
in
5482 else (state
.winw
- sbw), state
.winw
5485 GlDraw.color (0.64, 0.64, 0.64);
5486 filledrect (float x0) 0. (float x1) (float state
.winh
);
5488 0. (float (state
.winh
- sbh))
5489 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5491 GlDraw.color (0.0, 0.0, 0.0);
5493 filledrect (float x0) ph
(float x1) (ph
+. sh);
5494 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5498 match state
.mstate
with
5499 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5502 | Msel
((x0, y0), (x1, y1)) ->
5503 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5504 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5505 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5506 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5509 let showrects = function [] -> () | rects
->
5511 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5512 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5514 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5516 if l.pageno = pageno
5518 let dx = float (l.pagedispx - l.pagex
) in
5519 let dy = float (l.pagedispy - l.pagey) in
5520 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5521 Raw.sets_float state
.vraw ~
pos:0
5526 GlArray.vertex `two state
.vraw
;
5527 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5536 GlClear.color (scalecolor2 conf
.bgcolor
);
5537 GlClear.clear
[`
color];
5538 List.iter
drawpage state
.layout;
5540 match state
.mode with
5541 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5542 begin match getopaque pageno with
5544 let dx = xadjsb 0 in
5545 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5546 let x0 = x0 + dx and x1 = x1 + dx in
5553 | None
-> state
.rects
5555 | LinkNav
(Ltgendir
_)
5558 | View
-> state
.rects
5561 let rec postloop linkindexbase
= function
5563 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5564 postloop linkindexbase rest
5568 postloop 0 state
.layout;
5570 begin match state
.mstate
with
5571 | Mzoomrect
((x0, y0), (x1, y1)) ->
5573 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5574 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5575 filledrect (float x0) (float y0) (float x1) (float y1);
5579 | Mscrolly
| Mscrollx
5588 let zoomrect x y x1 y1 =
5591 and y0 = min
y y1 in
5592 gotoy (state
.y + y0);
5593 state
.anchor <- getanchor
();
5594 let zoom = (float state
.w) /. float (x1 - x0) in
5597 let adjw = wadjsb state
.winw
in
5599 then (adjw - state
.w) / 2
5602 match conf
.fitmodel
with
5603 | FitWidth
| FitProportional
-> simple ()
5605 match conf
.columns
with
5607 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5608 | Cmulti
_ | Csingle
_ -> simple ()
5610 state
.x <- (state
.x + margin) - x0;
5616 let g opaque l px py =
5617 match rectofblock
opaque px py with
5619 let x0 = a.(0) -. 20. in
5620 let x1 = a.(1) +. 20. in
5621 let y0 = a.(2) -. 20. in
5622 let zoom = (float state
.w) /. (x1 -. x0) in
5623 let pagey = getpagey
l.pageno in
5624 gotoy_and_clear_text (pagey + truncate
y0);
5625 state
.anchor <- getanchor
();
5626 let margin = (state
.w - l.pagew
)/2 in
5627 state
.x <- -truncate
x0 - margin;
5632 match conf
.columns
with
5634 showtext '
!'
"block zooming does not work properly in split columns mode"
5635 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5639 let winw = wadjsb state
.winw - 1 in
5640 let s = float x /. float winw in
5641 let destx = truncate
(float (state
.w + winw) *. s) in
5642 state
.x <- winw - destx;
5643 gotoy_and_clear_text state
.y;
5644 state
.mstate
<- Mscrollx
;
5648 let s = float y /. float state
.winh
in
5649 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5650 gotoy_and_clear_text desty;
5651 state
.mstate
<- Mscrolly
;
5654 let viewmulticlick clicks
x y mask
=
5655 let g opaque l px py =
5663 if markunder
opaque px py mark
5667 match getopaque l.pageno with
5669 | Some
opaque -> pipesel opaque cmd
5671 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5672 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5677 G.postRedisplay "viewmulticlick";
5678 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5682 match conf
.columns
with
5684 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5687 let viewmouse button down
x y mask
=
5689 | n when (n == 4 || n == 5) && not down
->
5690 if Wsi.withctrl mask
5692 match state
.mstate
with
5693 | Mzoom
(oldn
, i
) ->
5701 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5703 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5705 let zoom = conf
.zoom -. incr in
5707 state
.mstate
<- Mzoom
(n, 0);
5709 state
.mstate
<- Mzoom
(n, i
+1);
5711 else state
.mstate
<- Mzoom
(n, 0)
5715 | Mscrolly
| Mscrollx
5717 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5720 match state
.autoscroll
with
5721 | Some step
-> setautoscrollspeed step
(n=4)
5723 if conf
.wheelbypage
|| conf
.presentation
5732 then -conf
.scrollstep
5733 else conf
.scrollstep
5735 let incr = incr * 2 in
5736 let y = clamp incr in
5737 gotoy_and_clear_text y
5740 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5742 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5743 gotoy_and_clear_text state
.y
5745 | 1 when Wsi.withshift mask
->
5746 state
.mstate
<- Mnone
;
5749 match unproject x y with
5750 | Some
(pageno, ux
, uy
) ->
5751 let cmd = Printf.sprintf
5753 conf
.stcmd state
.path pageno ux uy
5759 | 1 when Wsi.withctrl mask
->
5762 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5763 state
.mstate
<- Mpan
(x, y)
5766 state
.mstate
<- Mnone
5771 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5773 state
.mstate
<- Mzoomrect
(p, p)
5776 match state
.mstate
with
5777 | Mzoomrect
((x0, y0), _) ->
5778 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5779 then zoomrect x0 y0 x y
5782 G.postRedisplay "kill accidental zoom rect";
5786 | Mscrolly
| Mscrollx
5792 | 1 when x > state
.winw - vscrollw () ->
5795 let _, position, sh = state
.uioh#
scrollph in
5796 if y > truncate
position && y < truncate
(position +. sh)
5797 then state
.mstate
<- Mscrolly
5800 state
.mstate
<- Mnone
5802 | 1 when y > state
.winh
- hscrollh () ->
5805 let _, position, sw = state
.uioh#scrollpw
in
5806 if x > truncate
position && x < truncate
(position +. sw)
5807 then state
.mstate
<- Mscrollx
5810 state
.mstate
<- Mnone
5812 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5815 let dest = if down
then getunder x y else Unone
in
5816 begin match dest with
5819 | Uremote
_ | Uremotedest
_
5820 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5823 | Unone
when down
->
5824 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5825 state
.mstate
<- Mpan
(x, y);
5827 | Uannotation contents
-> enterannotmode contents
5829 | Unone
| Utext
_ ->
5834 state
.mstate
<- Msel
((x, y), (x, y));
5835 G.postRedisplay "mouse select";
5839 match state
.mstate
with
5842 | Mzoom
_ | Mscrollx
| Mscrolly
->
5843 state
.mstate
<- Mnone
5845 | Mzoomrect
((x0, y0), _) ->
5849 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5850 state
.mstate
<- Mnone
5852 | Msel
((x0, y0), (x1, y1)) ->
5853 let rec loop = function
5857 let a0 = l.pagedispy in
5858 let a1 = a0 + l.pagevh in
5859 let b0 = l.pagedispx in
5860 let b1 = b0 + l.pagevw in
5861 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5862 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5866 match getopaque l.pageno with
5869 match Unix.pipe
() with
5873 "can not create sel pipe: %s"
5877 Ne.clo fd
(fun msg
->
5878 dolog
"%s close failed: %s" what msg
)
5881 try popen
cmd [r, 0; w, -1]; true
5883 dolog
"can not execute %S: %s"
5890 G.postRedisplay "copysel";
5892 else clo "Msel pipe/w" w;
5893 clo "Msel pipe/r" r;
5895 dosel conf
.selcmd
();
5896 state
.roam
<- dosel conf
.paxcmd
;
5908 let birdseyemouse button down
x y mask
5909 (conf
, leftx
, _, hooverpageno
, anchor) =
5912 let rec loop = function
5915 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5916 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5918 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5924 | _ -> viewmouse button down
x y mask
5930 method key key mask
=
5931 begin match state
.mode with
5932 | Textentry
textentry -> textentrykeyboard key mask
textentry
5933 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5934 | View
-> viewkeyboard key mask
5935 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5939 method button button bstate
x y mask
=
5940 begin match state
.mode with
5942 | View
-> viewmouse button bstate
x y mask
5943 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5948 method multiclick clicks
x y mask
=
5949 begin match state
.mode with
5951 | View
-> viewmulticlick clicks
x y mask
5958 begin match state
.mode with
5960 | View
| Birdseye
_ | LinkNav
_ ->
5961 match state
.mstate
with
5962 | Mzoom
_ | Mnone
-> ()
5967 state
.mstate
<- Mpan
(x, y);
5969 then state
.x <- panbound (state
.x + dx);
5971 gotoy_and_clear_text y
5974 state
.mstate
<- Msel
(a, (x, y));
5975 G.postRedisplay "motion select";
5978 let y = min state
.winh
(max
0 y) in
5982 let x = min state
.winw (max
0 x) in
5985 | Mzoomrect
(p0
, _) ->
5986 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5987 G.postRedisplay "motion zoomrect";
5991 method pmotion
x y =
5992 begin match state
.mode with
5993 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5994 let rec loop = function
5996 if hooverpageno
!= -1
5998 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5999 G.postRedisplay "pmotion birdseye no hoover";
6002 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6003 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6005 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6006 G.postRedisplay "pmotion birdseye hoover";
6016 match state
.mstate
with
6017 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
6026 let past, _, _ = !r in
6028 let delta = now -. past in
6031 else r := (now, x, y)
6035 method infochanged
_ = ()
6038 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6041 then 0.0, float state
.winh
6042 else scrollph state
.y maxy
6047 let winw = wadjsb state
.winw in
6048 let fwinw = float winw in
6050 let sw = fwinw /. float state
.w in
6051 let sw = fwinw *. sw in
6052 max
sw (float conf
.scrollh
)
6055 let maxx = state
.w + winw in
6056 let x = winw - state
.x in
6057 let percent = float x /. float maxx in
6058 (fwinw -. sw) *. percent
6060 hscrollh (), position, sw
6064 match state
.mode with
6065 | LinkNav
_ -> "links"
6066 | Textentry
_ -> "textentry"
6067 | Birdseye
_ -> "birdseye"
6070 findkeyhash conf
modename
6072 method eformsgs
= true
6073 method hasvscrollb
= conf
.scrollb
land scrollbvv
!= 0
6074 method hashscrollb
= conf
.scrollb
land scrollbhv
!= 0
6077 let adderrmsg src msg
=
6078 Buffer.add_string state
.errmsgs msg
;
6079 state
.newerrmsgs
<- true;
6083 let adderrfmt src fmt
=
6084 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6088 let cl = splitatspace cmds
in
6090 try Scanf.sscanf
s fmt
f
6092 adderrfmt "remote exec"
6093 "error processing '%S': %s\n" cmds
(exntos exn
)
6096 | "reload" :: [] -> reload ()
6097 | "goto" :: args
:: [] ->
6098 scan args
"%u %f %f"
6100 let cmd, _ = state
.geomcmds
in
6102 then gotopagexy pageno x y
6105 gotopagexy pageno x y;
6108 state
.reprf
<- f state
.reprf
6110 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6111 | "gotor" :: args
:: [] ->
6113 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6114 | "gotord" :: args
:: [] ->
6116 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6117 | "rect" :: args
:: [] ->
6118 scan args
"%u %u %f %f %f %f"
6119 (fun pageno color x0 y0 x1 y1 ->
6120 onpagerect pageno (fun w h ->
6121 let _,w1,h1
,_ = getpagedim
pageno in
6122 let sw = float w1 /. float w
6123 and sh = float h1
/. float h in
6127 and y1s
= y1 *. sh in
6128 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6130 state
.rects <- (pageno, color, rect) :: state
.rects;
6131 G.postRedisplay "rect";
6134 | "activatewin" :: [] -> Wsi.activatewin
()
6135 | "quit" :: [] -> raise Quit
6137 adderrfmt "remote command"
6138 "error processing remote command: %S\n" cmds
;
6142 let scratch = Bytes.create
80 in
6143 let buf = Buffer.create
80 in
6146 try Some
(Unix.read fd
scratch 0 80)
6148 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6149 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6152 match tempfr () with
6158 if Buffer.length
buf > 0
6160 let s = Buffer.contents
buf in
6170 let pos = Bytes.index_from
scratch ppos '
\n'
in
6171 if pos >= n then -1 else pos
6172 with Not_found
-> -1
6176 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6177 let s = Buffer.contents
buf in
6183 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6189 let remoteopen path =
6190 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6192 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6197 let gcconfig = ref E.s in
6198 let trimcachepath = ref E.s in
6199 let rcmdpath = ref E.s in
6200 let pageno = ref None
in
6201 let rootwid = ref 0 in
6202 let openlast = ref false in
6203 let nofc = ref false in
6204 selfexec := Sys.executable_name
;
6207 [("-p", Arg.String
(fun s -> state
.password
<- s),
6208 "<password> Set password");
6212 Config.fontpath
:= s;
6213 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6215 "<path> Set path to the user interface font");
6219 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6220 Config.confpath
:= s),
6221 "<path> Set path to the configuration file");
6223 ("-last", Arg.Set
openlast, " Open last document");
6225 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6226 "<page-number> Jump to page");
6228 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6229 "<path> Set path to the trim cache file");
6231 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6232 "<named-destination> Set named destination");
6234 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6235 ("-cxack", Arg.Set
cxack, " Cut corners");
6237 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6238 "<path> Set path to the remote commands source");
6240 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6241 "<original-path> Set original path");
6243 ("-gc", Arg.Set_string
gcconfig,
6244 "<script-path> Collect garbage with the help of a script");
6246 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6248 ("-v", Arg.Unit
(fun () ->
6250 "%s\nconfiguration path: %s\n"
6254 exit
0), " Print version and exit");
6256 ("-embed", Arg.Set_int
rootwid,
6257 "<window-id> Embed into window")
6260 (fun s -> state
.path <- s)
6261 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6264 then selfexec := !selfexec ^
" -wtmode";
6266 let histmode = emptystr state
.path && not
!openlast in
6268 if not
(Config.load !openlast)
6269 then prerr_endline
"failed to load configuration";
6270 begin match !pageno with
6271 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6275 if not
(emptystr
!gcconfig)
6278 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6280 error
"gc socketpair failed: %s" (exntos exn
)
6283 match popen
!gcconfig [(c, 0); (c, 1)] with
6288 error
"failed to popen gc script: %s" (exntos exn
);
6291 let wsfd, winw, winh
= Wsi.init
(object (self)
6292 val mutable m_clicks
= 0
6293 val mutable m_click_x
= 0
6294 val mutable m_click_y
= 0
6295 val mutable m_lastclicktime
= infinity
6297 method private cleanup
=
6298 state
.roam
<- noroam
;
6299 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6300 method expose
= G.postRedisplay"expose"
6304 | Wsi.Unobscured
-> "unobscured"
6305 | Wsi.PartiallyObscured
-> "partiallyobscured"
6306 | Wsi.FullyObscured
-> "fullyobscured"
6308 vlog "visibility change %s" name
6309 method display = display ()
6310 method map mapped
= vlog "mappped %b" mapped
6311 method reshape w h =
6314 method mouse
b d x y m =
6315 if d && canselect ()
6317 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6323 if abs
x - m_click_x
> 10
6324 || abs
y - m_click_y
> 10
6325 || abs_float
(t -. m_lastclicktime
) > 0.3
6327 m_clicks
<- m_clicks
+ 1;
6328 m_lastclicktime
<- t;
6332 G.postRedisplay "cleanup";
6333 state
.uioh <- state
.uioh#button
b d x y m;
6335 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6340 m_lastclicktime
<- infinity
;
6341 state
.uioh <- state
.uioh#button
b d x y m
6345 state
.uioh <- state
.uioh#button
b d x y m
6348 state
.mpos
<- (x, y);
6349 state
.uioh <- state
.uioh#motion
x y
6350 method pmotion
x y =
6351 state
.mpos
<- (x, y);
6352 state
.uioh <- state
.uioh#pmotion
x y
6354 let mascm = m land (
6355 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6358 let x = state
.x and y = state
.y in
6360 if x != state
.x || y != state
.y then self#cleanup
6362 match state
.keystate
with
6364 let km = k
, mascm in
6367 let modehash = state
.uioh#
modehash in
6368 try Hashtbl.find modehash km
6370 try Hashtbl.find (findkeyhash conf
"global") km
6371 with Not_found
-> KMinsrt
(k
, m)
6373 | KMinsrt
(k
, m) -> keyboard k
m
6374 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6375 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6377 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6378 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6379 state
.keystate
<- KSnone
6380 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6381 state
.keystate
<- KSinto
(keys
, insrt
)
6382 | KSinto
_ -> state
.keystate
<- KSnone
6385 state
.mpos
<- (x, y);
6386 state
.uioh <- state
.uioh#pmotion
x y
6387 method leave = state
.mpos
<- (-1, -1)
6388 method winstate wsl
= state
.winstate
<- wsl
6389 method quit
= raise Quit
6390 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6395 List.exists
GlMisc.check_extension
6396 [ "GL_ARB_texture_rectangle"
6397 ; "GL_EXT_texture_recangle"
6398 ; "GL_NV_texture_rectangle" ]
6400 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6403 let r = GlMisc.get_string `renderer
in
6404 let p = "Mesa DRI Intel(" in
6405 let l = String.length
p in
6406 String.length
r > l && String.sub
r 0 l = p
6409 defconf
.sliceheight
<- 1024;
6410 defconf
.texcount
<- 32;
6411 defconf
.usepbo
<- true;
6415 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6417 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6425 setcheckers conf
.checkers
;
6427 if conf
.redirectstderr
6431 (Buffer.to_bytes state
.errmsgs
)
6432 (match state
.errfd
with
6434 let s = Bytes.create
(80*24) in
6437 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6439 then Unix.read fd
s 0 (Bytes.length
s)
6445 else Bytes.sub
s 0 n
6449 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6450 with exn
-> print_endline
(exntos exn
)
6455 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6456 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6457 !Config.fontpath
, !trimcachepath,
6458 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6461 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6467 Wsi.settitle
"llpp (history)";
6471 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6472 opendoc state
.path state
.password
;
6477 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6480 if nonemptystr
!rcmdpath
6481 then remoteopen !rcmdpath
6486 let rec loop deadline
=
6488 match state
.errfd
with
6489 | None
-> [state
.ss; state
.wsfd]
6490 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6495 | Some fd
-> fd
:: r
6499 state
.redisplay
<- false;
6506 if deadline
= infinity
6508 else max
0.0 (deadline
-. now)
6513 try Unix.select
r [] [] timeout
6514 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6520 if state
.ghyll
== noghyll
6522 match state
.autoscroll
with
6523 | Some step
when step
!= 0 ->
6524 let y = state
.y + step
in
6528 else if y >= state
.maxy then 0 else y
6531 if state
.mode = View
6532 then state
.text <- E.s;
6535 else deadline
+. 0.01
6540 let rec checkfds = function
6542 | fd
:: rest
when fd
= state
.ss ->
6543 let cmd = readcmd state
.ss in
6547 | fd
:: rest
when fd
= state
.wsfd ->
6551 | fd
:: rest
when Some fd
= !optrfd ->
6552 begin match remote fd
with
6553 | None
-> optrfd := remoteopen !rcmdpath;
6554 | opt -> optrfd := opt
6559 let s = Bytes.create
80 in
6560 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6561 if conf
.redirectstderr
6563 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6564 state
.newerrmsgs
<- true;
6565 state
.redisplay
<- true;
6568 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6574 if !reeenterhist then (
6576 reeenterhist := false;
6580 if deadline
= infinity
6584 match state
.autoscroll
with
6585 | Some step
when step
!= 0 -> deadline1
6586 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6594 Config.save
leavebirdseye;