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;
3448 let gotooutline (_, _, kind
) =
3452 let (pageno, y, _) = anchor in
3454 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3458 | Ouri
uri -> gotounder (Ulinkuri
uri)
3459 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3460 | Oremote remote
-> gotounder (Uremote remote
)
3461 | Ohistory hist
-> gotohist hist
3462 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3466 let genhistoutlines =
3467 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3469 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3470 | `
path -> compare p2 p1
3471 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3473 let e1 = emptystr c1
.title
3474 and e2
= emptystr c2
.title
in
3476 then compare
(Filename.basename p2
) (Filename.basename p1
)
3479 else compare c1
.title c2
.title
3481 let showfullpath = ref false in
3484 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3485 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3487 let list = ref [] in
3488 if Config.gethist
list
3492 (fun accu (path, c, b, x, a) ->
3493 let hist = (path, (c, b, x, a)) in
3494 let s = if !showfullpath then path else Filename.basename
path in
3495 let base = mbtoutf8
s in
3496 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3498 [ setorty "Sort by time of last visit" `lastvisit
;
3499 setorty "Sort by file name" `file
;
3500 setorty "Sort by path" `
path;
3501 setorty "Sort by title" `title
;
3502 (if !showfullpath then "@Uradical "
3503 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3504 showfullpath := not
!showfullpath; reeenterhist := true)
3505 ] (List.sort
(order orderty
) !list)
3511 let outlinesource sourcetype
=
3513 inherit lvsourcebase
3514 val mutable m_items
= E.a
3515 val mutable m_minfo
= E.a
3516 val mutable m_orig_items
= E.a
3517 val mutable m_orig_minfo
= E.a
3518 val mutable m_narrow_patterns
= []
3519 val mutable m_hadremovals
= false
3520 val mutable m_gen
= -1
3522 method getitemcount
=
3523 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3526 if n == Array.length m_items
&& m_hadremovals
3528 ("[Confirm removal]", 0)
3530 let s, n, _ = m_items
.(n) in
3533 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3534 ignore
(uioh
, first);
3535 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3537 if m_narrow_patterns
= []
3538 then m_orig_items
, m_orig_minfo
3539 else m_items
, m_minfo
3543 if not
confrimremoval
3545 gotooutline m_items
.(active);
3550 state
.bookmarks
<- Array.to_list m_items
;
3551 m_orig_items
<- m_items
;
3552 m_orig_minfo
<- m_minfo
;
3562 method hasaction
_ = true
3565 if Array.length m_items
!= Array.length m_orig_items
3568 match m_narrow_patterns
with
3570 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3572 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3576 match m_narrow_patterns
with
3579 | head
:: _ -> "@Uellipsis" ^ head
3581 method narrow
pattern =
3582 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3586 let rec loop accu minfo n =
3589 m_items
<- Array.of_list
accu;
3590 m_minfo
<- Array.of_list
minfo;
3593 let (s, _, t
) as o = m_items
.(n) in
3596 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3597 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3598 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3600 try Str.search_forward
re s 0
3601 with Not_found
-> -1
3604 then o :: accu, (first, Str.match_end
()) :: minfo
3607 loop accu minfo (n-1)
3609 loop [] [] (Array.length m_items
- 1)
3611 method! getminfo
= m_minfo
3615 match sourcetype
with
3616 | `bookmarks
-> Array.of_list state
.bookmarks
3617 | `outlines
-> state
.outlines
3618 | `history
-> genhistoutlines !Config.historder
3620 m_minfo
<- m_orig_minfo
;
3621 m_items
<- m_orig_items
3624 if sourcetype
= `bookmarks
3626 if m >= 0 && m < Array.length m_items
3628 m_hadremovals
<- true;
3629 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3630 let n = if n >= m then n+1 else n in
3635 method add_narrow_pattern
pattern =
3636 m_narrow_patterns
<- pattern :: m_narrow_patterns
3638 method del_narrow_pattern
=
3639 match m_narrow_patterns
with
3640 | _ :: rest
-> m_narrow_patterns
<- rest
3645 match m_narrow_patterns
with
3646 | pattern :: [] -> self#narrow
pattern; pattern
3648 List.fold_left
(fun accu pattern ->
3649 self#narrow
pattern;
3650 pattern ^
"@Uellipsis" ^
accu) E.s list
3652 method calcactive
anchor =
3653 let rely = getanchory anchor in
3654 let rec loop n best bestd
=
3655 if n = Array.length m_items
3658 let _, _, kind
= m_items
.(n) in
3661 let orely = getanchory anchor in
3662 let d = abs
(orely - rely) in
3665 else loop (n+1) best bestd
3666 | Onone
| Oremote
_ | Olaunch
_
3667 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3668 loop (n+1) best bestd
3672 method reset
anchor items =
3673 m_hadremovals
<- false;
3674 if state
.gen
!= m_gen
3676 m_orig_items
<- items;
3678 m_narrow_patterns
<- [];
3680 m_orig_minfo
<- E.a;
3684 if items != m_orig_items
3686 m_orig_items
<- items;
3687 if m_narrow_patterns
== []
3688 then m_items
<- items;
3691 let active = self#calcactive
anchor in
3693 m_first
<- firstof m_first
active
3697 let enterselector sourcetype
=
3699 let source = outlinesource sourcetype
in
3702 match sourcetype
with
3703 | `bookmarks
-> Array.of_list state
.bookmarks
3704 | `
outlines -> state
.outlines
3705 | `history
-> genhistoutlines !Config.historder
3707 if Array.length
outlines = 0
3709 showtext ' ' errmsg
;
3712 state
.text <- source#greetmsg
;
3713 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3714 let anchor = getanchor
() in
3715 source#reset
anchor outlines;
3717 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3718 G.postRedisplay "enter selector";
3722 let enteroutlinemode =
3723 let f = enterselector `
outlines in
3724 fun () -> f "Document has no outline";
3727 let enterbookmarkmode =
3728 let f = enterselector `bookmarks
in
3729 fun () -> f "Document has no bookmarks (yet)";
3732 let enterhistmode () = enterselector `history
"No history (yet)";;
3734 let makecheckers () =
3735 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3737 converted by Issac Trotts. July 25, 2002 *)
3738 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3739 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3740 let id = GlTex.gen_texture
() in
3741 GlTex.bind_texture ~target
:`texture_2d
id;
3742 GlPix.store
(`unpack_alignment
1);
3743 GlTex.image2d
image;
3744 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3745 [ `mag_filter `nearest
; `min_filter `nearest
];
3749 let setcheckers enabled
=
3750 match state
.checkerstexid
with
3752 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3754 | Some checkerstexid
->
3757 GlTex.delete_texture checkerstexid
;
3758 state
.checkerstexid
<- None
;
3762 let describe_location () =
3763 let fn = page_of_y state
.y in
3764 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3765 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3769 else (100. *. (float state
.y /. float maxy))
3773 Printf.sprintf
"page %d of %d [%.2f%%]"
3774 (fn+1) state
.pagecount
percent
3777 "pages %d-%d of %d [%.2f%%]"
3778 (fn+1) (ln+1) state
.pagecount
percent
3781 let setpresentationmode v
=
3782 let n = page_of_y state
.y in
3783 state
.anchor <- (n, 0.0, 1.0);
3784 conf
.presentation
<- v
;
3785 if conf
.fitmodel
= FitPage
3786 then reqlayout conf
.angle conf
.fitmodel
;
3791 let btos b = if b then "@Uradical" else E.s in
3792 let showextended = ref false in
3793 let leave mode
_ = state
.mode
<- mode
in
3796 val mutable m_first_time
= true
3797 val mutable m_l
= []
3798 val mutable m_a
= E.a
3799 val mutable m_prev_uioh
= nouioh
3800 val mutable m_prev_mode
= View
3802 inherit lvsourcebase
3804 method reset prev_mode prev_uioh
=
3805 m_a
<- Array.of_list
(List.rev m_l
);
3807 m_prev_mode
<- prev_mode
;
3808 m_prev_uioh
<- prev_uioh
;
3812 if n >= Array.length m_a
3816 | _, _, _, Action
_ -> m_active
<- n
3817 | _, _, _, Noaction
-> loop (n+1)
3820 m_first_time
<- false;
3823 method int name get
set =
3825 (name
, `
int get
, 1, Action
(
3828 try set (int_of_string
s)
3830 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3834 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3835 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3839 method int_with_suffix name get
set =
3841 (name
, `intws get
, 1, Action
(
3844 try set (int_of_string_with_suffix
s)
3846 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3851 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3853 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3857 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3859 (name
, `
bool (btos, get
), offset
, Action
(
3866 method color name get
set =
3868 (name
, `color get
, 1, Action
(
3870 let invalid = (nan
, nan
, nan
) in
3873 try color_of_string
s
3875 state
.text <- Printf.sprintf
"bad color `%s': %s"
3882 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3883 state
.text <- color_to_string
(get
());
3884 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3888 method string name get
set =
3890 (name
, `
string get
, 1, Action
(
3892 let ondone s = set s in
3893 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3894 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3898 method colorspace name get
set =
3900 (name
, `
string get
, 1, Action
(
3904 inherit lvsourcebase
3907 m_active
<- CSTE.to_int conf
.colorspace
;
3910 method getitemcount
=
3911 Array.length
CSTE.names
3914 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3915 ignore
(uioh
, first, pan
);
3916 if not cancel
then set active;
3918 method hasaction
_ = true
3922 let modehash = findkeyhash conf
"info" in
3923 coe (new listview ~zebra
:false ~helpmode
:false
3924 ~
source ~trusted
:true ~
modehash)
3927 method paxmark name get
set =
3929 (name
, `
string get
, 1, Action
(
3933 inherit lvsourcebase
3936 m_active
<- MTE.to_int conf
.paxmark
;
3939 method getitemcount
= Array.length
MTE.names
3940 method getitem
n = (MTE.names
.(n), 0)
3941 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3942 ignore
(uioh
, first, pan
);
3943 if not cancel
then set active;
3945 method hasaction
_ = true
3949 let modehash = findkeyhash conf
"info" in
3950 coe (new listview ~zebra
:false ~helpmode
:false
3951 ~
source ~trusted
:true ~
modehash)
3954 method fitmodel name get
set =
3956 (name
, `
string get
, 1, Action
(
3960 inherit lvsourcebase
3963 m_active
<- FMTE.to_int conf
.fitmodel
;
3966 method getitemcount
= Array.length
FMTE.names
3967 method getitem
n = (FMTE.names
.(n), 0)
3968 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3969 ignore
(uioh
, first, pan
);
3970 if not cancel
then set active;
3972 method hasaction
_ = true
3976 let modehash = findkeyhash conf
"info" in
3977 coe (new listview ~zebra
:false ~helpmode
:false
3978 ~
source ~trusted
:true ~
modehash)
3981 method caption
s offset
=
3982 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3984 method caption2
s f offset
=
3985 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3987 method getitemcount
= Array.length m_a
3990 let tostr = function
3991 | `
int f -> string_of_int
(f ())
3992 | `intws
f -> string_with_suffix_of_int
(f ())
3994 | `color
f -> color_to_string
(f ())
3995 | `
bool (btos, f) -> btos (f ())
3998 let name, t
, offset
, _ = m_a
.(n) in
3999 ((let s = tostr t
in
4001 then Printf.sprintf
"%s\t%s" name s
4005 method exit ~uioh ~cancel ~
active ~
first ~pan
=
4010 match m_a
.(active) with
4011 | _, _, _, Action
f -> f uioh
4012 | _, _, _, Noaction
-> uioh
4023 method hasaction
n =
4025 | _, _, _, Action
_ -> true
4026 | _, _, _, Noaction
-> false
4029 let rec fillsrc prevmode prevuioh
=
4030 let sep () = src#caption
E.s 0 in
4031 let colorp name get
set =
4033 (fun () -> color_to_string
(get
()))
4036 let c = color_of_string
v in
4039 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
4042 let oldmode = state
.mode
in
4043 let birdseye = isbirdseye state
.mode
in
4045 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4047 src#
bool "presentation mode"
4048 (fun () -> conf
.presentation
)
4049 (fun v -> setpresentationmode v);
4051 src#
bool "ignore case in searches"
4052 (fun () -> conf
.icase
)
4053 (fun v -> conf
.icase
<- v);
4056 (fun () -> conf
.preload)
4057 (fun v -> conf
.preload <- v);
4059 src#
bool "highlight links"
4060 (fun () -> conf
.hlinks
)
4061 (fun v -> conf
.hlinks
<- v);
4063 src#
bool "under info"
4064 (fun () -> conf
.underinfo
)
4065 (fun v -> conf
.underinfo
<- v);
4067 src#
bool "persistent bookmarks"
4068 (fun () -> conf
.savebmarks
)
4069 (fun v -> conf
.savebmarks
<- v);
4071 src#fitmodel
"fit model"
4072 (fun () -> FMTE.to_string conf
.fitmodel
)
4073 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4075 src#
bool "trim margins"
4076 (fun () -> conf
.trimmargins
)
4077 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4079 src#
bool "persistent location"
4080 (fun () -> conf
.jumpback
)
4081 (fun v -> conf
.jumpback
<- v);
4084 src#
int "inter-page space"
4085 (fun () -> conf
.interpagespace
)
4087 conf
.interpagespace
<- n;
4088 docolumns conf
.columns
;
4090 match state
.layout with
4095 state
.maxy <- calcheight
();
4096 let y = getpagey
pageno in
4101 (fun () -> conf
.pagebias
)
4102 (fun v -> conf
.pagebias
<- v);
4104 src#
int "scroll step"
4105 (fun () -> conf
.scrollstep
)
4106 (fun n -> conf
.scrollstep
<- n);
4108 src#
int "horizontal scroll step"
4109 (fun () -> conf
.hscrollstep
)
4110 (fun v -> conf
.hscrollstep
<- v);
4112 src#
int "auto scroll step"
4114 match state
.autoscroll
with
4116 | _ -> conf
.autoscrollstep
)
4118 let n = boundastep state
.winh
n in
4119 if state
.autoscroll
<> None
4120 then state
.autoscroll
<- Some
n;
4121 conf
.autoscrollstep
<- n);
4124 (fun () -> truncate
(conf
.zoom *. 100.))
4125 (fun v -> setzoom ((float v) /. 100.));
4128 (fun () -> conf
.angle
)
4129 (fun v -> reqlayout v conf
.fitmodel
);
4131 src#
int "scroll bar width"
4132 (fun () -> conf
.scrollbw
)
4135 reshape state
.winw state
.winh
;
4138 src#
int "scroll handle height"
4139 (fun () -> conf
.scrollh
)
4140 (fun v -> conf
.scrollh
<- v;);
4142 src#
int "thumbnail width"
4143 (fun () -> conf
.thumbw
)
4145 conf
.thumbw
<- min
4096 v;
4148 leavebirdseye beye
false;
4155 let mode = state
.mode in
4156 src#
string "columns"
4158 match conf
.columns
with
4160 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4161 | Csplit
(count
, _) -> "-" ^ string_of_int count
4164 let n, a, b = multicolumns_of_string
v in
4165 setcolumns mode n a b);
4168 src#caption
"Pixmap cache" 0;
4169 src#int_with_suffix
"size (advisory)"
4170 (fun () -> conf
.memlimit
)
4171 (fun v -> conf
.memlimit
<- v);
4174 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4175 (string_with_suffix_of_int state
.memused
)
4176 (Hashtbl.length state
.tilemap
)) 1;
4179 src#caption
"Layout" 0;
4180 src#caption2
"Dimension"
4182 Printf.sprintf
"%dx%d (virtual %dx%d)"
4183 state
.winw state
.winh
4188 src#caption2
"Position" (fun () ->
4189 Printf.sprintf
"%dx%d" state
.x state
.y
4192 src#caption2
"Position" (fun () -> describe_location ()) 1
4196 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4197 "Save these parameters as global defaults at exit"
4198 (fun () -> conf
.bedefault
)
4199 (fun v -> conf
.bedefault
<- v)
4203 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4204 src#
bool ~offset
:0 ~
btos "Extended parameters"
4205 (fun () -> !showextended)
4206 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4210 (fun () -> conf
.checkers
)
4211 (fun v -> conf
.checkers
<- v; setcheckers v);
4212 src#
bool "update cursor"
4213 (fun () -> conf
.updatecurs
)
4214 (fun v -> conf
.updatecurs
<- v);
4215 src#
bool "scroll-bar on the left"
4216 (fun () -> conf
.leftscroll
)
4217 (fun v -> conf
.leftscroll
<- v);
4219 (fun () -> conf
.verbose
)
4220 (fun v -> conf
.verbose
<- v);
4221 src#
bool "invert colors"
4222 (fun () -> conf
.invert
)
4223 (fun v -> conf
.invert
<- v);
4225 (fun () -> conf
.maxhfit
)
4226 (fun v -> conf
.maxhfit
<- v);
4227 src#
bool "redirect stderr"
4228 (fun () -> conf
.redirectstderr)
4229 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4231 (fun () -> conf
.pax
!= None
)
4234 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4235 else conf
.pax
<- None
);
4236 src#
string "uri launcher"
4237 (fun () -> conf
.urilauncher
)
4238 (fun v -> conf
.urilauncher
<- v);
4239 src#
string "path launcher"
4240 (fun () -> conf
.pathlauncher
)
4241 (fun v -> conf
.pathlauncher
<- v);
4242 src#
string "tile size"
4243 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4246 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4247 conf
.tilew
<- max
64 w;
4248 conf
.tileh
<- max
64 h;
4251 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4254 src#
int "texture count"
4255 (fun () -> conf
.texcount
)
4258 then conf
.texcount
<- v
4259 else showtext '
!'
" Failed to set texture count please retry later"
4261 src#
int "slice height"
4262 (fun () -> conf
.sliceheight
)
4264 conf
.sliceheight
<- v;
4265 wcmd "sliceh %d" conf
.sliceheight
;
4267 src#
int "anti-aliasing level"
4268 (fun () -> conf
.aalevel
)
4270 conf
.aalevel
<- bound
v 0 8;
4271 state
.anchor <- getanchor
();
4272 opendoc state
.path state
.password
;
4274 src#
string "page scroll scaling factor"
4275 (fun () -> string_of_float conf
.pgscale)
4278 let s = float_of_string
v in
4281 state
.text <- Printf.sprintf
4282 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4285 src#
int "ui font size"
4286 (fun () -> fstate
.fontsize
)
4287 (fun v -> setfontsize (bound
v 5 100));
4288 src#
int "hint font size"
4289 (fun () -> conf
.hfsize
)
4290 (fun v -> conf
.hfsize
<- bound
v 5 100);
4291 colorp "background color"
4292 (fun () -> conf
.bgcolor
)
4293 (fun v -> conf
.bgcolor
<- v);
4294 src#
bool "crop hack"
4295 (fun () -> conf
.crophack
)
4296 (fun v -> conf
.crophack
<- v);
4297 src#
string "trim fuzz"
4298 (fun () -> irect_to_string conf
.trimfuzz
)
4301 conf
.trimfuzz
<- irect_of_string
v;
4303 then settrim true conf
.trimfuzz
;
4305 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4307 src#
string "throttle"
4309 match conf
.maxwait
with
4310 | None
-> "show place holder if page is not ready"
4313 then "wait for page to fully render"
4315 "wait " ^ string_of_float
time
4316 ^
" seconds before showing placeholder"
4320 let f = float_of_string
v in
4322 then conf
.maxwait
<- None
4323 else conf
.maxwait
<- Some
f
4325 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4327 src#
string "ghyll scroll"
4329 match conf
.ghyllscroll
with
4331 | Some nab
-> ghyllscroll_to_string nab
4334 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4336 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4338 src#
string "selection command"
4339 (fun () -> conf
.selcmd
)
4340 (fun v -> conf
.selcmd
<- v);
4341 src#
string "synctex command"
4342 (fun () -> conf
.stcmd
)
4343 (fun v -> conf
.stcmd
<- v);
4344 src#
string "pax command"
4345 (fun () -> conf
.paxcmd
)
4346 (fun v -> conf
.paxcmd
<- v);
4347 src#colorspace
"color space"
4348 (fun () -> CSTE.to_string conf
.colorspace
)
4350 conf
.colorspace
<- CSTE.of_int
v;
4354 src#paxmark
"pax mark method"
4355 (fun () -> MTE.to_string conf
.paxmark
)
4356 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4360 (fun () -> conf
.usepbo
)
4361 (fun v -> conf
.usepbo
<- v);
4362 src#
bool "mouse wheel scrolls pages"
4363 (fun () -> conf
.wheelbypage
)
4364 (fun v -> conf
.wheelbypage
<- v);
4365 src#
bool "open remote links in a new instance"
4366 (fun () -> conf
.riani
)
4367 (fun v -> conf
.riani
<- v);
4371 src#caption
"Document" 0;
4372 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4373 src#caption2
"Pages"
4374 (fun () -> string_of_int state
.pagecount
) 1;
4375 src#caption2
"Dimensions"
4376 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4380 src#caption
"Trimmed margins" 0;
4381 src#caption2
"Dimensions"
4382 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4386 src#caption
"OpenGL" 0;
4387 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4388 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4391 src#caption
"Location" 0;
4392 if nonemptystr state
.origin
4393 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4394 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4396 src#reset prevmode prevuioh
;
4401 let prevmode = state
.mode
4402 and prevuioh
= state
.uioh in
4403 fillsrc prevmode prevuioh
;
4404 let source = (src :> lvsource
) in
4405 let modehash = findkeyhash conf
"info" in
4406 state
.uioh <- coe (object (self)
4407 inherit listview ~zebra
:false ~helpmode
:false
4408 ~
source ~trusted
:true ~
modehash as super
4409 val mutable m_prevmemused
= 0
4410 method! infochanged
= function
4412 if m_prevmemused
!= state
.memused
4414 m_prevmemused
<- state
.memused
;
4415 G.postRedisplay "memusedchanged";
4417 | Pdim
-> G.postRedisplay "pdimchanged"
4418 | Docinfo
-> fillsrc prevmode prevuioh
4420 method! key key mask
=
4421 if not
(Wsi.withctrl mask
)
4424 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4425 | @right
| @kpright
-> coe (self#updownlevel
1)
4426 | _ -> super#
key key mask
4427 else super#
key key mask
4429 G.postRedisplay "info";
4435 inherit lvsourcebase
4436 method getitemcount
= Array.length state
.help
4438 let s, l, _ = state
.help
.(n) in
4441 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4445 match state
.help
.(active) with
4446 | _, _, Action
f -> Some
(f uioh)
4447 | _, _, Noaction
-> Some
uioh
4456 method hasaction
n =
4457 match state
.help
.(n) with
4458 | _, _, Action
_ -> true
4459 | _, _, Noaction
-> false
4465 let modehash = findkeyhash conf
"help" in
4467 state
.uioh <- coe (new listview
4468 ~zebra
:false ~helpmode
:true
4469 ~
source ~trusted
:true ~
modehash);
4470 G.postRedisplay "help";
4475 let re = Str.regexp
"[\r\n]" in
4477 inherit lvsourcebase
4478 val mutable m_items
= E.a
4480 method getitemcount
= 1 + Array.length m_items
4485 else m_items
.(n-1), 0
4487 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4492 then Buffer.clear state
.errmsgs
;
4499 method hasaction
n =
4503 state
.newerrmsgs
<- false;
4504 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4505 m_items
<- Array.of_list
l
4514 let source = (msgsource :> lvsource
) in
4515 let modehash = findkeyhash conf
"listview" in
4516 state
.uioh <- coe (object
4517 inherit listview ~zebra
:false ~helpmode
:false
4518 ~
source ~trusted
:false ~
modehash as super
4521 then msgsource#reset
;
4524 G.postRedisplay "msgs";
4527 let quickbookmark ?title
() =
4528 match state
.layout with
4534 let tm = Unix.localtime
(now
()) in
4535 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4539 (tm.Unix.tm_year
+ 1900)
4542 | Some
title -> title
4544 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4547 let setautoscrollspeed step goingdown
=
4548 let incr = max
1 ((abs step
) / 2) in
4549 let incr = if goingdown
then incr else -incr in
4550 let astep = boundastep state
.winh
(step
+ incr) in
4551 state
.autoscroll
<- Some
astep;
4555 match conf
.columns
with
4557 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4560 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4562 let existsinrow pageno (columns
, coverA
, coverB
) p =
4563 let last = ((pageno - coverA
) mod columns
) + columns
in
4564 let rec any = function
4567 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4571 then (if l.pageno = last then false else any rest
)
4579 match state
.layout with
4581 let pageno = page_of_y state
.y in
4582 gotoghyll (getpagey
(pageno+1))
4584 match conf
.columns
with
4586 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4588 let y = clamp (pgscale state
.winh
) in
4591 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4592 gotoghyll (getpagey
pageno)
4593 | Cmulti
((c, _, _) as cl, _) ->
4594 if conf
.presentation
4595 && (existsinrow l.pageno cl
4596 (fun l -> l.pageh
> l.pagey + l.pagevh))
4598 let y = clamp (pgscale state
.winh
) in
4601 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4602 gotoghyll (getpagey
pageno)
4604 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4606 let pagey, pageh
= getpageyh
l.pageno in
4607 let pagey = pagey + pageh
* l.pagecol
in
4608 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4609 gotoghyll (pagey + pageh
+ ips)
4613 match state
.layout with
4615 let pageno = page_of_y state
.y in
4616 gotoghyll (getpagey
(pageno-1))
4618 match conf
.columns
with
4620 if conf
.presentation
&& l.pagey != 0
4622 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4624 let pageno = max
0 (l.pageno-1) in
4625 gotoghyll (getpagey
pageno)
4626 | Cmulti
((c, _, coverB
) as cl, _) ->
4627 if conf
.presentation
&&
4628 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4630 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4633 if l.pageno = state
.pagecount
- coverB
4637 let pageno = max
0 (l.pageno-decr) in
4638 gotoghyll (getpagey
pageno)
4646 let pageno = max
0 (l.pageno-1) in
4647 let pagey, pageh
= getpageyh
pageno in
4650 let pagey, pageh
= getpageyh
l.pageno in
4651 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4656 let viewkeyboard key mask
=
4658 let mode = state
.mode in
4659 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4662 G.postRedisplay "view:enttext"
4664 let ctrl = Wsi.withctrl mask
in
4666 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4671 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4673 state
.mode <- LinkNav
(Ltgendir
0);
4676 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4679 begin match state
.mstate
with
4682 G.postRedisplay "kill zoom rect";
4685 | Mscrolly
| Mscrollx
4688 begin match state
.mode with
4691 G.postRedisplay "esc leave linknav"
4695 match state
.ranchors
with
4697 | (path, password
, anchor, origin
) :: rest
->
4698 state
.ranchors
<- rest
;
4699 state
.anchor <- anchor;
4700 state
.origin
<- origin
;
4701 state
.nameddest
<- E.s;
4702 opendoc path password
4707 gotoghyll (getnav ~
-1)
4718 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4719 G.postRedisplay "dehighlight";
4721 | @slash
| @question
->
4722 let ondone isforw
s =
4723 cbput state
.hists
.pat
s;
4724 state
.searchpattern
<- s;
4727 let s = String.make
1 (Char.chr
key) in
4728 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4729 textentry, ondone (key = @slash
), true)
4731 | @plus
| @kpplus
| @equals
when ctrl ->
4732 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4733 setzoom (conf
.zoom +. incr)
4735 | @plus
| @kpplus
->
4738 try int_of_string
s with exc
->
4739 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4745 state
.text <- "page bias is now " ^ string_of_int
n;
4748 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4750 | @minus
| @kpminus
when ctrl ->
4751 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4752 setzoom (max
0.01 (conf
.zoom -. decr))
4754 | @minus
| @kpminus
->
4755 let ondone msg
= state
.text <- msg
in
4757 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4758 optentry state
.mode, ondone, true
4769 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4771 match conf
.columns
with
4772 | Csingle
_ | Cmulti
_ -> 1
4773 | Csplit
(n, _) -> n
4775 let h = state
.winh
-
4776 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4778 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4779 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4784 match conf
.fitmodel
with
4785 | FitWidth
-> FitProportional
4786 | FitProportional
-> FitPage
4787 | FitPage
-> FitWidth
4789 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4790 reqlayout conf
.angle
fm
4798 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4799 when not
ctrl -> (* 0..9 *)
4802 try int_of_string
s with exc
->
4803 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4809 cbput state
.hists
.pag
(string_of_int
n);
4810 gotopage1 (n + conf
.pagebias
- 1) 0;
4813 let pageentry text key =
4814 match Char.unsafe_chr
key with
4815 | '
g'
-> TEdone
text
4816 | _ -> intentry text key
4818 let text = String.make
1 (Char.chr
key) in
4819 enttext (":", text, Some
(onhist state
.hists
.pag
),
4820 pageentry, ondone, true)
4823 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4824 reshape state
.winw state
.winh
;
4827 state
.bzoom
<- not state
.bzoom
;
4829 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4832 conf
.hlinks
<- not conf
.hlinks
;
4833 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4834 G.postRedisplay "toggle highlightlinks";
4837 state
.glinks
<- true;
4838 let mode = state
.mode in
4839 state
.mode <- Textentry
(
4840 (":", E.s, None
, linknentry, linkndone gotounder, false),
4842 state
.glinks
<- false;
4846 G.postRedisplay "view:linkent(F)"
4849 state
.glinks
<- true;
4850 let mode = state
.mode in
4851 state
.mode <- Textentry
(
4853 ":", E.s, None
, linknentry, linkndone (fun under ->
4854 selstring (undertext under);
4858 state
.glinks
<- false;
4862 G.postRedisplay "view:linkent"
4865 begin match state
.autoscroll
with
4867 conf
.autoscrollstep
<- step
;
4868 state
.autoscroll
<- None
4870 if conf
.autoscrollstep
= 0
4871 then state
.autoscroll
<- Some
1
4872 else state
.autoscroll
<- Some conf
.autoscrollstep
4879 setpresentationmode (not conf
.presentation
);
4880 showtext ' '
("presentation mode " ^
4881 if conf
.presentation
then "on" else "off");
4884 if List.mem
Wsi.Fullscreen state
.winstate
4885 then Wsi.reshape conf
.cwinw conf
.cwinh
4886 else Wsi.fullscreen
()
4889 search state
.searchpattern
false
4892 search state
.searchpattern
true
4895 begin match state
.layout with
4898 gotoghyll (getpagey
l.pageno)
4904 | @delete
| @kpdelete
-> (* delete *)
4908 showtext ' '
(describe_location ());
4911 begin match state
.layout with
4914 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4919 enterbookmarkmode ()
4927 | @e when Buffer.length state
.errmsgs
> 0 ->
4932 match state
.layout with
4937 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4940 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
4944 showtext ' '
"Quick bookmark added";
4947 begin match state
.layout with
4949 let rect = getpdimrect
l.pagedimno
in
4953 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
4954 truncate
(1.2 *. (rect.(3) -. rect.(0))))
4956 (truncate
(rect.(1) -. rect.(0)),
4957 truncate
(rect.(3) -. rect.(0)))
4959 let w = truncate
((float w)*.conf
.zoom)
4960 and h = truncate
((float h)*.conf
.zoom) in
4963 state
.anchor <- getanchor
();
4964 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
4966 G.postRedisplay "z";
4971 | @x -> state
.roam
()
4974 reqlayout (conf
.angle
+
4975 (if key = @Gt
then 30 else -30)) conf
.fitmodel
4979 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
4981 G.postRedisplay "brightness";
4983 | @c when state
.mode = View
->
4988 let m = (wadjsb state
.winw
- state
.w) / 2 in
4990 gotoy_and_clear_text state
.y
4994 match state
.prevcolumns
with
4995 | None
-> (1, 0, 0), 1.0
4996 | Some
(columns
, z
) ->
4999 | Csplit
(c, _) -> -c, 0, 0
5000 | Cmulti
((c, a, b), _) -> c, a, b
5001 | Csingle
_ -> 1, 0, 0
5005 setcolumns View
c a b;
5008 | @down
| @up
when ctrl && Wsi.withshift mask
->
5009 let zoom, x = state
.prevzoom
in
5013 | @k
| @up
| @kpup
->
5014 begin match state
.autoscroll
with
5016 begin match state
.mode with
5017 | Birdseye beye
-> upbirdseye 1 beye
5022 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5024 if not
(Wsi.withshift mask
) && conf
.presentation
5026 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5030 setautoscrollspeed n false
5033 | @j
| @down
| @kpdown
->
5034 begin match state
.autoscroll
with
5036 begin match state
.mode with
5037 | Birdseye beye
-> downbirdseye 1 beye
5042 then gotoy_and_clear_text (clamp (state
.winh
/2))
5044 if not
(Wsi.withshift mask
) && conf
.presentation
5046 else gotoghyll1 true (clamp (conf
.scrollstep
))
5050 setautoscrollspeed n true
5053 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5059 else conf
.hscrollstep
5061 let dx = if key = @left || key = @kpleft
then dx else -dx in
5062 state
.x <- panbound (state
.x + dx);
5063 gotoy_and_clear_text state
.y
5066 G.postRedisplay "left/right"
5069 | @prior
| @kpprior
->
5073 match state
.layout with
5075 | l :: _ -> state
.y - l.pagey
5077 clamp (pgscale (-state
.winh
))
5081 | @next | @kpnext
->
5085 match List.rev state
.layout with
5087 | l :: _ -> getpagey
l.pageno
5089 clamp (pgscale state
.winh
)
5093 | @g | @home
| @kphome
->
5096 | @G
| @jend
| @kpend
->
5098 gotoghyll (clamp state
.maxy)
5100 | @right
| @kpright
when Wsi.withalt mask
->
5101 gotoghyll (getnav 1)
5102 | @left | @kpleft
when Wsi.withalt mask
->
5103 gotoghyll (getnav ~
-1)
5108 | @v when conf
.debug
->
5111 match getopaque l.pageno with
5114 let x0, y0, x1, y1 = pagebbox
opaque in
5115 let a,b = float x0, float y0 in
5116 let c,d = float x1, float y0 in
5117 let e,f = float x1, float y1 in
5118 let h,j
= float x0, float y1 in
5119 let rect = (a,b,c,d,e,f,h,j
) in
5121 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5123 G.postRedisplay "v";
5126 let mode = state
.mode in
5127 let cmd = ref E.s in
5128 let onleave = function
5129 | Cancel
-> state
.mode <- mode
5132 match getopaque l.pageno with
5133 | Some
opaque -> pipesel opaque !cmd
5134 | None
-> ()) state
.layout;
5138 cbput state
.hists
.sel
s;
5142 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5144 G.postRedisplay "|";
5145 state
.mode <- Textentry
(te, onleave);
5148 vlog "huh? %s" (Wsi.keyname
key)
5151 let linknavkeyboard key mask
linknav =
5152 let getpage pageno =
5153 let rec loop = function
5155 | l :: _ when l.pageno = pageno -> Some
l
5156 | _ :: rest
-> loop rest
5157 in loop state
.layout
5159 let doexact (pageno, n) =
5160 match getopaque pageno, getpage pageno with
5161 | Some
opaque, Some
l ->
5162 if key = @enter
|| key = @kpenter
5164 let under = getlink
opaque n in
5165 G.postRedisplay "link gotounder";
5172 Some
(findlink
opaque LDfirst
), -1
5175 Some
(findlink
opaque LDlast
), 1
5178 Some
(findlink
opaque (LDleft
n)), -1
5181 Some
(findlink
opaque (LDright
n)), 1
5184 Some
(findlink
opaque (LDup
n)), -1
5187 Some
(findlink
opaque (LDdown
n)), 1
5192 begin match findpwl
l.pageno dir with
5196 state
.mode <- LinkNav
(Ltgendir
dir);
5197 let y, h = getpageyh
pageno in
5200 then y + h - state
.winh
5205 begin match getopaque pageno, getpage pageno with
5206 | Some
opaque, Some
_ ->
5208 let ld = if dir > 0 then LDfirst
else LDlast
in
5211 begin match link with
5213 showlinktype (getlink
opaque m);
5214 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5215 G.postRedisplay "linknav jpage";
5216 | Lnotfound
-> notfound dir
5222 begin match opt with
5223 | Some Lnotfound
-> pwl l dir;
5224 | Some
(Lfound
m) ->
5228 let _, y0, _, y1 = getlinkrect
opaque m in
5230 then gotopage1 l.pageno y0
5232 let d = fstate
.fontsize
+ 1 in
5233 if y1 - l.pagey > l.pagevh - d
5234 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5235 else G.postRedisplay "linknav";
5237 showlinktype (getlink
opaque m);
5238 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5241 | None
-> viewkeyboard key mask
5243 | _ -> viewkeyboard key mask
5248 G.postRedisplay "leave linknav"
5252 | Ltgendir
_ -> viewkeyboard key mask
5253 | Ltexact exact
-> doexact exact
5256 let keyboard key mask
=
5257 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5258 then wcmd "interrupt"
5259 else state
.uioh <- state
.uioh#
key key mask
5262 let birdseyekeyboard key mask
5263 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5265 match conf
.columns
with
5267 | Cmulti
((c, _, _), _) -> c
5268 | Csplit
_ -> failwith
"bird's eye split mode"
5270 let pgh layout = List.fold_left
5271 (fun m l -> max
l.pageh
m) state
.winh
layout in
5273 | @l when Wsi.withctrl mask
->
5274 let y, h = getpageyh
pageno in
5275 let top = (state
.winh
- h) / 2 in
5276 gotoy (max
0 (y - top))
5277 | @enter
| @kpenter
-> leavebirdseye beye
false
5278 | @escape
-> leavebirdseye beye
true
5279 | @up
-> upbirdseye incr beye
5280 | @down
-> downbirdseye incr beye
5281 | @left -> upbirdseye 1 beye
5282 | @right
-> downbirdseye 1 beye
5285 begin match state
.layout with
5289 state
.mode <- Birdseye
(
5290 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5292 gotopage1 l.pageno 0;
5295 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5297 | [] -> gotoy (clamp (-state
.winh
))
5299 state
.mode <- Birdseye
(
5300 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5302 gotopage1 l.pageno 0
5305 | [] -> gotoy (clamp (-state
.winh
))
5309 begin match List.rev state
.layout with
5311 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5312 begin match layout with
5314 let incr = l.pageh
- l.pagevh in
5319 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5321 G.postRedisplay "birdseye pagedown";
5323 else gotoy (clamp (incr + conf
.interpagespace
*2));
5327 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5328 gotopage1 l.pageno 0;
5331 | [] -> gotoy (clamp state
.winh
)
5335 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5339 let pageno = state
.pagecount
- 1 in
5340 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5341 if not
(pagevisible state
.layout pageno)
5344 match List.rev state
.pdims
with
5346 | (_, _, h, _) :: _ -> h
5348 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5349 else G.postRedisplay "birdseye end";
5351 | _ -> viewkeyboard key mask
5356 match state
.mode with
5357 | Textentry
_ -> scalecolor 0.4
5359 | View
-> scalecolor 1.0
5360 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5361 if l.pageno = hooverpageno
5364 if l.pageno = pageno
5366 let c = scalecolor 1.0 in
5368 GlDraw.line_width
3.0;
5369 let dispx = xadjsb l.pagedispx in
5371 (float (dispx-1)) (float (l.pagedispy-1))
5372 (float (dispx+l.pagevw+1))
5373 (float (l.pagedispy+l.pagevh+1))
5375 GlDraw.line_width
1.0;
5384 let postdrawpage l linkindexbase
=
5385 match getopaque l.pageno with
5387 if tileready l l.pagex
l.pagey
5389 let x = l.pagedispx - l.pagex
+ xadjsb 0
5390 and y = l.pagedispy - l.pagey in
5392 match conf
.columns
with
5393 | Csingle
_ | Cmulti
_ ->
5394 (if conf
.hlinks
then 1 else 0)
5396 && not
(isbirdseye state
.mode) then 2 else 0)
5400 match state
.mode with
5401 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5407 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5412 let scrollindicator () =
5413 let sbw, ph
, sh = state
.uioh#
scrollph in
5414 let sbh, pw, sw = state
.uioh#scrollpw
in
5419 else (state
.winw
- sbw), state
.winw
5422 GlDraw.color (0.64, 0.64, 0.64);
5423 filledrect (float x0) 0. (float x1) (float state
.winh
);
5425 0. (float (state
.winh
- sbh))
5426 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5428 GlDraw.color (0.0, 0.0, 0.0);
5430 filledrect (float x0) ph
(float x1) (ph
+. sh);
5431 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5435 match state
.mstate
with
5436 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5439 | Msel
((x0, y0), (x1, y1)) ->
5440 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5441 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5442 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5443 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5446 let showrects = function [] -> () | rects
->
5448 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5449 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5451 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5453 if l.pageno = pageno
5455 let dx = float (l.pagedispx - l.pagex
) in
5456 let dy = float (l.pagedispy - l.pagey) in
5457 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5458 Raw.sets_float state
.vraw ~
pos:0
5463 GlArray.vertex `two state
.vraw
;
5464 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5473 GlClear.color (scalecolor2 conf
.bgcolor
);
5474 GlClear.clear
[`
color];
5475 List.iter
drawpage state
.layout;
5477 match state
.mode with
5478 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5479 begin match getopaque pageno with
5481 let dx = xadjsb 0 in
5482 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5483 let x0 = x0 + dx and x1 = x1 + dx in
5490 | None
-> state
.rects
5492 | LinkNav
(Ltgendir
_)
5495 | View
-> state
.rects
5498 let rec postloop linkindexbase
= function
5500 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5501 postloop linkindexbase rest
5505 postloop 0 state
.layout;
5507 begin match state
.mstate
with
5508 | Mzoomrect
((x0, y0), (x1, y1)) ->
5510 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5511 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5512 filledrect (float x0) (float y0) (float x1) (float y1);
5516 | Mscrolly
| Mscrollx
5525 let zoomrect x y x1 y1 =
5528 and y0 = min
y y1 in
5529 gotoy (state
.y + y0);
5530 state
.anchor <- getanchor
();
5531 let zoom = (float state
.w) /. float (x1 - x0) in
5534 let adjw = wadjsb state
.winw
in
5536 then (adjw - state
.w) / 2
5539 match conf
.fitmodel
with
5540 | FitWidth
| FitProportional
-> simple ()
5542 match conf
.columns
with
5544 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5545 | Cmulti
_ | Csingle
_ -> simple ()
5547 state
.x <- (state
.x + margin) - x0;
5553 let g opaque l px py =
5554 match rectofblock
opaque px py with
5556 let x0 = a.(0) -. 20. in
5557 let x1 = a.(1) +. 20. in
5558 let y0 = a.(2) -. 20. in
5559 let zoom = (float state
.w) /. (x1 -. x0) in
5560 let pagey = getpagey
l.pageno in
5561 gotoy_and_clear_text (pagey + truncate
y0);
5562 state
.anchor <- getanchor
();
5563 let margin = (state
.w - l.pagew
)/2 in
5564 state
.x <- -truncate
x0 - margin;
5569 match conf
.columns
with
5571 showtext '
!'
"block zooming does not work properly in split columns mode"
5572 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5576 let winw = wadjsb state
.winw - 1 in
5577 let s = float x /. float winw in
5578 let destx = truncate
(float (state
.w + winw) *. s) in
5579 state
.x <- winw - destx;
5580 gotoy_and_clear_text state
.y;
5581 state
.mstate
<- Mscrollx
;
5585 let s = float y /. float state
.winh
in
5586 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5587 gotoy_and_clear_text desty;
5588 state
.mstate
<- Mscrolly
;
5591 let viewmulticlick clicks
x y mask
=
5592 let g opaque l px py =
5600 if markunder
opaque px py mark
5604 match getopaque l.pageno with
5606 | Some
opaque -> pipesel opaque cmd
5608 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5609 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5614 G.postRedisplay "viewmulticlick";
5615 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5619 match conf
.columns
with
5621 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5624 let viewmouse button down
x y mask
=
5626 | n when (n == 4 || n == 5) && not down
->
5627 if Wsi.withctrl mask
5629 match state
.mstate
with
5630 | Mzoom
(oldn
, i
) ->
5638 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5640 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5642 let zoom = conf
.zoom -. incr in
5644 state
.mstate
<- Mzoom
(n, 0);
5646 state
.mstate
<- Mzoom
(n, i
+1);
5648 else state
.mstate
<- Mzoom
(n, 0)
5652 | Mscrolly
| Mscrollx
5654 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5657 match state
.autoscroll
with
5658 | Some step
-> setautoscrollspeed step
(n=4)
5660 if conf
.wheelbypage
|| conf
.presentation
5669 then -conf
.scrollstep
5670 else conf
.scrollstep
5672 let incr = incr * 2 in
5673 let y = clamp incr in
5674 gotoy_and_clear_text y
5677 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5679 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5680 gotoy_and_clear_text state
.y
5682 | 1 when Wsi.withshift mask
->
5683 state
.mstate
<- Mnone
;
5686 match unproject x y with
5687 | Some
(pageno, ux
, uy
) ->
5688 let cmd = Printf.sprintf
5690 conf
.stcmd state
.path pageno ux uy
5696 | 1 when Wsi.withctrl mask
->
5699 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5700 state
.mstate
<- Mpan
(x, y)
5703 state
.mstate
<- Mnone
5708 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5710 state
.mstate
<- Mzoomrect
(p, p)
5713 match state
.mstate
with
5714 | Mzoomrect
((x0, y0), _) ->
5715 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5716 then zoomrect x0 y0 x y
5719 G.postRedisplay "kill accidental zoom rect";
5723 | Mscrolly
| Mscrollx
5729 | 1 when x > state
.winw - vscrollw () ->
5732 let _, position, sh = state
.uioh#
scrollph in
5733 if y > truncate
position && y < truncate
(position +. sh)
5734 then state
.mstate
<- Mscrolly
5737 state
.mstate
<- Mnone
5739 | 1 when y > state
.winh
- hscrollh () ->
5742 let _, position, sw = state
.uioh#scrollpw
in
5743 if x > truncate
position && x < truncate
(position +. sw)
5744 then state
.mstate
<- Mscrollx
5747 state
.mstate
<- Mnone
5749 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5752 let dest = if down
then getunder x y else Unone
in
5753 begin match dest with
5756 | Uremote
_ | Uremotedest
_
5757 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5760 | Unone
when down
->
5761 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5762 state
.mstate
<- Mpan
(x, y);
5764 | Unone
| Utext
_ ->
5769 state
.mstate
<- Msel
((x, y), (x, y));
5770 G.postRedisplay "mouse select";
5774 match state
.mstate
with
5777 | Mzoom
_ | Mscrollx
| Mscrolly
->
5778 state
.mstate
<- Mnone
5780 | Mzoomrect
((x0, y0), _) ->
5784 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5785 state
.mstate
<- Mnone
5787 | Msel
((x0, y0), (x1, y1)) ->
5788 let rec loop = function
5792 let a0 = l.pagedispy in
5793 let a1 = a0 + l.pagevh in
5794 let b0 = l.pagedispx in
5795 let b1 = b0 + l.pagevw in
5796 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5797 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5801 match getopaque l.pageno with
5804 match Unix.pipe
() with
5808 "can not create sel pipe: %s"
5812 Ne.clo fd
(fun msg
->
5813 dolog
"%s close failed: %s" what msg
)
5816 try popen
cmd [r, 0; w, -1]; true
5818 dolog
"can not execute %S: %s"
5825 G.postRedisplay "copysel";
5827 else clo "Msel pipe/w" w;
5828 clo "Msel pipe/r" r;
5830 dosel conf
.selcmd
();
5831 state
.roam
<- dosel conf
.paxcmd
;
5843 let birdseyemouse button down
x y mask
5844 (conf
, leftx
, _, hooverpageno
, anchor) =
5847 let rec loop = function
5850 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5851 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5853 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5859 | _ -> viewmouse button down
x y mask
5865 method key key mask
=
5866 begin match state
.mode with
5867 | Textentry
textentry -> textentrykeyboard key mask
textentry
5868 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5869 | View
-> viewkeyboard key mask
5870 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5874 method button button bstate
x y mask
=
5875 begin match state
.mode with
5877 | View
-> viewmouse button bstate
x y mask
5878 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5883 method multiclick clicks
x y mask
=
5884 begin match state
.mode with
5886 | View
-> viewmulticlick clicks
x y mask
5893 begin match state
.mode with
5895 | View
| Birdseye
_ | LinkNav
_ ->
5896 match state
.mstate
with
5897 | Mzoom
_ | Mnone
-> ()
5902 state
.mstate
<- Mpan
(x, y);
5904 then state
.x <- panbound (state
.x + dx);
5906 gotoy_and_clear_text y
5909 state
.mstate
<- Msel
(a, (x, y));
5910 G.postRedisplay "motion select";
5913 let y = min state
.winh
(max
0 y) in
5917 let x = min state
.winw (max
0 x) in
5920 | Mzoomrect
(p0
, _) ->
5921 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5922 G.postRedisplay "motion zoomrect";
5926 method pmotion
x y =
5927 begin match state
.mode with
5928 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5929 let rec loop = function
5931 if hooverpageno
!= -1
5933 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5934 G.postRedisplay "pmotion birdseye no hoover";
5937 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5938 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5940 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
5941 G.postRedisplay "pmotion birdseye hoover";
5951 match state
.mstate
with
5952 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
5961 let past, _, _ = !r in
5963 let delta = now -. past in
5966 else r := (now, x, y)
5970 method infochanged
_ = ()
5973 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
5976 then 0.0, float state
.winh
5977 else scrollph state
.y maxy
5982 let winw = wadjsb state
.winw in
5983 let fwinw = float winw in
5985 let sw = fwinw /. float state
.w in
5986 let sw = fwinw *. sw in
5987 max
sw (float conf
.scrollh
)
5990 let maxx = state
.w + winw in
5991 let x = winw - state
.x in
5992 let percent = float x /. float maxx in
5993 (fwinw -. sw) *. percent
5995 hscrollh (), position, sw
5999 match state
.mode with
6000 | LinkNav
_ -> "links"
6001 | Textentry
_ -> "textentry"
6002 | Birdseye
_ -> "birdseye"
6005 findkeyhash conf
modename
6007 method eformsgs
= true
6010 let adderrmsg src msg
=
6011 Buffer.add_string state
.errmsgs msg
;
6012 state
.newerrmsgs
<- true;
6016 let adderrfmt src fmt
=
6017 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6021 let cl = splitatspace cmds
in
6023 try Scanf.sscanf
s fmt
f
6025 adderrfmt "remote exec"
6026 "error processing '%S': %s\n" cmds
(exntos exn
)
6029 | "reload" :: [] -> reload ()
6030 | "goto" :: args
:: [] ->
6031 scan args
"%u %f %f"
6033 let cmd, _ = state
.geomcmds
in
6035 then gotopagexy pageno x y
6038 gotopagexy pageno x y;
6041 state
.reprf
<- f state
.reprf
6043 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6044 | "gotor" :: args
:: [] ->
6046 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6047 | "gotord" :: args
:: [] ->
6049 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6050 | "rect" :: args
:: [] ->
6051 scan args
"%u %u %f %f %f %f"
6052 (fun pageno color x0 y0 x1 y1 ->
6053 onpagerect pageno (fun w h ->
6054 let _,w1,h1
,_ = getpagedim
pageno in
6055 let sw = float w1 /. float w
6056 and sh = float h1
/. float h in
6060 and y1s
= y1 *. sh in
6061 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6063 state
.rects <- (pageno, color, rect) :: state
.rects;
6064 G.postRedisplay "rect";
6067 | "activatewin" :: [] -> Wsi.activatewin
()
6068 | "quit" :: [] -> raise Quit
6070 adderrfmt "remote command"
6071 "error processing remote command: %S\n" cmds
;
6075 let scratch = Bytes.create
80 in
6076 let buf = Buffer.create
80 in
6079 try Some
(Unix.read fd
scratch 0 80)
6081 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6082 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6085 match tempfr () with
6091 if Buffer.length
buf > 0
6093 let s = Buffer.contents
buf in
6103 let pos = Bytes.index_from
scratch ppos '
\n'
in
6104 if pos >= n then -1 else pos
6105 with Not_found
-> -1
6109 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6110 let s = Buffer.contents
buf in
6116 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6122 let remoteopen path =
6123 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6125 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6130 let gcconfig = ref E.s in
6131 let trimcachepath = ref E.s in
6132 let rcmdpath = ref E.s in
6133 let pageno = ref None
in
6134 let rootwid = ref 0 in
6135 let openlast = ref false in
6136 let nofc = ref false in
6137 selfexec := Sys.executable_name
;
6140 [("-p", Arg.String
(fun s -> state
.password
<- s),
6141 "<password> Set password");
6145 Config.fontpath
:= s;
6146 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6148 "<path> Set path to the user interface font");
6152 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6153 Config.confpath
:= s),
6154 "<path> Set path to the configuration file");
6156 ("-last", Arg.Set
openlast, " Open last document");
6158 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6159 "<page-number> Jump to page");
6161 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6162 "<path> Set path to the trim cache file");
6164 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6165 "<named-destination> Set named destination");
6167 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6168 ("-cxack", Arg.Set
cxack, " Cut corners");
6170 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6171 "<path> Set path to the remote commands source");
6173 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6174 "<original-path> Set original path");
6176 ("-gc", Arg.Set_string
gcconfig,
6177 "<script-path> Collect garbage with the help of a script");
6179 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6181 ("-v", Arg.Unit
(fun () ->
6183 "%s\nconfiguration path: %s\n"
6187 exit
0), " Print version and exit");
6189 ("-embed", Arg.Set_int
rootwid,
6190 "<window-id> Embed into window")
6193 (fun s -> state
.path <- s)
6194 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6197 then selfexec := !selfexec ^
" -wtmode";
6199 let histmode = emptystr state
.path && not
!openlast in
6201 if not
(Config.load !openlast)
6202 then prerr_endline
"failed to load configuration";
6203 begin match !pageno with
6204 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6208 if not
(emptystr
!gcconfig)
6211 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6213 error
"gc socketpair failed: %s" (exntos exn
)
6216 match popen
!gcconfig [(c, 0); (c, 1)] with
6221 error
"failed to popen gc script: %s" (exntos exn
);
6224 let wsfd, winw, winh
= Wsi.init
(object (self)
6225 val mutable m_clicks
= 0
6226 val mutable m_click_x
= 0
6227 val mutable m_click_y
= 0
6228 val mutable m_lastclicktime
= infinity
6230 method private cleanup
=
6231 state
.roam
<- noroam
;
6232 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6233 method expose
= G.postRedisplay"expose"
6237 | Wsi.Unobscured
-> "unobscured"
6238 | Wsi.PartiallyObscured
-> "partiallyobscured"
6239 | Wsi.FullyObscured
-> "fullyobscured"
6241 vlog "visibility change %s" name
6242 method display = display ()
6243 method map mapped
= vlog "mappped %b" mapped
6244 method reshape w h =
6247 method mouse
b d x y m =
6248 if d && canselect ()
6250 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6256 if abs
x - m_click_x
> 10
6257 || abs
y - m_click_y
> 10
6258 || abs_float
(t -. m_lastclicktime
) > 0.3
6260 m_clicks
<- m_clicks
+ 1;
6261 m_lastclicktime
<- t;
6265 G.postRedisplay "cleanup";
6266 state
.uioh <- state
.uioh#button
b d x y m;
6268 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6273 m_lastclicktime
<- infinity
;
6274 state
.uioh <- state
.uioh#button
b d x y m
6278 state
.uioh <- state
.uioh#button
b d x y m
6281 state
.mpos
<- (x, y);
6282 state
.uioh <- state
.uioh#motion
x y
6283 method pmotion
x y =
6284 state
.mpos
<- (x, y);
6285 state
.uioh <- state
.uioh#pmotion
x y
6287 let mascm = m land (
6288 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6291 let x = state
.x and y = state
.y in
6293 if x != state
.x || y != state
.y then self#cleanup
6295 match state
.keystate
with
6297 let km = k
, mascm in
6300 let modehash = state
.uioh#
modehash in
6301 try Hashtbl.find modehash km
6303 try Hashtbl.find (findkeyhash conf
"global") km
6304 with Not_found
-> KMinsrt
(k
, m)
6306 | KMinsrt
(k
, m) -> keyboard k
m
6307 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6308 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6310 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6311 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6312 state
.keystate
<- KSnone
6313 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6314 state
.keystate
<- KSinto
(keys
, insrt
)
6315 | KSinto
_ -> state
.keystate
<- KSnone
6318 state
.mpos
<- (x, y);
6319 state
.uioh <- state
.uioh#pmotion
x y
6320 method leave = state
.mpos
<- (-1, -1)
6321 method winstate wsl
= state
.winstate
<- wsl
6322 method quit
= raise Quit
6323 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6328 List.exists
GlMisc.check_extension
6329 [ "GL_ARB_texture_rectangle"
6330 ; "GL_EXT_texture_recangle"
6331 ; "GL_NV_texture_rectangle" ]
6333 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6336 let r = GlMisc.get_string `renderer
in
6337 let p = "Mesa DRI Intel(" in
6338 let l = String.length
p in
6339 String.length
r > l && String.sub
r 0 l = p
6342 defconf
.sliceheight
<- 1024;
6343 defconf
.texcount
<- 32;
6344 defconf
.usepbo
<- true;
6348 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6350 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6358 setcheckers conf
.checkers
;
6360 if conf
.redirectstderr
6364 (Buffer.to_bytes state
.errmsgs
)
6365 (match state
.errfd
with
6367 let s = Bytes.create
(80*24) in
6370 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6372 then Unix.read fd
s 0 (Bytes.length
s)
6378 else Bytes.sub
s 0 n
6382 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6383 with exn
-> print_endline
(exntos exn
)
6388 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6389 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6390 !Config.fontpath
, !trimcachepath,
6391 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6394 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6400 Wsi.settitle
"llpp (history)";
6404 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6405 opendoc state
.path state
.password
;
6410 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6413 if nonemptystr
!rcmdpath
6414 then remoteopen !rcmdpath
6419 let rec loop deadline
=
6421 match state
.errfd
with
6422 | None
-> [state
.ss; state
.wsfd]
6423 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6428 | Some fd
-> fd
:: r
6432 state
.redisplay
<- false;
6439 if deadline
= infinity
6441 else max
0.0 (deadline
-. now)
6446 try Unix.select
r [] [] timeout
6447 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6453 if state
.ghyll
== noghyll
6455 match state
.autoscroll
with
6456 | Some step
when step
!= 0 ->
6457 let y = state
.y + step
in
6461 else if y >= state
.maxy then 0 else y
6464 if state
.mode = View
6465 then state
.text <- E.s;
6468 else deadline
+. 0.01
6473 let rec checkfds = function
6475 | fd
:: rest
when fd
= state
.ss ->
6476 let cmd = readcmd state
.ss in
6480 | fd
:: rest
when fd
= state
.wsfd ->
6484 | fd
:: rest
when Some fd
= !optrfd ->
6485 begin match remote fd
with
6486 | None
-> optrfd := remoteopen !rcmdpath;
6487 | opt -> optrfd := opt
6492 let s = Bytes.create
80 in
6493 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6494 if conf
.redirectstderr
6496 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6497 state
.newerrmsgs
<- true;
6498 state
.redisplay
<- true;
6501 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6507 if !reeenterhist then (
6509 reeenterhist := false;
6513 if deadline
= infinity
6517 match state
.autoscroll
with
6518 | Some step
when step
!= 0 -> deadline1
6519 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6527 Config.save
leavebirdseye;