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 (conf
.scrollb
land scrollbhv
= 0)
100 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
106 if (conf
.scrollb
land scrollbvv
= 0)
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
259 | Uremotedest _
-> Some
under
261 onppundermouse g x y Unone
266 match unproject opaque
x y with
267 | Some
(x, y) -> Some
(Some
(l
.pageno
, x, y))
270 onppundermouse g x y None
;
274 state
.text
<- Printf.sprintf
"%c%s" c s
;
275 G.postRedisplay "showtext";
278 let pipesel opaque cmd
=
281 match Unix.pipe
() with
284 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
286 let doclose what fd
=
287 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
290 try popen cmd
[r
, 0; w
, -1]; true
292 dolog
"can not execute %S: %s" cmd
(exntos exn
);
298 G.postRedisplay "pipesel";
300 else doclose "pipesel pipe/w" w
;
301 doclose "pipesel pipe/r" r
;
305 let g opaque l
px py
=
306 if markunder opaque
px py conf
.paxmark
309 match getopaque l
.pageno
with
311 | Some opaque
-> pipesel opaque conf
.paxcmd
316 G.postRedisplay "paxunder";
317 if conf
.paxmark
= Mark_page
320 match getopaque l
.pageno
with
322 | Some opaque
-> clearmark opaque
) state
.layout
;
324 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
328 match Unix.pipe
() with
330 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
333 Ne.clo fd
(fun msg
->
334 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
338 try popen conf
.selcmd
[r
, 0; w
, -1]; true
341 (Printf.sprintf
"failed to execute %s: %s"
342 conf
.selcmd
(exntos exn
));
348 let l = String.length s
in
349 let bytes = Bytes.unsafe_of_string s
in
350 let n = tempfailureretry
(Unix.write w
bytes 0) l in
355 "failed to write %d characters to sel pipe, wrote %d"
360 (Printf.sprintf
"failed to write to sel pipe: %s"
365 clo "selstring pipe/r" r
;
366 clo "selstring pipe/w" w
;
369 let undertext = function
372 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
373 | Utext s
-> "font: " ^ s
374 | Uunexpected s
-> "unexpected: " ^ s
375 | Ulaunch s
-> "launch: " ^ s
376 | Unamed s
-> "named: " ^ s
377 | Uremote
(filename
, pageno
) ->
378 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
379 | Uremotedest
(filename
, destname
) ->
380 Printf.sprintf
"%s: destination %S" filename destname
383 let updateunder x y =
384 match getunder x y with
385 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
387 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
388 Wsi.setcursor
Wsi.CURSOR_INFO
389 | Ulinkgoto
(pageno
, _
) ->
391 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
392 Wsi.setcursor
Wsi.CURSOR_INFO
394 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
395 Wsi.setcursor
Wsi.CURSOR_TEXT
397 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
398 Wsi.setcursor
Wsi.CURSOR_INHERIT
400 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
401 Wsi.setcursor
Wsi.CURSOR_INHERIT
403 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
404 Wsi.setcursor
Wsi.CURSOR_INHERIT
405 | Uremote
(filename
, pageno
) ->
406 if conf
.underinfo
then showtext 'r'
407 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
408 Wsi.setcursor
Wsi.CURSOR_INFO
409 | Uremotedest
(filename
, destname
) ->
410 if conf
.underinfo
then showtext 'r'
411 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
412 Wsi.setcursor
Wsi.CURSOR_INFO
415 let showlinktype under =
428 let s = undertext under in
433 let b = Buffer.create
(String.length
s + 1) in
434 Buffer.add_string
b s;
439 let intentry_with_suffix text key
=
441 if key
>= 32 && key
< 127
445 match Char.lowercase
c with
447 let text = addchar text c in
451 let text = addchar text c in
455 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
460 let s = Bytes.create
4 in
461 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
462 if n != 4 then error
"incomplete read(len) = %d" n;
463 let len = (Char.code
(Bytes.get
s 0) lsl 24)
464 lor (Char.code
(Bytes.get
s 1) lsl 16)
465 lor (Char.code
(Bytes.get
s 2) lsl 8)
466 lor (Char.code
(Bytes.get
s 3))
468 let s = Bytes.create
len in
469 let n = tempfailureretry
(Unix.read fd
s 0) len in
470 if n != len then error
"incomplete read(data) %d vs %d" n len;
474 let btod b = if b then 1 else 0;;
477 let b = Buffer.create
16 in
478 Buffer.add_string
b "llll";
481 let s = Buffer.to_bytes
b in
482 let n = Bytes.length
s in
484 (* dolog "wcmd %S" (String.sub s 4 len); *)
485 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
486 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
487 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
488 Bytes.set
s 3 (Char.chr
(len land 0xff));
489 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
490 if n'
!= n then error
"write failed %d vs %d" n'
n;
494 let nogeomcmds cmds
=
496 | s, [] -> emptystr
s
500 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
501 let sh = sh - (hscrollh ()) in
502 let rec fold accu
n =
503 if n = Array.length
b
506 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
509 || n = state
.pagecount
- coverB
510 || (n - coverA
) mod columns
= columns
- 1)
516 let pagey = max
0 (y - vy
) in
517 let pagedispy = if pagey > 0 then 0 else vy
- y in
518 let pagedispx, pagex
=
520 if n = coverA
- 1 || n = state
.pagecount
- coverB
521 then state
.x + (wadjsb state
.winw
- w
) / 2
522 else dx + xoff
+ state
.x
529 let vw = wadjsb state
.winw
- pagedispx in
530 let pw = w
- pagex
in
533 let pagevh = min
(h
- pagey) (sh - pagedispy) in
534 if pagevw > 0 && pagevh > 0
545 ; pagedispx = pagedispx
546 ; pagedispy = pagedispy
558 if Array.length
b = 0
560 else List.rev
(fold [] (page_of_y
y))
563 let layoutS (columns
, b) y sh =
564 let sh = sh - hscrollh () in
565 let rec fold accu n =
566 if n = Array.length
b
569 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
576 let x = xoff
+ state
.x in
577 let pagey = max
0 (y - vy
) in
578 let pagedispy = if pagey > 0 then 0 else vy
- y in
579 let pagedispx, pagex
=
593 let pagecolw = pagew
/columns
in
595 if pagecolw < state
.winw
596 then pagedispx + ((wadjsb state
.winw
- pagecolw) / 2)
600 let vw = wadjsb state
.winw
- pagedispx in
601 let pw = pagew
- pagex
in
604 let pagevw = min
pagevw pagecolw in
605 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
606 if pagevw > 0 && pagevh > 0
617 ; pagedispx = pagedispx
618 ; pagedispy = pagedispy
619 ; pagecol
= n mod columns
634 if nogeomcmds state
.geomcmds
636 match conf
.columns
with
637 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
638 | Cmulti
c -> layoutN c y sh
639 | Csplit
s -> layoutS s y sh
644 let y = state
.y + incr
in
646 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
651 let tilex = l.pagex
mod conf
.tilew
in
652 let tiley = l.pagey mod conf
.tileh
in
654 let col = l.pagex
/ conf
.tilew
in
655 let row = l.pagey / conf
.tileh
in
657 let rec rowloop row y0 dispy h
=
661 let dh = conf
.tileh
- y0 in
663 let rec colloop col x0 dispx w
=
667 let dw = conf
.tilew
- x0 in
669 let dispx'
= xadjsb dispx in
670 f col row dispx' dispy
x0 y0 dw dh;
671 colloop (col+1) 0 (dispx+dw) (w
-dw)
674 colloop col tilex l.pagedispx l.pagevw;
675 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
678 if l.pagevw > 0 && l.pagevh > 0
679 then rowloop row tiley l.pagedispy l.pagevh;
682 let gettileopaque l col row =
684 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
686 try Some
(Hashtbl.find state
.tilemap
key)
687 with Not_found
-> None
690 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
691 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
692 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
695 let filledrect x0 y0 x1 y1 =
696 GlArray.disable `texture_coord
;
697 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
698 GlArray.vertex `two state
.vraw
;
699 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
700 GlArray.enable `texture_coord
;
703 let linerect x0 y0 x1 y1 =
704 GlArray.disable `texture_coord
;
705 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
706 GlArray.vertex `two state
.vraw
;
707 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
708 GlArray.enable `texture_coord
;
711 let drawtiles l color
=
714 let f col row x y tilex tiley w h
=
715 match gettileopaque l col row with
716 | Some
(opaque
, _
, t
) ->
717 let params = x, y, w
, h
, tilex, tiley in
719 then GlTex.env
(`mode `blend
);
720 drawtile
params opaque
;
722 then GlTex.env
(`mode `modulate
);
726 let s = Printf.sprintf
730 let w = measurestr fstate
.fontsize
s in
731 GlDraw.color
(0.0, 0.0, 0.0);
732 filledrect (float (x-2))
735 (float (y + fstate
.fontsize
+ 2));
736 GlDraw.color
(1.0, 1.0, 1.0);
737 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
747 let lw = wadjsb state
.winw
- x in
750 let lh = state
.winh
- y in
754 then GlTex.env
(`mode `blend
);
755 begin match state
.checkerstexid
with
757 Gl.enable `texture_2d
;
758 GlTex.bind_texture ~target
:`texture_2d id
;
762 and y1 = float (y+h
) in
764 let tw = float w /. 16.0
765 and th
= float h
/. 16.0 in
766 let tx0 = float tilex /. 16.0
767 and ty0
= float tiley /. 16.0 in
769 and ty1
= ty0
+. th
in
770 Raw.sets_float state
.vraw ~pos
:0
771 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
772 Raw.sets_float state
.traw ~pos
:0
773 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
774 GlArray.vertex `two state
.vraw
;
775 GlArray.tex_coord `two state
.traw
;
776 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
777 Gl.disable `texture_2d
;
780 GlDraw.color
(1.0, 1.0, 1.0);
781 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
784 then GlTex.env
(`mode `modulate
);
785 if w > 128 && h
> fstate
.fontsize
+ 10
787 let c = if conf
.invert
then 1.0 else 0.0 in
788 GlDraw.color
(c, c, c);
791 then (col*conf
.tilew
, row*conf
.tileh
)
794 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
803 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
805 let tilevisible1 l x y =
807 and ax1
= l.pagex
+ l.pagevw
809 and ay1
= l.pagey + l.pagevh in
813 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
814 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
816 let rx0 = max
ax0 bx0
817 and ry0
= max ay0 by0
818 and rx1
= min ax1
bx1
819 and ry1
= min ay1 by1
in
821 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
825 let tilevisible layout n x y =
826 let rec findpageinlayout m
= function
827 | l :: rest
when l.pageno
= n ->
828 tilevisible1 l x y || (
829 match conf
.columns
with
830 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
835 | _
:: rest
-> findpageinlayout 0 rest
838 findpageinlayout 0 layout;
841 let tileready l x y =
842 tilevisible1 l x y &&
843 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
846 let tilepage n p
layout =
847 let rec loop = function
851 let f col row _ _ _ _ _ _
=
852 if state
.currently
= Idle
854 match gettileopaque l col row with
857 let x = col*conf
.tilew
858 and y = row*conf
.tileh
in
860 let w = l.pagew
- x in
864 let h = l.pageh
- y in
869 then getpbo
w h conf
.colorspace
872 wcmd "tile %s %d %d %d %d %s"
873 (~
> p
) x y w h (~
> pbo);
876 l, p
, conf
.colorspace
, conf
.angle
,
877 state
.gen
, col, row, conf
.tilew
, conf
.tileh
886 if nogeomcmds state
.geomcmds
890 let preloadlayout y =
891 let y = if y < state
.winh
then 0 else y - state
.winh
in
892 let h = state
.winh
*3 in
898 if state
.currently
!= Idle
903 begin match getopaque l.pageno
with
905 wcmd "page %d %d" l.pageno
l.pagedimno
;
906 state
.currently
<- Loading
(l, state
.gen
);
908 tilepage l.pageno opaque pages
;
913 if nogeomcmds state
.geomcmds
919 if conf
.preload && state
.currently
= Idle
920 then load (preloadlayout state
.y);
923 let layoutready layout =
924 let rec fold all ls
=
927 let seen = ref false in
928 let allvisible = ref true in
929 let foo col row _ _ _ _ _ _
=
931 allvisible := !allvisible &&
932 begin match gettileopaque l col row with
938 fold (!seen && !allvisible) rest
941 let alltilesvisible = fold true layout in
946 let y = bound
y 0 state
.maxy
in
947 let y, layout, proceed
=
948 match conf
.maxwait
with
949 | Some time
when state
.ghyll
== noghyll
->
950 begin match state
.throttle
with
952 let layout = layout y state
.winh
in
953 let ready = layoutready layout in
957 state
.throttle
<- Some
(layout, y, now
());
959 else G.postRedisplay "gotoy showall (None)";
961 | Some
(_
, _
, started
) ->
962 let dt = now
() -. started
in
965 state
.throttle
<- None
;
966 let layout = layout y state
.winh
in
968 G.postRedisplay "maxwait";
975 let layout = layout y state
.winh
in
976 if not
!wtmode || layoutready layout
977 then G.postRedisplay "gotoy ready";
983 state
.layout <- layout;
984 begin match state
.mode
with
987 | Ltexact
(pageno
, linkno
) ->
988 let rec loop = function
990 state
.mode
<- LinkNav
(Ltgendir
0)
991 | l :: _
when l.pageno
= pageno
->
992 begin match getopaque pageno
with
994 state
.mode
<- LinkNav
(Ltgendir
0)
996 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
997 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
998 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
999 then state
.mode
<- LinkNav
(Ltgendir
0)
1001 | _
:: rest
-> loop rest
1010 begin match state
.mode
with
1011 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1012 if not
(pagevisible layout pageno
)
1014 match state
.layout with
1017 state
.mode
<- Birdseye
(
1018 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1025 let rec loop = function
1028 match getopaque l.pageno
with
1034 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1036 if dir
> 0 then LDfirst
else LDlast
1042 | Lnotfound
-> loop rest
1044 showlinktype (getlink opaque
n);
1045 Ltexact
(l.pageno
, n)
1049 state
.mode
<- LinkNav
linknav
1057 state
.ghyll
<- noghyll
;
1060 let mx, my
= state
.mpos
in
1065 let conttiling pageno opaque
=
1066 tilepage pageno opaque
1067 (if conf
.preload then preloadlayout state
.y else state
.layout)
1070 let gotoy_and_clear_text y =
1071 if not conf
.verbose
then state
.text <- E.s;
1075 let getanchory (n, top
, dtop
) =
1076 let y, h = getpageyh
n in
1077 if conf
.presentation
1079 let ips = calcips
h in
1080 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1082 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1085 let gotoanchor anchor
=
1086 gotoy (getanchory anchor
);
1090 cbput state
.hists
.nav
(getanchor
());
1094 let anchor = cbgetc state
.hists
.nav dir
in
1098 let gotoghyll1 single
y =
1099 let scroll f n a
b =
1100 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1102 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1104 then s (float f /. float a
)
1107 then 1.0 -. s ((float (f-b) /. float (n-b)))
1113 let ins = float a
*. 0.5
1114 and outs
= float (n-b) *. 0.5 in
1116 ins +. outs
+. float ones
1118 let rec set nab
y sy
=
1119 let (_N
, _A
, _B
), y =
1122 let scl = if y > sy
then 2 else -2 in
1123 let _N, _
, _
= nab
in
1124 (_N,0,_N), y+conf
.scrollstep
*scl
1126 let sum = summa
_N _A _B
in
1127 let dy = float (y - sy
) in
1131 then state
.ghyll
<- noghyll
1134 let s = scroll n _N _A _B
in
1135 let y1 = y1 +. ((s *. dy) /. sum) in
1136 gotoy_and_clear_text (truncate
y1);
1137 state
.ghyll
<- gf (n+1) y1;
1141 | Some
y'
when single
-> set nab
y' state
.y
1142 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1144 gf 0 (float state
.y)
1147 match conf
.ghyllscroll
with
1148 | Some nab
when not conf
.presentation
->
1149 if state
.ghyll
== noghyll
1150 then set nab
y state
.y
1151 else state
.ghyll
(Some
y)
1153 gotoy_and_clear_text y
1156 let gotoghyll = gotoghyll1 false;;
1158 let gotopage n top
=
1159 let y, h = getpageyh
n in
1160 let y = y + (truncate
(top
*. float h)) in
1164 let gotopage1 n top
=
1165 let y = getpagey
n in
1170 let invalidate s f =
1175 match state
.geomcmds
with
1176 | ps
, [] when emptystr ps
->
1178 state
.geomcmds
<- s, [];
1181 state
.geomcmds
<- ps
, [s, f];
1183 | ps
, (s'
, _
) :: rest
when s'
= s ->
1184 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1187 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1191 Hashtbl.iter
(fun _ opaque
->
1192 wcmd "freepage %s" (~
> opaque
);
1194 Hashtbl.clear state
.pagemap
;
1198 if not
(Queue.is_empty state
.tilelru
)
1200 Queue.iter
(fun (k
, p
, s) ->
1201 wcmd "freetile %s" (~
> p
);
1202 state
.memused
<- state
.memused
- s;
1203 Hashtbl.remove state
.tilemap k
;
1205 state
.uioh#infochanged Memused
;
1206 Queue.clear state
.tilelru
;
1212 let h = truncate
(float h*.conf
.zoom
) in
1213 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1217 let opendoc path password
=
1219 state
.password
<- password
;
1220 state
.gen
<- state
.gen
+ 1;
1221 state
.docinfo
<- [];
1222 state
.outlines
<- [||];
1225 setaalevel conf
.aalevel
;
1227 if emptystr state
.origin
1231 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1232 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1233 invalidate "reqlayout"
1235 wcmd "reqlayout %d %d %d %s\000"
1236 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1237 (stateh state
.winh
) state
.nameddest
1242 state
.anchor <- getanchor
();
1243 opendoc state
.path state
.password
;
1247 let c = c *. conf
.colorscale
in
1251 let scalecolor2 (r
, g, b) =
1252 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1255 let docolumns = function
1257 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1258 let rec loop pageno
pdimno pdim
y ph pdims
=
1259 if pageno
= state
.pagecount
1262 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1264 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1265 pdimno+1, pdim
, rest
1269 let x = max
0 (((wadjsb state
.winw
- w) / 2) - xoff
) in
1271 (if conf
.presentation
1272 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1273 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1276 a.(pageno
) <- (pdimno, x, y, pdim
);
1277 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1279 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1280 conf
.columns
<- Csingle
a;
1282 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1283 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1284 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1285 let rec fixrow m
= if m
= pageno
then () else
1286 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1289 let y = y + (rowh
- h) / 2 in
1290 a.(m
) <- (pdimno, x, y, pdim
);
1294 if pageno
= state
.pagecount
1295 then fixrow (((pageno
- 1) / columns
) * columns
)
1297 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1299 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1300 pdimno+1, pdim
, rest
1305 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1307 let x = (wadjsb state
.winw
- w) / 2 in
1309 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1310 x, y + ips + rowh
, h
1313 if (pageno
- coverA
) mod columns
= 0
1315 let x = max
0 (wadjsb state
.winw
- state
.w) / 2 in
1317 if conf
.presentation
1319 let ips = calcips
h in
1320 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1322 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1326 else x, y, max rowh
h
1330 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1333 if pageno
= columns
&& conf
.presentation
1335 let ips = calcips rowh
in
1336 for i
= 0 to pred columns
1338 let (pdimno, x, y, pdim
) = a.(i
) in
1339 a.(i
) <- (pdimno, x, y+ips, pdim
)
1345 fixrow (pageno
- columns
);
1350 a.(pageno
) <- (pdimno, x, y, pdim
);
1351 let x = x + w + xoff
*2 + conf
.interpagespace
in
1352 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1354 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1355 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1358 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1359 let rec loop pageno
pdimno pdim
y pdims
=
1360 if pageno
= state
.pagecount
1363 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1365 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1366 pdimno+1, pdim
, rest
1371 let rec loop1 n x y =
1372 if n = c then y else (
1373 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1374 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1377 let y = loop1 0 0 y in
1378 loop (pageno
+1) pdimno pdim
y pdims
1380 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1381 conf
.columns
<- Csplit
(c, a);
1385 docolumns conf
.columns
;
1386 state
.maxy
<- calcheight
();
1387 if state
.reprf
== noreprf
1389 match state
.mode
with
1390 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1391 let y, h = getpageyh pageno
in
1392 let top = (state
.winh
- h) / 2 in
1393 gotoy (max
0 (y - top))
1396 | LinkNav _
-> gotoanchor state
.anchor
1400 state
.reprf
<- noreprf
;
1405 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1406 let firsttime = state
.geomcmds
== firstgeomcmds
in
1407 if not
firsttime && nogeomcmds state
.geomcmds
1408 then state
.anchor <- getanchor
();
1411 let w = wadjsb (truncate
(float w *. conf
.zoom
)) in
1414 setfontsize fstate
.fontsize
;
1415 GlMat.mode `modelview
;
1416 GlMat.load_identity
();
1418 GlMat.mode `projection
;
1419 GlMat.load_identity
();
1420 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1421 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1422 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1427 else float state
.x /. float state
.w
1429 invalidate "geometry"
1433 then state
.x <- truncate
(relx *. float w);
1435 match conf
.columns
with
1437 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1438 | Csplit
(c, _
) -> w * c
1440 wcmd "geometry %d %d %d"
1441 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1446 let len = String.length state
.text in
1447 let x0 = xadjsb 0 in
1450 match state
.mode
with
1451 | Textentry _
| View
| LinkNav _
->
1452 let h, _
, _
= state
.uioh#scrollpw
in
1457 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1458 (x+.w) (float (state
.winh
- hscrollh))
1461 let w = float (wadjsb state
.winw
- 1) in
1462 if state
.progress
>= 0.0 && state
.progress
< 1.0
1464 GlDraw.color
(0.3, 0.3, 0.3);
1465 let w1 = w *. state
.progress
in
1467 GlDraw.color
(0.0, 0.0, 0.0);
1468 rect (float x0+.w1) (float x0+.w-.w1)
1471 GlDraw.color
(0.0, 0.0, 0.0);
1475 GlDraw.color
(1.0, 1.0, 1.0);
1476 drawstring fstate
.fontsize
1477 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1478 (state
.winh
- hscrollh - 5) s;
1481 match state
.mode
with
1482 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1486 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1488 Printf.sprintf
"%s%s_" prefix
text
1494 | LinkNav _
-> state
.text
1499 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1501 let s1 = "(press 'e' to review error messasges)" in
1502 if nonemptystr
s then s ^
" " ^
s1 else s1
1512 let len = Queue.length state
.tilelru
in
1514 match state
.throttle
with
1517 then preloadlayout state
.y
1519 | Some
(layout, _
, _
) ->
1523 if state
.memused
<= conf
.memlimit
1528 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1529 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1530 let (_
, pw, ph
, _
) = getpagedim
n in
1533 && colorspace
= conf
.colorspace
1534 && angle
= conf
.angle
1538 let x = col*conf
.tilew
1539 and y = row*conf
.tileh
in
1540 tilevisible (Lazy.force_val
layout) n x y
1542 then Queue.push lruitem state
.tilelru
1545 wcmd "freetile %s" (~
> p
);
1546 state
.memused
<- state
.memused
- s;
1547 state
.uioh#infochanged Memused
;
1548 Hashtbl.remove state
.tilemap k
;
1556 let logcurrently = function
1557 | Idle
-> dolog
"Idle"
1558 | Loading
(l, gen
) ->
1559 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1560 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1562 "Tiling %d[%d,%d] page=%s cs=%s angle"
1563 l.pageno
col row (~
> pageopaque
)
1564 (CSTE.to_string colorspace
)
1566 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1567 angle gen conf
.angle state
.gen
1569 conf
.tilew conf
.tileh
1576 let r = Str.regexp
" " in
1577 fun s -> Str.bounded_split
r s 2;
1580 let onpagerect pageno
f =
1582 match conf
.columns
with
1583 | Cmulti
(_
, b) -> b
1585 | Csplit
(_
, b) -> b
1587 if pageno
>= 0 && pageno
< Array.length
b
1589 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1593 let gotopagexy1 pageno
x y =
1594 let _,w1,h1
,leftx
= getpagedim pageno
in
1595 let top = y /. (float h1
) in
1596 let left = x /. (float w1) in
1597 let py, w, h = getpageywh pageno
in
1598 let wh = state
.winh
- hscrollh () in
1599 let x = left *. (float w) in
1600 let x = leftx
+ state
.x + truncate
x in
1602 if x < 0 || x >= wadjsb state
.winw
1606 let pdy = truncate
(top *. float h) in
1607 let y'
= py + pdy in
1608 let dy = y'
- state
.y in
1610 if x != state
.x || not
(dy > 0 && dy < wh)
1612 if conf
.presentation
1614 if abs
(py - y'
) > wh
1621 if state
.x != sx || state
.y != sy
1626 let ww = wadjsb state
.winw
in
1628 and qy
= pdy / wh in
1630 and y = py + qy
* wh in
1631 let x = if -x + ww > w1 then -(w1-ww) else x
1632 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1634 if conf
.presentation
1636 if abs
(py - y'
) > wh
1646 gotoy_and_clear_text y;
1648 else gotoy_and_clear_text state
.y;
1651 let gotopagexy pageno
x y =
1652 match state
.mode
with
1653 | Birdseye
_ -> gotopage pageno
0.0
1656 | LinkNav
_ -> gotopagexy1 pageno
x y
1660 (* dolog "%S" cmds; *)
1661 let cl = splitatspace cmds
in
1663 try Scanf.sscanf
s fmt
f
1665 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1668 let addoutline outline
=
1669 match state
.currently
with
1670 | Outlining outlines
->
1671 state
.currently
<- Outlining
(outline
:: outlines
)
1672 | Idle
-> state
.currently
<- Outlining
[outline
]
1675 dolog
"invalid outlining state";
1676 logcurrently state
.currently
1680 state
.uioh#infochanged Pdim
;
1683 | "clearrects" :: [] ->
1684 state
.rects
<- state
.rects1
;
1685 G.postRedisplay "clearrects";
1687 | "continue" :: args
:: [] ->
1688 let n = scan args
"%u" (fun n -> n) in
1689 state
.pagecount
<- n;
1690 begin match state
.currently
with
1692 state
.currently
<- Idle
;
1693 state
.outlines
<- Array.of_list
(List.rev
l)
1699 let cur, cmds
= state
.geomcmds
in
1701 then failwith
"umpossible";
1703 begin match List.rev cmds
with
1705 state
.geomcmds
<- E.s, [];
1706 state
.throttle
<- None
;
1710 state
.geomcmds
<- s, List.rev rest
;
1712 if conf
.maxwait
= None
&& not
!wtmode
1713 then G.postRedisplay "continue";
1715 | "title" :: args
:: [] ->
1719 | "msg" :: args
:: [] ->
1722 | "vmsg" :: args
:: [] ->
1724 then showtext ' ' args
1726 | "emsg" :: args
:: [] ->
1727 Buffer.add_string state
.errmsgs args
;
1728 state
.newerrmsgs
<- true;
1729 G.postRedisplay "error message"
1731 | "progress" :: args
:: [] ->
1732 let progress, text =
1735 f, String.sub args pos
(String.length args
- pos
))
1738 state
.progress <- progress;
1739 G.postRedisplay "progress"
1741 | "firstmatch" :: args
:: [] ->
1742 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1743 scan args
"%u %d %f %f %f %f %f %f %f %f"
1744 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1745 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1747 let xoff = float (xadjsb 0) in
1751 and x3
= x3
+. xoff in
1752 let y = (getpagey
pageno) + truncate
y0 in
1755 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1757 | "match" :: args
:: [] ->
1758 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1759 scan args
"%u %d %f %f %f %f %f %f %f %f"
1760 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1761 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1763 let xoff = float (xadjsb 0) in
1767 and x3
= x3
+. xoff in
1769 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1771 | "page" :: args
:: [] ->
1772 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1773 let pageopaque = ~
< pageopaques in
1774 begin match state
.currently
with
1775 | Loading
(l, gen
) ->
1776 vlog "page %d took %f sec" l.pageno t
;
1777 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1778 begin match state
.throttle
with
1780 let preloadedpages =
1782 then preloadlayout state
.y
1787 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1788 IntSet.empty
preloadedpages
1791 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1792 if not
(IntSet.mem
pageno set)
1794 wcmd "freepage %s" (~
> opaque
);
1800 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1803 state
.currently
<- Idle
;
1806 tilepage l.pageno pageopaque state
.layout;
1808 load preloadedpages;
1809 if pagevisible state
.layout l.pageno
1810 && layoutready state
.layout
1811 then G.postRedisplay "page";
1814 | Some
(layout, _, _) ->
1815 state
.currently
<- Idle
;
1816 tilepage l.pageno pageopaque layout;
1823 dolog
"Inconsistent loading state";
1824 logcurrently state
.currently
;
1828 | "tile" :: args
:: [] ->
1829 let (x, y, opaques
, size
, t
) =
1830 scan args
"%u %u %s %u %f"
1831 (fun x y p size t
-> (x, y, p
, size
, t
))
1833 let opaque = ~
< opaques
in
1834 begin match state
.currently
with
1835 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1836 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1839 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1841 wcmd "freetile %s" (~
> opaque);
1842 state
.currently
<- Idle
;
1846 puttileopaque l col row gen cs angle
opaque size t
;
1847 state
.memused
<- state
.memused
+ size
;
1848 state
.uioh#infochanged Memused
;
1850 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1851 opaque, size
) state
.tilelru
;
1854 match state
.throttle
with
1855 | None
-> state
.layout
1856 | Some
(layout, _, _) -> layout
1859 state
.currently
<- Idle
;
1861 && conf
.colorspace
= cs
1862 && conf
.angle
= angle
1863 && tilevisible layout l.pageno x y
1864 then conttiling l.pageno pageopaque;
1866 begin match state
.throttle
with
1868 preload state
.layout;
1870 && conf
.colorspace
= cs
1871 && conf
.angle
= angle
1872 && tilevisible state
.layout l.pageno x y
1873 && (not
!wtmode || layoutready state
.layout)
1874 then G.postRedisplay "tile nothrottle";
1876 | Some
(layout, y, _) ->
1877 let ready = layoutready layout in
1881 state
.layout <- layout;
1882 state
.throttle
<- None
;
1883 G.postRedisplay "throttle";
1892 dolog
"Inconsistent tiling state";
1893 logcurrently state
.currently
;
1897 | "pdim" :: args
:: [] ->
1898 let (n, w, h, _) as pdim
=
1899 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1902 match conf
.fitmodel
with
1904 | FitPage
| FitProportional
->
1905 match conf
.columns
with
1906 | Csplit
_ -> (n, w, h, 0)
1907 | Csingle
_ | Cmulti
_ -> pdim
1909 state
.uioh#infochanged Pdim
;
1910 state
.pdims
<- pdim :: state
.pdims
1912 | "o" :: args
:: [] ->
1913 let (l, n, t
, h, pos
) =
1914 scan args
"%u %u %d %u %n"
1915 (fun l n t
h pos
-> l, n, t
, h, pos
)
1917 let s = String.sub args pos
(String.length args
- pos
) in
1918 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1920 | "ou" :: args
:: [] ->
1921 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1922 let s = String.sub args pos
len in
1923 let pos2 = pos
+ len + 1 in
1924 let uri = String.sub args
pos2 (String.length args
- pos2) in
1925 addoutline (s, l, Ouri
uri)
1927 | "on" :: args
:: [] ->
1928 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1929 let s = String.sub args pos
(String.length args
- pos
) in
1930 addoutline (s, l, Onone
)
1932 | "a" :: args
:: [] ->
1934 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1936 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1938 | "info" :: args
:: [] ->
1939 state
.docinfo
<- (1, args
) :: state
.docinfo
1941 | "infoend" :: [] ->
1942 state
.uioh#infochanged Docinfo
;
1943 state
.docinfo
<- List.rev state
.docinfo
1946 error
"unknown cmd `%S'" cmds
1951 let action = function
1952 | HCprev
-> cbget cb ~
-1
1953 | HCnext
-> cbget cb
1
1954 | HCfirst
-> cbget cb ~
-(cb
.rc)
1955 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1956 and cancel
() = cb
.rc <- rc
1960 let search pattern forward
=
1961 match conf
.columns
with
1963 showtext '
!'
"searching does not work properly in split columns mode"
1966 if nonemptystr pattern
1969 match state
.layout with
1972 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1974 wcmd "search %d %d %d %d,%s\000"
1975 (btod conf
.icase
) pn py (btod forward
) pattern
;
1978 let intentry text key =
1980 if key >= 32 && key < 127
1986 let text = addchar text c in
1990 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1994 let linknentry text key =
1996 if key >= 32 && key < 127
2002 let text = addchar text c in
2006 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2014 let l = String.length
s in
2015 let rec loop pos
n = if pos
= l then n else
2016 let m = Char.code
s.[pos
] - (if pos
= 0 && l > 1 then 96 else 97) in
2017 loop (pos
+1) (n*26 + m)
2020 let rec loop n = function
2023 match getopaque l.pageno with
2024 | None
-> loop n rest
2026 let m = getlinkcount
opaque in
2029 let under = getlink
opaque n in
2032 else loop (n-m) rest
2034 loop n state
.layout;
2038 let textentry text key =
2039 if key land 0xff00 = 0xff00
2041 else TEcont
(text ^ toutf8
key)
2044 let reqlayout angle fitmodel
=
2045 match state
.throttle
with
2047 if nogeomcmds state
.geomcmds
2048 then state
.anchor <- getanchor
();
2049 conf
.angle
<- angle
mod 360;
2052 match state
.mode
with
2053 | LinkNav
_ -> state
.mode
<- View
2058 conf
.fitmodel
<- fitmodel
;
2059 invalidate "reqlayout"
2061 wcmd "reqlayout %d %d %d"
2062 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2067 let settrim trimmargins trimfuzz
=
2068 if nogeomcmds state
.geomcmds
2069 then state
.anchor <- getanchor
();
2070 conf
.trimmargins
<- trimmargins
;
2071 conf
.trimfuzz
<- trimfuzz
;
2072 let x0, y0, x1, y1 = trimfuzz
in
2073 invalidate "settrim"
2075 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2080 match state
.throttle
with
2082 let zoom = max
0.0001 zoom in
2083 if zoom <> conf
.zoom
2085 state
.prevzoom
<- (conf
.zoom, state
.x);
2087 reshape state
.winw state
.winh
;
2088 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2091 | Some
(layout, y, started
) ->
2093 match conf
.maxwait
with
2097 let dt = now
() -. started
in
2105 let setcolumns mode columns coverA coverB
=
2106 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2110 then showtext '
!'
"split mode doesn't work in bird's eye"
2112 conf
.columns
<- Csplit
(-columns
, E.a);
2120 conf
.columns
<- Csingle
E.a;
2125 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2129 reshape state
.winw state
.winh
;
2132 let resetmstate () =
2133 state
.mstate
<- Mnone
;
2134 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2137 let enterbirdseye () =
2138 let zoom = float conf
.thumbw
/. float state
.winw
in
2139 let birdseyepageno =
2140 let cy = state
.winh
/ 2 in
2144 let rec fold best
= function
2147 let d = cy - (l.pagedispy + l.pagevh/2)
2148 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2149 if abs
d < abs dbest
2156 state
.mode
<- Birdseye
(
2157 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2161 conf
.presentation
<- false;
2162 conf
.interpagespace
<- 10;
2163 conf
.hlinks
<- false;
2164 conf
.fitmodel
<- FitPage
;
2166 conf
.maxwait
<- None
;
2168 match conf
.beyecolumns
with
2171 Cmulti
((c, 0, 0), E.a)
2172 | None
-> Csingle
E.a
2176 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2181 reshape state
.winw state
.winh
;
2184 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2186 conf
.zoom <- c.zoom;
2187 conf
.presentation
<- c.presentation
;
2188 conf
.interpagespace
<- c.interpagespace
;
2189 conf
.maxwait
<- c.maxwait
;
2190 conf
.hlinks
<- c.hlinks
;
2191 conf
.fitmodel
<- c.fitmodel
;
2192 conf
.beyecolumns
<- (
2193 match conf
.columns
with
2194 | Cmulti
((c, _, _), _) -> Some
c
2196 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2199 match c.columns
with
2200 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2201 | Csingle
_ -> Csingle
E.a
2202 | Csplit
(c, _) -> Csplit
(c, E.a)
2206 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2209 reshape state
.winw state
.winh
;
2210 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2214 let togglebirdseye () =
2215 match state
.mode
with
2216 | Birdseye vals
-> leavebirdseye vals
true
2217 | View
-> enterbirdseye ()
2222 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2223 let pageno = max
0 (pageno - incr
) in
2224 let rec loop = function
2225 | [] -> gotopage1 pageno 0
2226 | l :: _ when l.pageno = pageno ->
2227 if l.pagedispy >= 0 && l.pagey = 0
2228 then G.postRedisplay "upbirdseye"
2229 else gotopage1 pageno 0
2230 | _ :: rest
-> loop rest
2234 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2237 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2238 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2239 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2240 let rec loop = function
2242 let y, h = getpageyh
pageno in
2243 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2245 | l :: _ when l.pageno = pageno ->
2246 if l.pagevh != l.pageh
2247 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2248 else G.postRedisplay "downbirdseye"
2249 | _ :: rest
-> loop rest
2255 let boundastep h step
=
2257 then bound step ~
-h 0
2261 let optentry mode
_ key =
2262 let btos b = if b then "on" else "off" in
2263 if key >= 32 && key < 127
2265 let c = Char.chr
key in
2269 try conf
.scrollstep
<- int_of_string
s with exc
->
2270 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2272 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2277 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2278 if state
.autoscroll
<> None
2279 then state
.autoscroll
<- Some conf
.autoscrollstep
2281 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2283 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2288 let n, a, b = multicolumns_of_string
s in
2289 setcolumns mode
n a b;
2291 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2293 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2298 let zoom = float (int_of_string
s) /. 100.0 in
2301 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2303 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2308 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2310 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2311 begin match mode
with
2313 leavebirdseye beye
false;
2320 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2322 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2327 Some
(int_of_string
s)
2329 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2333 | Some angle
-> reqlayout angle conf
.fitmodel
2336 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2339 conf
.icase
<- not conf
.icase
;
2340 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2343 conf
.preload <- not conf
.preload;
2345 TEdone
("preload " ^
(btos conf
.preload))
2348 conf
.verbose
<- not conf
.verbose
;
2349 TEdone
("verbose " ^
(btos conf
.verbose
))
2352 conf
.debug
<- not conf
.debug
;
2353 TEdone
("debug " ^
(btos conf
.debug
))
2356 conf
.maxhfit
<- not conf
.maxhfit
;
2357 state
.maxy
<- calcheight
();
2358 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2361 conf
.crophack
<- not conf
.crophack
;
2362 TEdone
("crophack " ^
btos conf
.crophack
)
2366 match conf
.maxwait
with
2368 conf
.maxwait
<- Some infinity
;
2369 "always wait for page to complete"
2371 conf
.maxwait
<- None
;
2372 "show placeholder if page is not ready"
2377 conf
.underinfo
<- not conf
.underinfo
;
2378 TEdone
("underinfo " ^
btos conf
.underinfo
)
2381 conf
.savebmarks
<- not conf
.savebmarks
;
2382 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2388 match state
.layout with
2393 conf
.interpagespace
<- int_of_string
s;
2394 docolumns conf
.columns
;
2395 state
.maxy
<- calcheight
();
2396 let y = getpagey
pageno in
2399 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2401 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2405 match conf
.fitmodel
with
2406 | FitProportional
-> FitWidth
2407 | FitWidth
| FitPage
-> FitProportional
2409 reqlayout conf
.angle
fm;
2410 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2413 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2414 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2417 conf
.invert
<- not conf
.invert
;
2418 TEdone
("invert colors " ^
btos conf
.invert
)
2422 cbput state
.hists
.sel
s;
2425 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2426 textentry, ondone, true)
2430 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2431 else conf
.pax
<- None
;
2432 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2435 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2441 class type lvsource
= object
2442 method getitemcount
: int
2443 method getitem
: int -> (string * int)
2444 method hasaction
: int -> bool
2452 method getactive
: int
2453 method getfirst
: int
2455 method getminfo
: (int * int) array
2458 class virtual lvsourcebase
= object
2459 val mutable m_active
= 0
2460 val mutable m_first
= 0
2461 val mutable m_pan
= 0
2462 method getactive
= m_active
2463 method getfirst
= m_first
2464 method getpan
= m_pan
2465 method getminfo
: (int * int) array
= E.a
2468 let withoutlastutf8 s =
2469 let len = String.length
s in
2477 let b = Char.code
s.[pos
] in
2478 if b land 0b11000000 = 0b11000000
2483 if Char.code
s.[len-1] land 0x80 = 0
2487 String.sub
s 0 first;
2490 let textentrykeyboard
2491 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2493 if key >= 0xffb0 && key <= 0xffb9
2494 then key - 0xffb0 + 48 else key
2497 state
.mode
<- Textentry
(te
, onleave
);
2500 G.postRedisplay "textentrykeyboard enttext";
2502 let histaction cmd
=
2505 | Some
(action, _) ->
2506 state
.mode
<- Textentry
(
2507 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2509 G.postRedisplay "textentry histaction"
2513 if emptystr
text && cancelonempty
2516 G.postRedisplay "textentrykeyboard after cancel";
2519 let s = withoutlastutf8 text in
2520 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2522 | @enter
| @kpenter
->
2525 G.postRedisplay "textentrykeyboard after confirm"
2527 | @up
| @kpup
-> histaction HCprev
2528 | @down
| @kpdown
-> histaction HCnext
2529 | @home
| @kphome
-> histaction HCfirst
2530 | @jend
| @kpend
-> histaction HClast
2535 begin match opthist
with
2537 | Some
(_, onhistcancel
) -> onhistcancel
()
2541 G.postRedisplay "textentrykeyboard after cancel2"
2544 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2547 | @delete
| @kpdelete
-> ()
2550 && key land 0xff00 != 0xff00 (* keyboard *)
2551 && key land 0xfe00 != 0xfe00 (* xkb *)
2552 && key land 0xfd00 != 0xfd00 (* 3270 *)
2554 begin match onkey
text key with
2558 G.postRedisplay "textentrykeyboard after confirm2";
2561 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2565 G.postRedisplay "textentrykeyboard after cancel3"
2568 state
.mode
<- Textentry
(te
, onleave
);
2569 G.postRedisplay "textentrykeyboard switch";
2573 vlog "unhandled key %s" (Wsi.keyname
key)
2576 let firstof first active
=
2577 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2578 then max
0 (active
- (fstate
.maxrows
/2))
2582 let calcfirst first active
=
2585 let rows = active
- first in
2586 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2590 let scrollph y maxy
=
2591 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2592 let sh = float state
.winh
/. sh in
2593 let sh = max
sh (float conf
.scrollh
) in
2595 let percent = float y /. float maxy
in
2596 let position = (float state
.winh
-. sh) *. percent in
2599 if position +. sh > float state
.winh
2600 then float state
.winh
-. sh
2606 let coe s = (s :> uioh
);;
2608 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2610 val m_pan
= source#getpan
2611 val m_first
= source#getfirst
2612 val m_active
= source#getactive
2614 val m_prev_uioh
= state
.uioh
2616 method private elemunder
y =
2620 let n = y / (fstate
.fontsize
+1) in
2621 if m_first
+ n < source#getitemcount
2623 if source#hasaction
(m_first
+ n)
2624 then Some
(m_first
+ n)
2631 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2632 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2633 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2634 GlDraw.color
(1., 1., 1.);
2635 Gl.enable `texture_2d
;
2636 let fs = fstate
.fontsize
in
2638 let hw = (wadjsb (xadjsb state
.winw
))/3 in
2639 let ww = fstate
.wwidth
in
2640 let tabw = 17.0*.ww in
2641 let itemcount = source#getitemcount
in
2642 let minfo = source#getminfo
in
2645 then float (xadjsb 0), float (state
.winw
- 1)
2646 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2649 if (row - m_first
) > fstate
.maxrows
2652 if row >= 0 && row < itemcount
2654 let (s, level
) = source#getitem
row in
2655 let y = (row - m_first
) * nfs in
2657 (if conf
.leftscroll
then float (xadjsb 0) else 5.0)
2658 +. (float (level
+ m_pan
)) *. ww in
2661 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2665 Gl.disable `texture_2d
;
2666 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2667 GlDraw.color
(1., 1., 1.) ~
alpha;
2668 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2669 Gl.enable `texture_2d
;
2672 if zebra
&& row land 1 = 1
2676 GlDraw.color
(c,c,c);
2677 let drawtabularstring s =
2679 let x'
= truncate
(x0 +. x) in
2680 let pos = nindex
s '
\000'
in
2682 then drawstring1 fs x'
(y+nfs) s
2684 let s1 = String.sub
s 0 pos
2685 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2690 let s'
= withoutlastutf8 s in
2691 let s = s' ^
"@Uellipsis" in
2692 let w = measurestr
fs s in
2693 if float x'
+. w +. ww < float (hw + x'
)
2698 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2702 ignore
(drawstring1 fs x'
(y+nfs) s1);
2703 drawstring1 fs (hw + x'
) (y+nfs) s2
2707 let x = if helpmode
&& row > 0 then x +. ww else x in
2708 let tabpos = nindex
s '
\t'
in
2711 let len = String.length
s - tabpos - 1 in
2712 let s1 = String.sub
s 0 tabpos
2713 and s2
= String.sub
s (tabpos + 1) len in
2714 let nx = drawstr x s1 in
2716 let x = x +. (max
tabw sw) in
2719 let len = String.length
s - 2 in
2720 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2722 let s = String.sub
s 2 len in
2723 let x = if not helpmode
then x +. ww else x in
2724 GlDraw.color
(1.2, 1.2, 1.2);
2725 let vinc = drawstring1 (fs+fs/4)
2726 (truncate
(x -. ww)) (y+nfs) s in
2727 GlDraw.color
(1., 1., 1.);
2728 vinc +. (float fs *. 0.8)
2734 ignore
(drawtabularstring s);
2740 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2742 if (row - m_first
) > fstate
.maxrows
2745 if row >= 0 && row < itemcount
2747 let (s, level
) = source#getitem
row in
2748 let pos0 = nindex
s '
\000'
in
2749 let y = (row - m_first
) * nfs in
2750 let x = float (level
+ m_pan
) *. ww in
2751 let (first, last
) = minfo.(row) in
2753 if pos0 > 0 && first > pos0
2754 then String.sub
s (pos0+1) (first-pos0-1)
2755 else String.sub
s 0 first
2757 let suffix = String.sub
s first (last
- first) in
2758 let w1 = measurestr fstate
.fontsize
prefix in
2759 let w2 = measurestr fstate
.fontsize
suffix in
2760 let x = x +. if conf
.leftscroll
then float (xadjsb 5) else 5.0 in
2761 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2763 and y0 = float (y+2) in
2765 and y1 = float (y+fs+3) in
2766 filledrect x0 y0 x1 y1;
2771 Gl.disable `texture_2d
;
2772 if Array.length
minfo > 0 then loop m_first
;
2775 method updownlevel incr
=
2776 let len = source#getitemcount
in
2778 if m_active
>= 0 && m_active
< len
2779 then snd
(source#getitem m_active
)
2783 if i
= len then i
-1 else if i
= -1 then 0 else
2784 let _, l = source#getitem i
in
2785 if l != curlevel then i
else flow (i
+incr
)
2787 let active = flow m_active
in
2788 let first = calcfirst m_first
active in
2789 G.postRedisplay "outline updownlevel";
2790 {< m_active
= active; m_first
= first >}
2792 method private key1
key mask
=
2793 let set1 active first qsearch
=
2794 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2796 let search active pattern incr
=
2797 let active = if active = -1 then m_first
else active in
2800 if n >= 0 && n < source#getitemcount
2802 let s, _ = source#getitem
n in
2804 (try ignore
(Str.search_forward
re s 0); true
2805 with Not_found
-> false)
2807 else loop (n + incr
)
2814 let re = Str.regexp_case_fold pattern
in
2820 let itemcount = source#getitemcount
in
2821 let find start incr
=
2823 if i
= -1 || i
= itemcount
2826 if source#hasaction i
2828 else find (i
+ incr
)
2833 let set active first =
2834 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2836 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2839 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2841 let incr1 = if incr
> 0 then 1 else -1 in
2842 if isvisible m_first m_active
2845 let next = m_active
+ incr
in
2847 if next < 0 || next >= itemcount
2849 else find next incr1
2851 if abs
(m_active
- next) > fstate
.maxrows
2857 let first = m_first
+ incr
in
2858 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2860 let next = m_active
+ incr
in
2861 let next = bound
next 0 (itemcount - 1) in
2868 if isvisible first next
2875 let first = min
next m_first
in
2877 if abs
(next - first) > fstate
.maxrows
2883 let first = m_first
+ incr
in
2884 let first = bound
first 0 (itemcount - 1) in
2886 let next = m_active
+ incr
in
2887 let next = bound
next 0 (itemcount - 1) in
2888 let next = find next incr1 in
2890 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2892 let active = if m_active
= -1 then next else m_active
in
2897 if isvisible first active
2903 G.postRedisplay "listview navigate";
2907 | (@r|@s) when Wsi.withctrl mask
->
2908 let incr = if key = @r then -1 else 1 in
2910 match search (m_active
+ incr) m_qsearch
incr with
2912 state
.text <- m_qsearch ^
" [not found]";
2915 state
.text <- m_qsearch
;
2916 active, firstof m_first
active
2918 G.postRedisplay "listview ctrl-r/s";
2919 set1 active first m_qsearch
;
2921 | @insert
when Wsi.withctrl mask
->
2922 if m_active
>= 0 && m_active
< source#getitemcount
2924 let s, _ = source#getitem m_active
in
2930 if emptystr m_qsearch
2933 let qsearch = withoutlastutf8 m_qsearch
in
2937 G.postRedisplay "listview empty qsearch";
2938 set1 m_active m_first
E.s;
2942 match search m_active
qsearch ~
-1 with
2944 state
.text <- qsearch ^
" [not found]";
2947 state
.text <- qsearch;
2948 active, firstof m_first
active
2950 G.postRedisplay "listview backspace qsearch";
2951 set1 active first qsearch
2954 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2955 let pattern = m_qsearch ^ toutf8
key in
2957 match search m_active
pattern 1 with
2959 state
.text <- pattern ^
" [not found]";
2962 state
.text <- pattern;
2963 active, firstof m_first
active
2965 G.postRedisplay "listview qsearch add";
2966 set1 active first pattern;
2970 if emptystr m_qsearch
2972 G.postRedisplay "list view escape";
2975 source#exit ~uioh
:(coe self
)
2976 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2978 | None
-> m_prev_uioh
2983 G.postRedisplay "list view kill qsearch";
2984 coe {< m_qsearch
= E.s >}
2987 | @enter
| @kpenter
->
2989 let self = {< m_qsearch
= E.s >} in
2991 G.postRedisplay "listview enter";
2992 if m_active
>= 0 && m_active
< source#getitemcount
2994 source#exit ~uioh
:(coe self) ~cancel
:false
2995 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2998 source#exit ~uioh
:(coe self) ~cancel
:true
2999 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3002 begin match opt with
3003 | None
-> m_prev_uioh
3007 | @delete
| @kpdelete
->
3010 | @up
| @kpup
-> navigate ~
-1
3011 | @down
| @kpdown
-> navigate 1
3012 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3013 | @next | @kpnext
-> navigate fstate
.maxrows
3015 | @right
| @kpright
->
3017 G.postRedisplay "listview right";
3018 coe {< m_pan
= m_pan
- 1 >}
3020 | @left | @kpleft
->
3022 G.postRedisplay "listview left";
3023 coe {< m_pan
= m_pan
+ 1 >}
3025 | @home
| @kphome
->
3026 let active = find 0 1 in
3027 G.postRedisplay "listview home";
3031 let first = max
0 (itemcount - fstate
.maxrows
) in
3032 let active = find (itemcount - 1) ~
-1 in
3033 G.postRedisplay "listview end";
3036 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3040 dolog
"listview unknown key %#x" key; coe self
3042 method key key mask
=
3043 match state
.mode
with
3044 | Textentry te
-> textentrykeyboard key mask te
; coe self
3047 | LinkNav
_ -> self#key1
key mask
3049 method button button down
x y _ =
3052 | 1 when x > state
.winw
- conf
.scrollbw
->
3053 G.postRedisplay "listview scroll";
3056 let _, position, sh = self#
scrollph in
3057 if y > truncate
position && y < truncate
(position +. sh)
3059 state
.mstate
<- Mscrolly
;
3063 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3064 let first = truncate
(s *. float source#getitemcount
) in
3065 let first = min source#getitemcount
first in
3066 Some
(coe {< m_first
= first; m_active
= first >})
3068 state
.mstate
<- Mnone
;
3071 | 1 when not down
->
3072 begin match self#elemunder
y with
3074 G.postRedisplay "listview click";
3075 source#exit ~uioh
:(coe {< m_active
= n >})
3076 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3080 | n when (n == 4 || n == 5) && not down
->
3081 let len = source#getitemcount
in
3083 if n = 5 && m_first
+ fstate
.maxrows
>= len
3087 let first = m_first
+ (if n == 4 then -1 else 1) in
3088 bound
first 0 (len - 1)
3090 G.postRedisplay "listview wheel";
3091 Some
(coe {< m_first
= first >})
3092 | n when (n = 6 || n = 7) && not down
->
3093 let inc = if n = 7 then -1 else 1 in
3094 G.postRedisplay "listview hwheel";
3095 Some
(coe {< m_pan
= m_pan
+ inc >})
3100 | None
-> m_prev_uioh
3103 method multiclick
_ x y = self#button
1 true x y
3106 match state
.mstate
with
3108 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3109 let first = truncate
(s *. float source#getitemcount
) in
3110 let first = min source#getitemcount
first in
3111 G.postRedisplay "listview motion";
3112 coe {< m_first
= first; m_active
= first >}
3120 method pmotion
x y =
3121 if x < state
.winw
- conf
.scrollbw
3124 match self#elemunder
y with
3125 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3126 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3130 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3135 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3139 method infochanged
_ = ()
3141 method scrollpw
= (0, 0.0, 0.0)
3143 let nfs = fstate
.fontsize
+ 1 in
3144 let y = m_first
* nfs in
3145 let itemcount = source#getitemcount
in
3146 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3147 let maxy = maxi * nfs in
3148 let p, h = scrollph y maxy in
3151 method modehash
= modehash
3152 method eformsgs
= false
3155 class outlinelistview ~zebra ~source
=
3156 let settext autonarrow
s =
3159 let ss = source#statestr
in
3163 else "{" ^
ss ^
"} [" ^
s ^
"]"
3164 else state
.text <- s
3170 ~source
:(source
:> lvsource
)
3172 ~modehash
:(findkeyhash conf
"outline")
3175 val m_autonarrow
= false
3177 method! key key mask
=
3179 if emptystr state
.text
3181 else fstate
.maxrows - 2
3183 let calcfirst first active =
3186 let rows = active - first in
3187 if rows > maxrows then active - maxrows else first
3191 let active = m_active
+ incr in
3192 let active = bound
active 0 (source#getitemcount
- 1) in
3193 let first = calcfirst m_first
active in
3194 G.postRedisplay "outline navigate";
3195 coe {< m_active
= active; m_first
= first >}
3197 let navscroll first =
3199 let dist = m_active
- first in
3205 else first + maxrows
3208 G.postRedisplay "outline navscroll";
3209 coe {< m_first
= first; m_active
= active >}
3211 let ctrl = Wsi.withctrl mask
in
3216 then (source#denarrow
; E.s)
3218 let pattern = source#renarrow
in
3219 if nonemptystr m_qsearch
3220 then (source#narrow m_qsearch
; m_qsearch
)
3224 settext (not m_autonarrow
) text;
3225 G.postRedisplay "toggle auto narrowing";
3226 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3228 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3230 G.postRedisplay "toggle auto narrowing";
3231 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3234 source#narrow m_qsearch
;
3236 then source#add_narrow_pattern m_qsearch
;
3237 G.postRedisplay "outline ctrl-n";
3238 coe {< m_first
= 0; m_active
= 0 >}
3241 let active = source#calcactive
(getanchor
()) in
3242 let first = firstof m_first
active in
3243 G.postRedisplay "outline ctrl-s";
3244 coe {< m_first
= first; m_active
= active >}
3247 G.postRedisplay "outline ctrl-u";
3248 if m_autonarrow
&& nonemptystr m_qsearch
3250 ignore
(source#renarrow
);
3251 settext m_autonarrow
E.s;
3252 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3255 source#del_narrow_pattern
;
3256 let pattern = source#renarrow
in
3258 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3260 settext m_autonarrow
text;
3261 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3265 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3266 G.postRedisplay "outline ctrl-l";
3267 coe {< m_first
= first >}
3269 | @tab
when m_autonarrow
->
3270 if nonemptystr m_qsearch
3272 G.postRedisplay "outline list view tab";
3273 source#add_narrow_pattern m_qsearch
;
3275 coe {< m_qsearch
= E.s >}
3279 | @escape
when m_autonarrow
->
3280 if nonemptystr m_qsearch
3281 then source#add_narrow_pattern m_qsearch
;
3284 | @enter
| @kpenter
when m_autonarrow
->
3285 if nonemptystr m_qsearch
3286 then source#add_narrow_pattern m_qsearch
;
3289 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3290 let pattern = m_qsearch ^ toutf8
key in
3291 G.postRedisplay "outlinelistview autonarrow add";
3292 source#narrow
pattern;
3293 settext true pattern;
3294 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3296 | key when m_autonarrow
&& key = @backspace
->
3297 if emptystr m_qsearch
3300 let pattern = withoutlastutf8 m_qsearch
in
3301 G.postRedisplay "outlinelistview autonarrow backspace";
3302 ignore
(source#renarrow
);
3303 source#narrow
pattern;
3304 settext true pattern;
3305 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3307 | @delete
| @kpdelete
->
3308 source#remove m_active
;
3309 G.postRedisplay "outline delete";
3310 let active = max
0 (m_active
-1) in
3311 coe {< m_first
= firstof m_first
active;
3312 m_active
= active >}
3314 | @up
| @kpup
when ctrl ->
3315 navscroll (max
0 (m_first
- 1))
3317 | @down
| @kpdown
when ctrl ->
3318 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3320 | @up
| @kpup
-> navigate ~
-1
3321 | @down
| @kpdown
-> navigate 1
3322 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3323 | @next | @kpnext
-> navigate fstate
.maxrows
3325 | @right
| @kpright
->
3329 G.postRedisplay "outline ctrl right";
3330 {< m_pan
= m_pan
+ 1 >}
3332 else self#updownlevel
1
3336 | @left | @kpleft
->
3340 G.postRedisplay "outline ctrl left";
3341 {< m_pan
= m_pan
- 1 >}
3343 else self#updownlevel ~
-1
3347 | @home
| @kphome
->
3348 G.postRedisplay "outline home";
3349 coe {< m_first
= 0; m_active
= 0 >}
3352 let active = source#getitemcount
- 1 in
3353 let first = max
0 (active - fstate
.maxrows) in
3354 G.postRedisplay "outline end";
3355 coe {< m_active
= active; m_first
= first >}
3357 | _ -> super#
key key mask
3360 let gotounder under =
3361 let getpath filename
=
3363 if nonemptystr filename
3365 if Filename.is_relative filename
3367 let dir = Filename.dirname state
.path in
3369 if Filename.is_implicit
dir
3370 then Filename.concat
(Sys.getcwd
()) dir
3373 Filename.concat
dir filename
3377 if Sys.file_exists
path
3382 | Ulinkgoto
(pageno, top) ->
3386 gotopage1 pageno top;
3392 | Uremote
(filename
, pageno) ->
3393 let path = getpath filename
in
3398 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
3399 try popen
command []
3401 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
3404 let anchor = getanchor
() in
3405 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3406 state
.origin
<- E.s;
3407 state
.anchor <- (pageno, 0.0, 0.0);
3408 state
.ranchors
<- ranchor :: state
.ranchors
;
3411 else showtext '
!'
("Could not find " ^ filename
)
3413 | Uremotedest
(filename
, destname
) ->
3414 let path = getpath filename
in
3419 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
3420 try popen
command []
3423 "failed to execute `%s': %s\n" command (exntos exn
);
3426 let anchor = getanchor
() in
3427 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3428 state
.origin
<- E.s;
3429 state
.nameddest
<- destname
;
3430 state
.ranchors
<- ranchor :: state
.ranchors
;
3433 else showtext '
!'
("Could not find " ^ filename
)
3435 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
3438 let gotohist (path, (c, bookmarks
, x, anchor)) =
3439 Config.save
leavebirdseye;
3440 state
.anchor <- anchor;
3442 state
.bookmarks
<- bookmarks
;
3443 state
.origin
<- E.s;
3445 let x0, y0, x1, y1 = conf
.trimfuzz
in
3446 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3450 let gotooutline (_, _, kind
) =
3454 let (pageno, y, _) = anchor in
3456 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3460 | Ouri
uri -> gotounder (Ulinkuri
uri)
3461 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3462 | Oremote remote
-> gotounder (Uremote remote
)
3463 | Ohistory hist
-> gotohist hist
3464 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3468 let genhistoutlines =
3469 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3471 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3472 | `
path -> compare p2 p1
3473 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3475 let e1 = emptystr c1
.title
3476 and e2
= emptystr c2
.title
in
3478 then compare
(Filename.basename p2
) (Filename.basename p1
)
3481 else compare c1
.title c2
.title
3483 let showfullpath = ref false in
3486 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3487 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3489 let list = ref [] in
3490 if Config.gethist
list
3494 (fun accu (path, c, b, x, a) ->
3495 let hist = (path, (c, b, x, a)) in
3496 let s = if !showfullpath then path else Filename.basename
path in
3497 let base = mbtoutf8
s in
3498 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3500 [ setorty "Sort by time of last visit" `lastvisit
;
3501 setorty "Sort by file name" `file
;
3502 setorty "Sort by path" `
path;
3503 setorty "Sort by title" `title
;
3504 (if !showfullpath then "@Uradical "
3505 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3506 showfullpath := not
!showfullpath; reeenterhist := true)
3507 ] (List.sort
(order orderty
) !list)
3513 let outlinesource sourcetype
=
3515 inherit lvsourcebase
3516 val mutable m_items
= E.a
3517 val mutable m_minfo
= E.a
3518 val mutable m_orig_items
= E.a
3519 val mutable m_orig_minfo
= E.a
3520 val mutable m_narrow_patterns
= []
3521 val mutable m_hadremovals
= false
3522 val mutable m_gen
= -1
3524 method getitemcount
=
3525 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3528 if n == Array.length m_items
&& m_hadremovals
3530 ("[Confirm removal]", 0)
3532 let s, n, _ = m_items
.(n) in
3535 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3536 ignore
(uioh
, first);
3537 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3539 if m_narrow_patterns
= []
3540 then m_orig_items
, m_orig_minfo
3541 else m_items
, m_minfo
3545 if not
confrimremoval
3547 gotooutline m_items
.(active);
3552 state
.bookmarks
<- Array.to_list m_items
;
3553 m_orig_items
<- m_items
;
3554 m_orig_minfo
<- m_minfo
;
3564 method hasaction
_ = true
3567 if Array.length m_items
!= Array.length m_orig_items
3570 match m_narrow_patterns
with
3572 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3574 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3578 match m_narrow_patterns
with
3581 | head
:: _ -> "@Uellipsis" ^ head
3583 method narrow
pattern =
3584 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3588 let rec loop accu minfo n =
3591 m_items
<- Array.of_list
accu;
3592 m_minfo
<- Array.of_list
minfo;
3595 let (s, _, t
) as o = m_items
.(n) in
3598 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3599 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3600 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3602 try Str.search_forward
re s 0
3603 with Not_found
-> -1
3606 then o :: accu, (first, Str.match_end
()) :: minfo
3609 loop accu minfo (n-1)
3611 loop [] [] (Array.length m_items
- 1)
3613 method! getminfo
= m_minfo
3617 match sourcetype
with
3618 | `bookmarks
-> Array.of_list state
.bookmarks
3619 | `outlines
-> state
.outlines
3620 | `history
-> genhistoutlines !Config.historder
3622 m_minfo
<- m_orig_minfo
;
3623 m_items
<- m_orig_items
3626 if sourcetype
= `bookmarks
3628 if m >= 0 && m < Array.length m_items
3630 m_hadremovals
<- true;
3631 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3632 let n = if n >= m then n+1 else n in
3637 method add_narrow_pattern
pattern =
3638 m_narrow_patterns
<- pattern :: m_narrow_patterns
3640 method del_narrow_pattern
=
3641 match m_narrow_patterns
with
3642 | _ :: rest
-> m_narrow_patterns
<- rest
3647 match m_narrow_patterns
with
3648 | pattern :: [] -> self#narrow
pattern; pattern
3650 List.fold_left
(fun accu pattern ->
3651 self#narrow
pattern;
3652 pattern ^
"@Uellipsis" ^
accu) E.s list
3654 method calcactive
anchor =
3655 let rely = getanchory anchor in
3656 let rec loop n best bestd
=
3657 if n = Array.length m_items
3660 let _, _, kind
= m_items
.(n) in
3663 let orely = getanchory anchor in
3664 let d = abs
(orely - rely) in
3667 else loop (n+1) best bestd
3668 | Onone
| Oremote
_ | Olaunch
_
3669 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3670 loop (n+1) best bestd
3674 method reset
anchor items =
3675 m_hadremovals
<- false;
3676 if state
.gen
!= m_gen
3678 m_orig_items
<- items;
3680 m_narrow_patterns
<- [];
3682 m_orig_minfo
<- E.a;
3686 if items != m_orig_items
3688 m_orig_items
<- items;
3689 if m_narrow_patterns
== []
3690 then m_items
<- items;
3693 let active = self#calcactive
anchor in
3695 m_first
<- firstof m_first
active
3699 let enterselector sourcetype
=
3701 let source = outlinesource sourcetype
in
3704 match sourcetype
with
3705 | `bookmarks
-> Array.of_list state
.bookmarks
3706 | `
outlines -> state
.outlines
3707 | `history
-> genhistoutlines !Config.historder
3709 if Array.length
outlines = 0
3711 showtext ' ' errmsg
;
3714 state
.text <- source#greetmsg
;
3715 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3716 let anchor = getanchor
() in
3717 source#reset
anchor outlines;
3719 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3720 G.postRedisplay "enter selector";
3724 let enteroutlinemode =
3725 let f = enterselector `
outlines in
3726 fun () -> f "Document has no outline";
3729 let enterbookmarkmode =
3730 let f = enterselector `bookmarks
in
3731 fun () -> f "Document has no bookmarks (yet)";
3734 let enterhistmode () = enterselector `history
"No history (yet)";;
3736 let makecheckers () =
3737 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3739 converted by Issac Trotts. July 25, 2002 *)
3740 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3741 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3742 let id = GlTex.gen_texture
() in
3743 GlTex.bind_texture ~target
:`texture_2d
id;
3744 GlPix.store
(`unpack_alignment
1);
3745 GlTex.image2d
image;
3746 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3747 [ `mag_filter `nearest
; `min_filter `nearest
];
3751 let setcheckers enabled
=
3752 match state
.checkerstexid
with
3754 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3756 | Some checkerstexid
->
3759 GlTex.delete_texture checkerstexid
;
3760 state
.checkerstexid
<- None
;
3764 let describe_location () =
3765 let fn = page_of_y state
.y in
3766 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3767 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3771 else (100. *. (float state
.y /. float maxy))
3775 Printf.sprintf
"page %d of %d [%.2f%%]"
3776 (fn+1) state
.pagecount
percent
3779 "pages %d-%d of %d [%.2f%%]"
3780 (fn+1) (ln+1) state
.pagecount
percent
3783 let setpresentationmode v
=
3784 let n = page_of_y state
.y in
3785 state
.anchor <- (n, 0.0, 1.0);
3786 conf
.presentation
<- v
;
3787 if conf
.fitmodel
= FitPage
3788 then reqlayout conf
.angle conf
.fitmodel
;
3793 let btos b = if b then "@Uradical" else E.s in
3794 let showextended = ref false in
3795 let leave mode
_ = state
.mode
<- mode
in
3798 val mutable m_first_time
= true
3799 val mutable m_l
= []
3800 val mutable m_a
= E.a
3801 val mutable m_prev_uioh
= nouioh
3802 val mutable m_prev_mode
= View
3804 inherit lvsourcebase
3806 method reset prev_mode prev_uioh
=
3807 m_a
<- Array.of_list
(List.rev m_l
);
3809 m_prev_mode
<- prev_mode
;
3810 m_prev_uioh
<- prev_uioh
;
3814 if n >= Array.length m_a
3818 | _, _, _, Action
_ -> m_active
<- n
3819 | _, _, _, Noaction
-> loop (n+1)
3822 m_first_time
<- false;
3825 method int name get
set =
3827 (name
, `
int get
, 1, Action
(
3830 try set (int_of_string
s)
3832 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3836 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3837 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3841 method int_with_suffix name get
set =
3843 (name
, `intws get
, 1, Action
(
3846 try set (int_of_string_with_suffix
s)
3848 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3853 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3855 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3859 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3861 (name
, `
bool (btos, get
), offset
, Action
(
3868 method color name get
set =
3870 (name
, `color get
, 1, Action
(
3872 let invalid = (nan
, nan
, nan
) in
3875 try color_of_string
s
3877 state
.text <- Printf.sprintf
"bad color `%s': %s"
3884 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3885 state
.text <- color_to_string
(get
());
3886 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3890 method string name get
set =
3892 (name
, `
string get
, 1, Action
(
3894 let ondone s = set s in
3895 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3896 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3900 method colorspace name get
set =
3902 (name
, `
string get
, 1, Action
(
3906 inherit lvsourcebase
3909 m_active
<- CSTE.to_int conf
.colorspace
;
3912 method getitemcount
=
3913 Array.length
CSTE.names
3916 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3917 ignore
(uioh
, first, pan
);
3918 if not cancel
then set active;
3920 method hasaction
_ = true
3924 let modehash = findkeyhash conf
"info" in
3925 coe (new listview ~zebra
:false ~helpmode
:false
3926 ~
source ~trusted
:true ~
modehash)
3929 method paxmark name get
set =
3931 (name
, `
string get
, 1, Action
(
3935 inherit lvsourcebase
3938 m_active
<- MTE.to_int conf
.paxmark
;
3941 method getitemcount
= Array.length
MTE.names
3942 method getitem
n = (MTE.names
.(n), 0)
3943 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3944 ignore
(uioh
, first, pan
);
3945 if not cancel
then set active;
3947 method hasaction
_ = true
3951 let modehash = findkeyhash conf
"info" in
3952 coe (new listview ~zebra
:false ~helpmode
:false
3953 ~
source ~trusted
:true ~
modehash)
3956 method fitmodel name get
set =
3958 (name
, `
string get
, 1, Action
(
3962 inherit lvsourcebase
3965 m_active
<- FMTE.to_int conf
.fitmodel
;
3968 method getitemcount
= Array.length
FMTE.names
3969 method getitem
n = (FMTE.names
.(n), 0)
3970 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3971 ignore
(uioh
, first, pan
);
3972 if not cancel
then set active;
3974 method hasaction
_ = true
3978 let modehash = findkeyhash conf
"info" in
3979 coe (new listview ~zebra
:false ~helpmode
:false
3980 ~
source ~trusted
:true ~
modehash)
3983 method caption
s offset
=
3984 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3986 method caption2
s f offset
=
3987 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3989 method getitemcount
= Array.length m_a
3992 let tostr = function
3993 | `
int f -> string_of_int
(f ())
3994 | `intws
f -> string_with_suffix_of_int
(f ())
3996 | `color
f -> color_to_string
(f ())
3997 | `
bool (btos, f) -> btos (f ())
4000 let name, t
, offset
, _ = m_a
.(n) in
4001 ((let s = tostr t
in
4003 then Printf.sprintf
"%s\t%s" name s
4007 method exit ~uioh ~cancel ~
active ~
first ~pan
=
4012 match m_a
.(active) with
4013 | _, _, _, Action
f -> f uioh
4014 | _, _, _, Noaction
-> uioh
4025 method hasaction
n =
4027 | _, _, _, Action
_ -> true
4028 | _, _, _, Noaction
-> false
4031 let rec fillsrc prevmode prevuioh
=
4032 let sep () = src#caption
E.s 0 in
4033 let colorp name get
set =
4035 (fun () -> color_to_string
(get
()))
4038 let c = color_of_string
v in
4041 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
4044 let oldmode = state
.mode
in
4045 let birdseye = isbirdseye state
.mode
in
4047 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4049 src#
bool "presentation mode"
4050 (fun () -> conf
.presentation
)
4051 (fun v -> setpresentationmode v);
4053 src#
bool "ignore case in searches"
4054 (fun () -> conf
.icase
)
4055 (fun v -> conf
.icase
<- v);
4058 (fun () -> conf
.preload)
4059 (fun v -> conf
.preload <- v);
4061 src#
bool "highlight links"
4062 (fun () -> conf
.hlinks
)
4063 (fun v -> conf
.hlinks
<- v);
4065 src#
bool "under info"
4066 (fun () -> conf
.underinfo
)
4067 (fun v -> conf
.underinfo
<- v);
4069 src#
bool "persistent bookmarks"
4070 (fun () -> conf
.savebmarks
)
4071 (fun v -> conf
.savebmarks
<- v);
4073 src#fitmodel
"fit model"
4074 (fun () -> FMTE.to_string conf
.fitmodel
)
4075 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4077 src#
bool "trim margins"
4078 (fun () -> conf
.trimmargins
)
4079 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4081 src#
bool "persistent location"
4082 (fun () -> conf
.jumpback
)
4083 (fun v -> conf
.jumpback
<- v);
4086 src#
int "inter-page space"
4087 (fun () -> conf
.interpagespace
)
4089 conf
.interpagespace
<- n;
4090 docolumns conf
.columns
;
4092 match state
.layout with
4097 state
.maxy <- calcheight
();
4098 let y = getpagey
pageno in
4103 (fun () -> conf
.pagebias
)
4104 (fun v -> conf
.pagebias
<- v);
4106 src#
int "scroll step"
4107 (fun () -> conf
.scrollstep
)
4108 (fun n -> conf
.scrollstep
<- n);
4110 src#
int "horizontal scroll step"
4111 (fun () -> conf
.hscrollstep
)
4112 (fun v -> conf
.hscrollstep
<- v);
4114 src#
int "auto scroll step"
4116 match state
.autoscroll
with
4118 | _ -> conf
.autoscrollstep
)
4120 let n = boundastep state
.winh
n in
4121 if state
.autoscroll
<> None
4122 then state
.autoscroll
<- Some
n;
4123 conf
.autoscrollstep
<- n);
4126 (fun () -> truncate
(conf
.zoom *. 100.))
4127 (fun v -> setzoom ((float v) /. 100.));
4130 (fun () -> conf
.angle
)
4131 (fun v -> reqlayout v conf
.fitmodel
);
4133 src#
int "scroll bar width"
4134 (fun () -> conf
.scrollbw
)
4137 reshape state
.winw state
.winh
;
4140 src#
int "scroll handle height"
4141 (fun () -> conf
.scrollh
)
4142 (fun v -> conf
.scrollh
<- v;);
4144 src#
int "thumbnail width"
4145 (fun () -> conf
.thumbw
)
4147 conf
.thumbw
<- min
4096 v;
4150 leavebirdseye beye
false;
4157 let mode = state
.mode in
4158 src#
string "columns"
4160 match conf
.columns
with
4162 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4163 | Csplit
(count
, _) -> "-" ^ string_of_int count
4166 let n, a, b = multicolumns_of_string
v in
4167 setcolumns mode n a b);
4170 src#caption
"Pixmap cache" 0;
4171 src#int_with_suffix
"size (advisory)"
4172 (fun () -> conf
.memlimit
)
4173 (fun v -> conf
.memlimit
<- v);
4176 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4177 (string_with_suffix_of_int state
.memused
)
4178 (Hashtbl.length state
.tilemap
)) 1;
4181 src#caption
"Layout" 0;
4182 src#caption2
"Dimension"
4184 Printf.sprintf
"%dx%d (virtual %dx%d)"
4185 state
.winw state
.winh
4190 src#caption2
"Position" (fun () ->
4191 Printf.sprintf
"%dx%d" state
.x state
.y
4194 src#caption2
"Position" (fun () -> describe_location ()) 1
4198 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4199 "Save these parameters as global defaults at exit"
4200 (fun () -> conf
.bedefault
)
4201 (fun v -> conf
.bedefault
<- v)
4205 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4206 src#
bool ~offset
:0 ~
btos "Extended parameters"
4207 (fun () -> !showextended)
4208 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4212 (fun () -> conf
.checkers
)
4213 (fun v -> conf
.checkers
<- v; setcheckers v);
4214 src#
bool "update cursor"
4215 (fun () -> conf
.updatecurs
)
4216 (fun v -> conf
.updatecurs
<- v);
4217 src#
bool "scroll-bar on the left"
4218 (fun () -> conf
.leftscroll
)
4219 (fun v -> conf
.leftscroll
<- v);
4221 (fun () -> conf
.verbose
)
4222 (fun v -> conf
.verbose
<- v);
4223 src#
bool "invert colors"
4224 (fun () -> conf
.invert
)
4225 (fun v -> conf
.invert
<- v);
4227 (fun () -> conf
.maxhfit
)
4228 (fun v -> conf
.maxhfit
<- v);
4229 src#
bool "redirect stderr"
4230 (fun () -> conf
.redirectstderr)
4231 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4233 (fun () -> conf
.pax
!= None
)
4236 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4237 else conf
.pax
<- None
);
4238 src#
string "uri launcher"
4239 (fun () -> conf
.urilauncher
)
4240 (fun v -> conf
.urilauncher
<- v);
4241 src#
string "path launcher"
4242 (fun () -> conf
.pathlauncher
)
4243 (fun v -> conf
.pathlauncher
<- v);
4244 src#
string "tile size"
4245 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4248 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4249 conf
.tilew
<- max
64 w;
4250 conf
.tileh
<- max
64 h;
4253 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4256 src#
int "texture count"
4257 (fun () -> conf
.texcount
)
4260 then conf
.texcount
<- v
4261 else showtext '
!'
" Failed to set texture count please retry later"
4263 src#
int "slice height"
4264 (fun () -> conf
.sliceheight
)
4266 conf
.sliceheight
<- v;
4267 wcmd "sliceh %d" conf
.sliceheight
;
4269 src#
int "anti-aliasing level"
4270 (fun () -> conf
.aalevel
)
4272 conf
.aalevel
<- bound
v 0 8;
4273 state
.anchor <- getanchor
();
4274 opendoc state
.path state
.password
;
4276 src#
string "page scroll scaling factor"
4277 (fun () -> string_of_float conf
.pgscale)
4280 let s = float_of_string
v in
4283 state
.text <- Printf.sprintf
4284 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4287 src#
int "ui font size"
4288 (fun () -> fstate
.fontsize
)
4289 (fun v -> setfontsize (bound
v 5 100));
4290 src#
int "hint font size"
4291 (fun () -> conf
.hfsize
)
4292 (fun v -> conf
.hfsize
<- bound
v 5 100);
4293 colorp "background color"
4294 (fun () -> conf
.bgcolor
)
4295 (fun v -> conf
.bgcolor
<- v);
4296 src#
bool "crop hack"
4297 (fun () -> conf
.crophack
)
4298 (fun v -> conf
.crophack
<- v);
4299 src#
string "trim fuzz"
4300 (fun () -> irect_to_string conf
.trimfuzz
)
4303 conf
.trimfuzz
<- irect_of_string
v;
4305 then settrim true conf
.trimfuzz
;
4307 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4309 src#
string "throttle"
4311 match conf
.maxwait
with
4312 | None
-> "show place holder if page is not ready"
4315 then "wait for page to fully render"
4317 "wait " ^ string_of_float
time
4318 ^
" seconds before showing placeholder"
4322 let f = float_of_string
v in
4324 then conf
.maxwait
<- None
4325 else conf
.maxwait
<- Some
f
4327 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4329 src#
string "ghyll scroll"
4331 match conf
.ghyllscroll
with
4333 | Some nab
-> ghyllscroll_to_string nab
4336 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4338 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4340 src#
string "selection command"
4341 (fun () -> conf
.selcmd
)
4342 (fun v -> conf
.selcmd
<- v);
4343 src#
string "synctex command"
4344 (fun () -> conf
.stcmd
)
4345 (fun v -> conf
.stcmd
<- v);
4346 src#
string "pax command"
4347 (fun () -> conf
.paxcmd
)
4348 (fun v -> conf
.paxcmd
<- v);
4349 src#colorspace
"color space"
4350 (fun () -> CSTE.to_string conf
.colorspace
)
4352 conf
.colorspace
<- CSTE.of_int
v;
4356 src#paxmark
"pax mark method"
4357 (fun () -> MTE.to_string conf
.paxmark
)
4358 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4362 (fun () -> conf
.usepbo
)
4363 (fun v -> conf
.usepbo
<- v);
4364 src#
bool "mouse wheel scrolls pages"
4365 (fun () -> conf
.wheelbypage
)
4366 (fun v -> conf
.wheelbypage
<- v);
4367 src#
bool "open remote links in a new instance"
4368 (fun () -> conf
.riani
)
4369 (fun v -> conf
.riani
<- v);
4373 src#caption
"Document" 0;
4374 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4375 src#caption2
"Pages"
4376 (fun () -> string_of_int state
.pagecount
) 1;
4377 src#caption2
"Dimensions"
4378 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4382 src#caption
"Trimmed margins" 0;
4383 src#caption2
"Dimensions"
4384 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4388 src#caption
"OpenGL" 0;
4389 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4390 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4393 src#caption
"Location" 0;
4394 if nonemptystr state
.origin
4395 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4396 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4398 src#reset prevmode prevuioh
;
4403 let prevmode = state
.mode
4404 and prevuioh
= state
.uioh in
4405 fillsrc prevmode prevuioh
;
4406 let source = (src :> lvsource
) in
4407 let modehash = findkeyhash conf
"info" in
4408 state
.uioh <- coe (object (self)
4409 inherit listview ~zebra
:false ~helpmode
:false
4410 ~
source ~trusted
:true ~
modehash as super
4411 val mutable m_prevmemused
= 0
4412 method! infochanged
= function
4414 if m_prevmemused
!= state
.memused
4416 m_prevmemused
<- state
.memused
;
4417 G.postRedisplay "memusedchanged";
4419 | Pdim
-> G.postRedisplay "pdimchanged"
4420 | Docinfo
-> fillsrc prevmode prevuioh
4422 method! key key mask
=
4423 if not
(Wsi.withctrl mask
)
4426 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4427 | @right
| @kpright
-> coe (self#updownlevel
1)
4428 | _ -> super#
key key mask
4429 else super#
key key mask
4431 G.postRedisplay "info";
4437 inherit lvsourcebase
4438 method getitemcount
= Array.length state
.help
4440 let s, l, _ = state
.help
.(n) in
4443 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4447 match state
.help
.(active) with
4448 | _, _, Action
f -> Some
(f uioh)
4449 | _, _, Noaction
-> Some
uioh
4458 method hasaction
n =
4459 match state
.help
.(n) with
4460 | _, _, Action
_ -> true
4461 | _, _, Noaction
-> false
4467 let modehash = findkeyhash conf
"help" in
4469 state
.uioh <- coe (new listview
4470 ~zebra
:false ~helpmode
:true
4471 ~
source ~trusted
:true ~
modehash);
4472 G.postRedisplay "help";
4477 let re = Str.regexp
"[\r\n]" in
4479 inherit lvsourcebase
4480 val mutable m_items
= E.a
4482 method getitemcount
= 1 + Array.length m_items
4487 else m_items
.(n-1), 0
4489 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4494 then Buffer.clear state
.errmsgs
;
4501 method hasaction
n =
4505 state
.newerrmsgs
<- false;
4506 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4507 m_items
<- Array.of_list
l
4516 let source = (msgsource :> lvsource
) in
4517 let modehash = findkeyhash conf
"listview" in
4518 state
.uioh <- coe (object
4519 inherit listview ~zebra
:false ~helpmode
:false
4520 ~
source ~trusted
:false ~
modehash as super
4523 then msgsource#reset
;
4526 G.postRedisplay "msgs";
4529 let quickbookmark ?title
() =
4530 match state
.layout with
4536 let tm = Unix.localtime
(now
()) in
4537 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4541 (tm.Unix.tm_year
+ 1900)
4544 | Some
title -> title
4546 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4549 let setautoscrollspeed step goingdown
=
4550 let incr = max
1 ((abs step
) / 2) in
4551 let incr = if goingdown
then incr else -incr in
4552 let astep = boundastep state
.winh
(step
+ incr) in
4553 state
.autoscroll
<- Some
astep;
4557 match conf
.columns
with
4559 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4562 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4564 let existsinrow pageno (columns
, coverA
, coverB
) p =
4565 let last = ((pageno - coverA
) mod columns
) + columns
in
4566 let rec any = function
4569 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4573 then (if l.pageno = last then false else any rest
)
4581 match state
.layout with
4583 let pageno = page_of_y state
.y in
4584 gotoghyll (getpagey
(pageno+1))
4586 match conf
.columns
with
4588 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4590 let y = clamp (pgscale state
.winh
) in
4593 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4594 gotoghyll (getpagey
pageno)
4595 | Cmulti
((c, _, _) as cl, _) ->
4596 if conf
.presentation
4597 && (existsinrow l.pageno cl
4598 (fun l -> l.pageh
> l.pagey + l.pagevh))
4600 let y = clamp (pgscale state
.winh
) in
4603 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4604 gotoghyll (getpagey
pageno)
4606 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4608 let pagey, pageh
= getpageyh
l.pageno in
4609 let pagey = pagey + pageh
* l.pagecol
in
4610 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4611 gotoghyll (pagey + pageh
+ ips)
4615 match state
.layout with
4617 let pageno = page_of_y state
.y in
4618 gotoghyll (getpagey
(pageno-1))
4620 match conf
.columns
with
4622 if conf
.presentation
&& l.pagey != 0
4624 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4626 let pageno = max
0 (l.pageno-1) in
4627 gotoghyll (getpagey
pageno)
4628 | Cmulti
((c, _, coverB
) as cl, _) ->
4629 if conf
.presentation
&&
4630 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4632 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4635 if l.pageno = state
.pagecount
- coverB
4639 let pageno = max
0 (l.pageno-decr) in
4640 gotoghyll (getpagey
pageno)
4648 let pageno = max
0 (l.pageno-1) in
4649 let pagey, pageh
= getpageyh
pageno in
4652 let pagey, pageh
= getpageyh
l.pageno in
4653 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4658 let viewkeyboard key mask
=
4660 let mode = state
.mode in
4661 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4664 G.postRedisplay "view:enttext"
4666 let ctrl = Wsi.withctrl mask
in
4668 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4673 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4675 state
.mode <- LinkNav
(Ltgendir
0);
4678 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4681 begin match state
.mstate
with
4684 G.postRedisplay "kill zoom rect";
4687 | Mscrolly
| Mscrollx
4690 begin match state
.mode with
4693 G.postRedisplay "esc leave linknav"
4697 match state
.ranchors
with
4699 | (path, password
, anchor, origin
) :: rest
->
4700 state
.ranchors
<- rest
;
4701 state
.anchor <- anchor;
4702 state
.origin
<- origin
;
4703 state
.nameddest
<- E.s;
4704 opendoc path password
4709 gotoghyll (getnav ~
-1)
4720 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4721 G.postRedisplay "dehighlight";
4723 | @slash
| @question
->
4724 let ondone isforw
s =
4725 cbput state
.hists
.pat
s;
4726 state
.searchpattern
<- s;
4729 let s = String.make
1 (Char.chr
key) in
4730 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4731 textentry, ondone (key = @slash
), true)
4733 | @plus
| @kpplus
| @equals
when ctrl ->
4734 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4735 setzoom (conf
.zoom +. incr)
4737 | @plus
| @kpplus
->
4740 try int_of_string
s with exc
->
4741 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4747 state
.text <- "page bias is now " ^ string_of_int
n;
4750 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4752 | @minus
| @kpminus
when ctrl ->
4753 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4754 setzoom (max
0.01 (conf
.zoom -. decr))
4756 | @minus
| @kpminus
->
4757 let ondone msg
= state
.text <- msg
in
4759 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4760 optentry state
.mode, ondone, true
4771 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4773 match conf
.columns
with
4774 | Csingle
_ | Cmulti
_ -> 1
4775 | Csplit
(n, _) -> n
4777 let h = state
.winh
-
4778 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4780 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4781 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4786 match conf
.fitmodel
with
4787 | FitWidth
-> FitProportional
4788 | FitProportional
-> FitPage
4789 | FitPage
-> FitWidth
4791 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4792 reqlayout conf
.angle
fm
4800 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4801 when not
ctrl -> (* 0..9 *)
4804 try int_of_string
s with exc
->
4805 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4811 cbput state
.hists
.pag
(string_of_int
n);
4812 gotopage1 (n + conf
.pagebias
- 1) 0;
4815 let pageentry text key =
4816 match Char.unsafe_chr
key with
4817 | '
g'
-> TEdone
text
4818 | _ -> intentry text key
4820 let text = String.make
1 (Char.chr
key) in
4821 enttext (":", text, Some
(onhist state
.hists
.pag
),
4822 pageentry, ondone, true)
4825 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4826 reshape state
.winw state
.winh
;
4829 state
.bzoom
<- not state
.bzoom
;
4831 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4834 conf
.hlinks
<- not conf
.hlinks
;
4835 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4836 G.postRedisplay "toggle highlightlinks";
4839 state
.glinks
<- true;
4840 let mode = state
.mode in
4841 state
.mode <- Textentry
(
4842 (":", E.s, None
, linknentry, linkndone gotounder, false),
4844 state
.glinks
<- false;
4848 G.postRedisplay "view:linkent(F)"
4851 state
.glinks
<- true;
4852 let mode = state
.mode in
4853 state
.mode <- Textentry
(
4855 ":", E.s, None
, linknentry, linkndone (fun under ->
4856 selstring (undertext under);
4860 state
.glinks
<- false;
4864 G.postRedisplay "view:linkent"
4867 begin match state
.autoscroll
with
4869 conf
.autoscrollstep
<- step
;
4870 state
.autoscroll
<- None
4872 if conf
.autoscrollstep
= 0
4873 then state
.autoscroll
<- Some
1
4874 else state
.autoscroll
<- Some conf
.autoscrollstep
4881 setpresentationmode (not conf
.presentation
);
4882 showtext ' '
("presentation mode " ^
4883 if conf
.presentation
then "on" else "off");
4886 if List.mem
Wsi.Fullscreen state
.winstate
4887 then Wsi.reshape conf
.cwinw conf
.cwinh
4888 else Wsi.fullscreen
()
4891 search state
.searchpattern
false
4894 search state
.searchpattern
true
4897 begin match state
.layout with
4900 gotoghyll (getpagey
l.pageno)
4906 | @delete
| @kpdelete
-> (* delete *)
4910 showtext ' '
(describe_location ());
4913 begin match state
.layout with
4916 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4921 enterbookmarkmode ()
4929 | @e when Buffer.length state
.errmsgs
> 0 ->
4934 match state
.layout with
4939 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4942 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
4946 showtext ' '
"Quick bookmark added";
4949 begin match state
.layout with
4951 let rect = getpdimrect
l.pagedimno
in
4955 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
4956 truncate
(1.2 *. (rect.(3) -. rect.(0))))
4958 (truncate
(rect.(1) -. rect.(0)),
4959 truncate
(rect.(3) -. rect.(0)))
4961 let w = truncate
((float w)*.conf
.zoom)
4962 and h = truncate
((float h)*.conf
.zoom) in
4965 state
.anchor <- getanchor
();
4966 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
4968 G.postRedisplay "z";
4973 | @x -> state
.roam
()
4976 reqlayout (conf
.angle
+
4977 (if key = @Gt
then 30 else -30)) conf
.fitmodel
4981 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
4983 G.postRedisplay "brightness";
4985 | @c when state
.mode = View
->
4990 let m = (wadjsb state
.winw
- state
.w) / 2 in
4992 gotoy_and_clear_text state
.y
4996 match state
.prevcolumns
with
4997 | None
-> (1, 0, 0), 1.0
4998 | Some
(columns
, z
) ->
5001 | Csplit
(c, _) -> -c, 0, 0
5002 | Cmulti
((c, a, b), _) -> c, a, b
5003 | Csingle
_ -> 1, 0, 0
5007 setcolumns View
c a b;
5010 | @down
| @up
when ctrl && Wsi.withshift mask
->
5011 let zoom, x = state
.prevzoom
in
5015 | @k
| @up
| @kpup
->
5016 begin match state
.autoscroll
with
5018 begin match state
.mode with
5019 | Birdseye beye
-> upbirdseye 1 beye
5024 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5026 if not
(Wsi.withshift mask
) && conf
.presentation
5028 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5032 setautoscrollspeed n false
5035 | @j
| @down
| @kpdown
->
5036 begin match state
.autoscroll
with
5038 begin match state
.mode with
5039 | Birdseye beye
-> downbirdseye 1 beye
5044 then gotoy_and_clear_text (clamp (state
.winh
/2))
5046 if not
(Wsi.withshift mask
) && conf
.presentation
5048 else gotoghyll1 true (clamp (conf
.scrollstep
))
5052 setautoscrollspeed n true
5055 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5061 else conf
.hscrollstep
5063 let dx = if key = @left || key = @kpleft
then dx else -dx in
5064 state
.x <- panbound (state
.x + dx);
5065 gotoy_and_clear_text state
.y
5068 G.postRedisplay "left/right"
5071 | @prior
| @kpprior
->
5075 match state
.layout with
5077 | l :: _ -> state
.y - l.pagey
5079 clamp (pgscale (-state
.winh
))
5083 | @next | @kpnext
->
5087 match List.rev state
.layout with
5089 | l :: _ -> getpagey
l.pageno
5091 clamp (pgscale state
.winh
)
5095 | @g | @home
| @kphome
->
5098 | @G
| @jend
| @kpend
->
5100 gotoghyll (clamp state
.maxy)
5102 | @right
| @kpright
when Wsi.withalt mask
->
5103 gotoghyll (getnav 1)
5104 | @left | @kpleft
when Wsi.withalt mask
->
5105 gotoghyll (getnav ~
-1)
5110 | @v when conf
.debug
->
5113 match getopaque l.pageno with
5116 let x0, y0, x1, y1 = pagebbox
opaque in
5117 let a,b = float x0, float y0 in
5118 let c,d = float x1, float y0 in
5119 let e,f = float x1, float y1 in
5120 let h,j
= float x0, float y1 in
5121 let rect = (a,b,c,d,e,f,h,j
) in
5123 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5125 G.postRedisplay "v";
5128 let mode = state
.mode in
5129 let cmd = ref E.s in
5130 let onleave = function
5131 | Cancel
-> state
.mode <- mode
5134 match getopaque l.pageno with
5135 | Some
opaque -> pipesel opaque !cmd
5136 | None
-> ()) state
.layout;
5140 cbput state
.hists
.sel
s;
5144 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5146 G.postRedisplay "|";
5147 state
.mode <- Textentry
(te, onleave);
5150 vlog "huh? %s" (Wsi.keyname
key)
5153 let linknavkeyboard key mask
linknav =
5154 let getpage pageno =
5155 let rec loop = function
5157 | l :: _ when l.pageno = pageno -> Some
l
5158 | _ :: rest
-> loop rest
5159 in loop state
.layout
5161 let doexact (pageno, n) =
5162 match getopaque pageno, getpage pageno with
5163 | Some
opaque, Some
l ->
5164 if key = @enter
|| key = @kpenter
5166 let under = getlink
opaque n in
5167 G.postRedisplay "link gotounder";
5174 Some
(findlink
opaque LDfirst
), -1
5177 Some
(findlink
opaque LDlast
), 1
5180 Some
(findlink
opaque (LDleft
n)), -1
5183 Some
(findlink
opaque (LDright
n)), 1
5186 Some
(findlink
opaque (LDup
n)), -1
5189 Some
(findlink
opaque (LDdown
n)), 1
5194 begin match findpwl
l.pageno dir with
5198 state
.mode <- LinkNav
(Ltgendir
dir);
5199 let y, h = getpageyh
pageno in
5202 then y + h - state
.winh
5207 begin match getopaque pageno, getpage pageno with
5208 | Some
opaque, Some
_ ->
5210 let ld = if dir > 0 then LDfirst
else LDlast
in
5213 begin match link with
5215 showlinktype (getlink
opaque m);
5216 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5217 G.postRedisplay "linknav jpage";
5218 | Lnotfound
-> notfound dir
5224 begin match opt with
5225 | Some Lnotfound
-> pwl l dir;
5226 | Some
(Lfound
m) ->
5230 let _, y0, _, y1 = getlinkrect
opaque m in
5232 then gotopage1 l.pageno y0
5234 let d = fstate
.fontsize
+ 1 in
5235 if y1 - l.pagey > l.pagevh - d
5236 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5237 else G.postRedisplay "linknav";
5239 showlinktype (getlink
opaque m);
5240 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5243 | None
-> viewkeyboard key mask
5245 | _ -> viewkeyboard key mask
5250 G.postRedisplay "leave linknav"
5254 | Ltgendir
_ -> viewkeyboard key mask
5255 | Ltexact exact
-> doexact exact
5258 let keyboard key mask
=
5259 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5260 then wcmd "interrupt"
5261 else state
.uioh <- state
.uioh#
key key mask
5264 let birdseyekeyboard key mask
5265 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5267 match conf
.columns
with
5269 | Cmulti
((c, _, _), _) -> c
5270 | Csplit
_ -> failwith
"bird's eye split mode"
5272 let pgh layout = List.fold_left
5273 (fun m l -> max
l.pageh
m) state
.winh
layout in
5275 | @l when Wsi.withctrl mask
->
5276 let y, h = getpageyh
pageno in
5277 let top = (state
.winh
- h) / 2 in
5278 gotoy (max
0 (y - top))
5279 | @enter
| @kpenter
-> leavebirdseye beye
false
5280 | @escape
-> leavebirdseye beye
true
5281 | @up
-> upbirdseye incr beye
5282 | @down
-> downbirdseye incr beye
5283 | @left -> upbirdseye 1 beye
5284 | @right
-> downbirdseye 1 beye
5287 begin match state
.layout with
5291 state
.mode <- Birdseye
(
5292 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5294 gotopage1 l.pageno 0;
5297 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5299 | [] -> gotoy (clamp (-state
.winh
))
5301 state
.mode <- Birdseye
(
5302 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5304 gotopage1 l.pageno 0
5307 | [] -> gotoy (clamp (-state
.winh
))
5311 begin match List.rev state
.layout with
5313 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5314 begin match layout with
5316 let incr = l.pageh
- l.pagevh in
5321 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5323 G.postRedisplay "birdseye pagedown";
5325 else gotoy (clamp (incr + conf
.interpagespace
*2));
5329 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5330 gotopage1 l.pageno 0;
5333 | [] -> gotoy (clamp state
.winh
)
5337 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5341 let pageno = state
.pagecount
- 1 in
5342 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5343 if not
(pagevisible state
.layout pageno)
5346 match List.rev state
.pdims
with
5348 | (_, _, h, _) :: _ -> h
5350 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5351 else G.postRedisplay "birdseye end";
5353 | _ -> viewkeyboard key mask
5358 match state
.mode with
5359 | Textentry
_ -> scalecolor 0.4
5361 | View
-> scalecolor 1.0
5362 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5363 if l.pageno = hooverpageno
5366 if l.pageno = pageno
5368 let c = scalecolor 1.0 in
5370 GlDraw.line_width
3.0;
5371 let dispx = xadjsb l.pagedispx in
5373 (float (dispx-1)) (float (l.pagedispy-1))
5374 (float (dispx+l.pagevw+1))
5375 (float (l.pagedispy+l.pagevh+1))
5377 GlDraw.line_width
1.0;
5386 let postdrawpage l linkindexbase
=
5387 match getopaque l.pageno with
5389 if tileready l l.pagex
l.pagey
5391 let x = l.pagedispx - l.pagex
+ xadjsb 0
5392 and y = l.pagedispy - l.pagey in
5394 match conf
.columns
with
5395 | Csingle
_ | Cmulti
_ ->
5396 (if conf
.hlinks
then 1 else 0)
5398 && not
(isbirdseye state
.mode) then 2 else 0)
5402 match state
.mode with
5403 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5409 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5414 let scrollindicator () =
5415 let sbw, ph
, sh = state
.uioh#
scrollph in
5416 let sbh, pw, sw = state
.uioh#scrollpw
in
5421 else (state
.winw
- sbw), state
.winw
5424 GlDraw.color (0.64, 0.64, 0.64);
5425 filledrect (float x0) 0. (float x1) (float state
.winh
);
5427 0. (float (state
.winh
- sbh))
5428 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5430 GlDraw.color (0.0, 0.0, 0.0);
5432 filledrect (float x0) ph
(float x1) (ph
+. sh);
5433 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5437 match state
.mstate
with
5438 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5441 | Msel
((x0, y0), (x1, y1)) ->
5442 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5443 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5444 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5445 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5448 let showrects = function [] -> () | rects
->
5450 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5451 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5453 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5455 if l.pageno = pageno
5457 let dx = float (l.pagedispx - l.pagex
) in
5458 let dy = float (l.pagedispy - l.pagey) in
5459 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5460 Raw.sets_float state
.vraw ~
pos:0
5465 GlArray.vertex `two state
.vraw
;
5466 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5475 GlClear.color (scalecolor2 conf
.bgcolor
);
5476 GlClear.clear
[`
color];
5477 List.iter
drawpage state
.layout;
5479 match state
.mode with
5480 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5481 begin match getopaque pageno with
5483 let dx = xadjsb 0 in
5484 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5485 let x0 = x0 + dx and x1 = x1 + dx in
5492 | None
-> state
.rects
5494 | LinkNav
(Ltgendir
_)
5497 | View
-> state
.rects
5500 let rec postloop linkindexbase
= function
5502 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5503 postloop linkindexbase rest
5507 postloop 0 state
.layout;
5509 begin match state
.mstate
with
5510 | Mzoomrect
((x0, y0), (x1, y1)) ->
5512 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5513 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5514 filledrect (float x0) (float y0) (float x1) (float y1);
5518 | Mscrolly
| Mscrollx
5527 let zoomrect x y x1 y1 =
5530 and y0 = min
y y1 in
5531 gotoy (state
.y + y0);
5532 state
.anchor <- getanchor
();
5533 let zoom = (float state
.w) /. float (x1 - x0) in
5536 let adjw = wadjsb state
.winw
in
5538 then (adjw - state
.w) / 2
5541 match conf
.fitmodel
with
5542 | FitWidth
| FitProportional
-> simple ()
5544 match conf
.columns
with
5546 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5547 | Cmulti
_ | Csingle
_ -> simple ()
5549 state
.x <- (state
.x + margin) - x0;
5555 let g opaque l px py =
5556 match rectofblock
opaque px py with
5558 let x0 = a.(0) -. 20. in
5559 let x1 = a.(1) +. 20. in
5560 let y0 = a.(2) -. 20. in
5561 let zoom = (float state
.w) /. (x1 -. x0) in
5562 let pagey = getpagey
l.pageno in
5563 gotoy_and_clear_text (pagey + truncate
y0);
5564 state
.anchor <- getanchor
();
5565 let margin = (state
.w - l.pagew
)/2 in
5566 state
.x <- -truncate
x0 - margin;
5571 match conf
.columns
with
5573 showtext '
!'
"block zooming does not work properly in split columns mode"
5574 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5578 let winw = wadjsb state
.winw - 1 in
5579 let s = float x /. float winw in
5580 let destx = truncate
(float (state
.w + winw) *. s) in
5581 state
.x <- winw - destx;
5582 gotoy_and_clear_text state
.y;
5583 state
.mstate
<- Mscrollx
;
5587 let s = float y /. float state
.winh
in
5588 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5589 gotoy_and_clear_text desty;
5590 state
.mstate
<- Mscrolly
;
5593 let viewmulticlick clicks
x y mask
=
5594 let g opaque l px py =
5602 if markunder
opaque px py mark
5606 match getopaque l.pageno with
5608 | Some
opaque -> pipesel opaque cmd
5610 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5611 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5616 G.postRedisplay "viewmulticlick";
5617 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5621 match conf
.columns
with
5623 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5626 let viewmouse button down
x y mask
=
5628 | n when (n == 4 || n == 5) && not down
->
5629 if Wsi.withctrl mask
5631 match state
.mstate
with
5632 | Mzoom
(oldn
, i
) ->
5640 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5642 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5644 let zoom = conf
.zoom -. incr in
5646 state
.mstate
<- Mzoom
(n, 0);
5648 state
.mstate
<- Mzoom
(n, i
+1);
5650 else state
.mstate
<- Mzoom
(n, 0)
5654 | Mscrolly
| Mscrollx
5656 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5659 match state
.autoscroll
with
5660 | Some step
-> setautoscrollspeed step
(n=4)
5662 if conf
.wheelbypage
|| conf
.presentation
5671 then -conf
.scrollstep
5672 else conf
.scrollstep
5674 let incr = incr * 2 in
5675 let y = clamp incr in
5676 gotoy_and_clear_text y
5679 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5681 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5682 gotoy_and_clear_text state
.y
5684 | 1 when Wsi.withshift mask
->
5685 state
.mstate
<- Mnone
;
5688 match unproject x y with
5689 | Some
(pageno, ux
, uy
) ->
5690 let cmd = Printf.sprintf
5692 conf
.stcmd state
.path pageno ux uy
5698 | 1 when Wsi.withctrl mask
->
5701 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5702 state
.mstate
<- Mpan
(x, y)
5705 state
.mstate
<- Mnone
5710 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5712 state
.mstate
<- Mzoomrect
(p, p)
5715 match state
.mstate
with
5716 | Mzoomrect
((x0, y0), _) ->
5717 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5718 then zoomrect x0 y0 x y
5721 G.postRedisplay "kill accidental zoom rect";
5725 | Mscrolly
| Mscrollx
5731 | 1 when x > state
.winw - vscrollw () ->
5734 let _, position, sh = state
.uioh#
scrollph in
5735 if y > truncate
position && y < truncate
(position +. sh)
5736 then state
.mstate
<- Mscrolly
5739 state
.mstate
<- Mnone
5741 | 1 when y > state
.winh
- hscrollh () ->
5744 let _, position, sw = state
.uioh#scrollpw
in
5745 if x > truncate
position && x < truncate
(position +. sw)
5746 then state
.mstate
<- Mscrollx
5749 state
.mstate
<- Mnone
5751 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5754 let dest = if down
then getunder x y else Unone
in
5755 begin match dest with
5758 | Uremote
_ | Uremotedest
_
5759 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5762 | Unone
when down
->
5763 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5764 state
.mstate
<- Mpan
(x, y);
5766 | Unone
| Utext
_ ->
5771 state
.mstate
<- Msel
((x, y), (x, y));
5772 G.postRedisplay "mouse select";
5776 match state
.mstate
with
5779 | Mzoom
_ | Mscrollx
| Mscrolly
->
5780 state
.mstate
<- Mnone
5782 | Mzoomrect
((x0, y0), _) ->
5786 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5787 state
.mstate
<- Mnone
5789 | Msel
((x0, y0), (x1, y1)) ->
5790 let rec loop = function
5794 let a0 = l.pagedispy in
5795 let a1 = a0 + l.pagevh in
5796 let b0 = l.pagedispx in
5797 let b1 = b0 + l.pagevw in
5798 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5799 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5803 match getopaque l.pageno with
5806 match Unix.pipe
() with
5810 "can not create sel pipe: %s"
5814 Ne.clo fd
(fun msg
->
5815 dolog
"%s close failed: %s" what msg
)
5818 try popen
cmd [r, 0; w, -1]; true
5820 dolog
"can not execute %S: %s"
5827 G.postRedisplay "copysel";
5829 else clo "Msel pipe/w" w;
5830 clo "Msel pipe/r" r;
5832 dosel conf
.selcmd
();
5833 state
.roam
<- dosel conf
.paxcmd
;
5845 let birdseyemouse button down
x y mask
5846 (conf
, leftx
, _, hooverpageno
, anchor) =
5849 let rec loop = function
5852 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5853 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5855 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5861 | _ -> viewmouse button down
x y mask
5867 method key key mask
=
5868 begin match state
.mode with
5869 | Textentry
textentry -> textentrykeyboard key mask
textentry
5870 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5871 | View
-> viewkeyboard key mask
5872 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5876 method button button bstate
x y mask
=
5877 begin match state
.mode with
5879 | View
-> viewmouse button bstate
x y mask
5880 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5885 method multiclick clicks
x y mask
=
5886 begin match state
.mode with
5888 | View
-> viewmulticlick clicks
x y mask
5895 begin match state
.mode with
5897 | View
| Birdseye
_ | LinkNav
_ ->
5898 match state
.mstate
with
5899 | Mzoom
_ | Mnone
-> ()
5904 state
.mstate
<- Mpan
(x, y);
5906 then state
.x <- panbound (state
.x + dx);
5908 gotoy_and_clear_text y
5911 state
.mstate
<- Msel
(a, (x, y));
5912 G.postRedisplay "motion select";
5915 let y = min state
.winh
(max
0 y) in
5919 let x = min state
.winw (max
0 x) in
5922 | Mzoomrect
(p0
, _) ->
5923 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5924 G.postRedisplay "motion zoomrect";
5928 method pmotion
x y =
5929 begin match state
.mode with
5930 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5931 let rec loop = function
5933 if hooverpageno
!= -1
5935 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5936 G.postRedisplay "pmotion birdseye no hoover";
5939 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5940 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5942 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
5943 G.postRedisplay "pmotion birdseye hoover";
5953 match state
.mstate
with
5954 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
5963 let past, _, _ = !r in
5965 let delta = now -. past in
5968 else r := (now, x, y)
5972 method infochanged
_ = ()
5975 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
5978 then 0.0, float state
.winh
5979 else scrollph state
.y maxy
5984 let winw = wadjsb state
.winw in
5985 let fwinw = float winw in
5987 let sw = fwinw /. float state
.w in
5988 let sw = fwinw *. sw in
5989 max
sw (float conf
.scrollh
)
5992 let maxx = state
.w + winw in
5993 let x = winw - state
.x in
5994 let percent = float x /. float maxx in
5995 (fwinw -. sw) *. percent
5997 hscrollh (), position, sw
6001 match state
.mode with
6002 | LinkNav
_ -> "links"
6003 | Textentry
_ -> "textentry"
6004 | Birdseye
_ -> "birdseye"
6007 findkeyhash conf
modename
6009 method eformsgs
= true
6012 let adderrmsg src msg
=
6013 Buffer.add_string state
.errmsgs msg
;
6014 state
.newerrmsgs
<- true;
6018 let adderrfmt src fmt
=
6019 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6023 let cl = splitatspace cmds
in
6025 try Scanf.sscanf
s fmt
f
6027 adderrfmt "remote exec"
6028 "error processing '%S': %s\n" cmds
(exntos exn
)
6031 | "reload" :: [] -> reload ()
6032 | "goto" :: args
:: [] ->
6033 scan args
"%u %f %f"
6035 let cmd, _ = state
.geomcmds
in
6037 then gotopagexy pageno x y
6040 gotopagexy pageno x y;
6043 state
.reprf
<- f state
.reprf
6045 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6046 | "gotor" :: args
:: [] ->
6048 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6049 | "gotord" :: args
:: [] ->
6051 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6052 | "rect" :: args
:: [] ->
6053 scan args
"%u %u %f %f %f %f"
6054 (fun pageno color x0 y0 x1 y1 ->
6055 onpagerect pageno (fun w h ->
6056 let _,w1,h1
,_ = getpagedim
pageno in
6057 let sw = float w1 /. float w
6058 and sh = float h1
/. float h in
6062 and y1s
= y1 *. sh in
6063 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6065 state
.rects <- (pageno, color, rect) :: state
.rects;
6066 G.postRedisplay "rect";
6069 | "activatewin" :: [] -> Wsi.activatewin
()
6070 | "quit" :: [] -> raise Quit
6072 adderrfmt "remote command"
6073 "error processing remote command: %S\n" cmds
;
6077 let scratch = Bytes.create
80 in
6078 let buf = Buffer.create
80 in
6081 try Some
(Unix.read fd
scratch 0 80)
6083 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6084 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6087 match tempfr () with
6093 if Buffer.length
buf > 0
6095 let s = Buffer.contents
buf in
6105 let pos = Bytes.index_from
scratch ppos '
\n'
in
6106 if pos >= n then -1 else pos
6107 with Not_found
-> -1
6111 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6112 let s = Buffer.contents
buf in
6118 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6124 let remoteopen path =
6125 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6127 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6132 let gcconfig = ref E.s in
6133 let trimcachepath = ref E.s in
6134 let rcmdpath = ref E.s in
6135 let pageno = ref None
in
6136 let rootwid = ref 0 in
6137 let openlast = ref false in
6138 let nofc = ref false in
6139 selfexec := Sys.executable_name
;
6142 [("-p", Arg.String
(fun s -> state
.password
<- s),
6143 "<password> Set password");
6147 Config.fontpath
:= s;
6148 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6150 "<path> Set path to the user interface font");
6154 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6155 Config.confpath
:= s),
6156 "<path> Set path to the configuration file");
6158 ("-last", Arg.Set
openlast, " Open last document");
6160 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6161 "<page-number> Jump to page");
6163 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6164 "<path> Set path to the trim cache file");
6166 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6167 "<named-destination> Set named destination");
6169 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6170 ("-cxack", Arg.Set
cxack, " Cut corners");
6172 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6173 "<path> Set path to the remote commands source");
6175 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6176 "<original-path> Set original path");
6178 ("-gc", Arg.Set_string
gcconfig,
6179 "<script-path> Collect garbage with the help of a script");
6181 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6183 ("-v", Arg.Unit
(fun () ->
6185 "%s\nconfiguration path: %s\n"
6189 exit
0), " Print version and exit");
6191 ("-embed", Arg.Set_int
rootwid,
6192 "<window-id> Embed into window")
6195 (fun s -> state
.path <- s)
6196 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6199 then selfexec := !selfexec ^
" -wtmode";
6201 let histmode = emptystr state
.path && not
!openlast in
6203 if not
(Config.load !openlast)
6204 then prerr_endline
"failed to load configuration";
6205 begin match !pageno with
6206 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6210 if not
(emptystr
!gcconfig)
6213 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6215 error
"gc socketpair failed: %s" (exntos exn
)
6218 match popen
!gcconfig [(c, 0); (c, 1)] with
6223 error
"failed to popen gc script: %s" (exntos exn
);
6226 let wsfd, winw, winh
= Wsi.init
(object (self)
6227 val mutable m_clicks
= 0
6228 val mutable m_click_x
= 0
6229 val mutable m_click_y
= 0
6230 val mutable m_lastclicktime
= infinity
6232 method private cleanup
=
6233 state
.roam
<- noroam
;
6234 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6235 method expose
= G.postRedisplay"expose"
6239 | Wsi.Unobscured
-> "unobscured"
6240 | Wsi.PartiallyObscured
-> "partiallyobscured"
6241 | Wsi.FullyObscured
-> "fullyobscured"
6243 vlog "visibility change %s" name
6244 method display = display ()
6245 method map mapped
= vlog "mappped %b" mapped
6246 method reshape w h =
6249 method mouse
b d x y m =
6250 if d && canselect ()
6252 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6258 if abs
x - m_click_x
> 10
6259 || abs
y - m_click_y
> 10
6260 || abs_float
(t -. m_lastclicktime
) > 0.3
6262 m_clicks
<- m_clicks
+ 1;
6263 m_lastclicktime
<- t;
6267 G.postRedisplay "cleanup";
6268 state
.uioh <- state
.uioh#button
b d x y m;
6270 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6275 m_lastclicktime
<- infinity
;
6276 state
.uioh <- state
.uioh#button
b d x y m
6280 state
.uioh <- state
.uioh#button
b d x y m
6283 state
.mpos
<- (x, y);
6284 state
.uioh <- state
.uioh#motion
x y
6285 method pmotion
x y =
6286 state
.mpos
<- (x, y);
6287 state
.uioh <- state
.uioh#pmotion
x y
6289 let mascm = m land (
6290 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6293 let x = state
.x and y = state
.y in
6295 if x != state
.x || y != state
.y then self#cleanup
6297 match state
.keystate
with
6299 let km = k
, mascm in
6302 let modehash = state
.uioh#
modehash in
6303 try Hashtbl.find modehash km
6305 try Hashtbl.find (findkeyhash conf
"global") km
6306 with Not_found
-> KMinsrt
(k
, m)
6308 | KMinsrt
(k
, m) -> keyboard k
m
6309 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6310 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6312 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6313 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6314 state
.keystate
<- KSnone
6315 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6316 state
.keystate
<- KSinto
(keys
, insrt
)
6317 | KSinto
_ -> state
.keystate
<- KSnone
6320 state
.mpos
<- (x, y);
6321 state
.uioh <- state
.uioh#pmotion
x y
6322 method leave = state
.mpos
<- (-1, -1)
6323 method winstate wsl
= state
.winstate
<- wsl
6324 method quit
= raise Quit
6325 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6330 List.exists
GlMisc.check_extension
6331 [ "GL_ARB_texture_rectangle"
6332 ; "GL_EXT_texture_recangle"
6333 ; "GL_NV_texture_rectangle" ]
6335 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6338 let r = GlMisc.get_string `renderer
in
6339 let p = "Mesa DRI Intel(" in
6340 let l = String.length
p in
6341 String.length
r > l && String.sub
r 0 l = p
6344 defconf
.sliceheight
<- 1024;
6345 defconf
.texcount
<- 32;
6346 defconf
.usepbo
<- true;
6350 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6352 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6360 setcheckers conf
.checkers
;
6362 if conf
.redirectstderr
6366 (Buffer.to_bytes state
.errmsgs
)
6367 (match state
.errfd
with
6369 let s = Bytes.create
(80*24) in
6372 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6374 then Unix.read fd
s 0 (Bytes.length
s)
6380 else Bytes.sub
s 0 n
6384 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6385 with exn
-> print_endline
(exntos exn
)
6390 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6391 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6392 !Config.fontpath
, !trimcachepath,
6393 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6396 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6402 Wsi.settitle
"llpp (history)";
6406 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6407 opendoc state
.path state
.password
;
6412 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6415 if nonemptystr
!rcmdpath
6416 then remoteopen !rcmdpath
6421 let rec loop deadline
=
6423 match state
.errfd
with
6424 | None
-> [state
.ss; state
.wsfd]
6425 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6430 | Some fd
-> fd
:: r
6434 state
.redisplay
<- false;
6441 if deadline
= infinity
6443 else max
0.0 (deadline
-. now)
6448 try Unix.select
r [] [] timeout
6449 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6455 if state
.ghyll
== noghyll
6457 match state
.autoscroll
with
6458 | Some step
when step
!= 0 ->
6459 let y = state
.y + step
in
6463 else if y >= state
.maxy then 0 else y
6466 if state
.mode = View
6467 then state
.text <- E.s;
6470 else deadline
+. 0.01
6475 let rec checkfds = function
6477 | fd
:: rest
when fd
= state
.ss ->
6478 let cmd = readcmd state
.ss in
6482 | fd
:: rest
when fd
= state
.wsfd ->
6486 | fd
:: rest
when Some fd
= !optrfd ->
6487 begin match remote fd
with
6488 | None
-> optrfd := remoteopen !rcmdpath;
6489 | opt -> optrfd := opt
6494 let s = Bytes.create
80 in
6495 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6496 if conf
.redirectstderr
6498 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6499 state
.newerrmsgs
<- true;
6500 state
.redisplay
<- true;
6503 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6509 if !reeenterhist then (
6511 reeenterhist := false;
6515 if deadline
= infinity
6519 match state
.autoscroll
with
6520 | Some step
when step
!= 0 -> deadline1
6521 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6529 Config.save
leavebirdseye;