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
260 | Uannotation _
-> Some
under
262 onppundermouse g x y Unone
267 match unproject opaque
x y with
268 | Some
(x, y) -> Some
(Some
(l
.pageno
, x, y))
271 onppundermouse g x y None
;
275 state
.text
<- Printf.sprintf
"%c%s" c s
;
276 G.postRedisplay "showtext";
279 let pipesel opaque cmd
=
282 match Unix.pipe
() with
285 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
287 let doclose what fd
=
288 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
291 try popen cmd
[r
, 0; w
, -1]; true
293 dolog
"can not execute %S: %s" cmd
(exntos exn
);
299 G.postRedisplay "pipesel";
301 else doclose "pipesel pipe/w" w
;
302 doclose "pipesel pipe/r" r
;
306 let g opaque l
px py
=
307 if markunder opaque
px py conf
.paxmark
310 match getopaque l
.pageno
with
312 | Some opaque
-> pipesel opaque conf
.paxcmd
317 G.postRedisplay "paxunder";
318 if conf
.paxmark
= Mark_page
321 match getopaque l
.pageno
with
323 | Some opaque
-> clearmark opaque
) state
.layout
;
325 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
329 match Unix.pipe
() with
331 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
334 Ne.clo fd
(fun msg
->
335 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
339 try popen conf
.selcmd
[r
, 0; w
, -1]; true
342 (Printf.sprintf
"failed to execute %s: %s"
343 conf
.selcmd
(exntos exn
));
349 let l = String.length s
in
350 let bytes = Bytes.unsafe_of_string s
in
351 let n = tempfailureretry
(Unix.write w
bytes 0) l in
356 "failed to write %d characters to sel pipe, wrote %d"
361 (Printf.sprintf
"failed to write to sel pipe: %s"
366 clo "selstring pipe/r" r
;
367 clo "selstring pipe/w" w
;
370 let undertext = function
373 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
374 | Utext s
-> "font: " ^ s
375 | Uunexpected s
-> "unexpected: " ^ s
376 | Ulaunch s
-> "launch: " ^ s
377 | Unamed s
-> "named: " ^ s
378 | Uremote
(filename
, pageno
) ->
379 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
380 | Uremotedest
(filename
, destname
) ->
381 Printf.sprintf
"%s: destination %S" filename destname
382 | Uannotation contents
->
383 Printf.sprintf
"annotation " ^ contents
386 let updateunder x y =
387 match getunder x y with
388 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
390 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
391 Wsi.setcursor
Wsi.CURSOR_INFO
392 | Ulinkgoto
(pageno
, _
) ->
394 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
395 Wsi.setcursor
Wsi.CURSOR_INFO
397 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
398 Wsi.setcursor
Wsi.CURSOR_TEXT
400 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
401 Wsi.setcursor
Wsi.CURSOR_INHERIT
403 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
404 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
407 Wsi.setcursor
Wsi.CURSOR_INHERIT
408 | Uremote
(filename
, pageno
) ->
409 if conf
.underinfo
then showtext 'r'
410 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
411 Wsi.setcursor
Wsi.CURSOR_INFO
412 | Uremotedest
(filename
, destname
) ->
413 if conf
.underinfo
then showtext 'r'
414 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
415 Wsi.setcursor
Wsi.CURSOR_INFO
417 if conf
.underinfo
then showtext 'a'
"nnotation";
418 Wsi.setcursor
Wsi.CURSOR_INFO
421 let showlinktype under =
435 let s = undertext under in
440 let b = Buffer.create
(String.length
s + 1) in
441 Buffer.add_string
b s;
446 let intentry_with_suffix text key
=
448 if key
>= 32 && key
< 127
452 match Char.lowercase
c with
454 let text = addchar text c in
458 let text = addchar text c in
462 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
467 let s = Bytes.create
4 in
468 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
469 if n != 4 then error
"incomplete read(len) = %d" n;
470 let len = (Char.code
(Bytes.get
s 0) lsl 24)
471 lor (Char.code
(Bytes.get
s 1) lsl 16)
472 lor (Char.code
(Bytes.get
s 2) lsl 8)
473 lor (Char.code
(Bytes.get
s 3))
475 let s = Bytes.create
len in
476 let n = tempfailureretry
(Unix.read fd
s 0) len in
477 if n != len then error
"incomplete read(data) %d vs %d" n len;
481 let btod b = if b then 1 else 0;;
484 let b = Buffer.create
16 in
485 Buffer.add_string
b "llll";
488 let s = Buffer.to_bytes
b in
489 let n = Bytes.length
s in
491 (* dolog "wcmd %S" (String.sub s 4 len); *)
492 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
493 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
494 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
495 Bytes.set
s 3 (Char.chr
(len land 0xff));
496 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
497 if n'
!= n then error
"write failed %d vs %d" n'
n;
501 let nogeomcmds cmds
=
503 | s, [] -> emptystr
s
507 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
508 let sh = sh - (hscrollh ()) in
509 let rec fold accu
n =
510 if n = Array.length
b
513 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
516 || n = state
.pagecount
- coverB
517 || (n - coverA
) mod columns
= columns
- 1)
523 let pagey = max
0 (y - vy
) in
524 let pagedispy = if pagey > 0 then 0 else vy
- y in
525 let pagedispx, pagex
=
527 if n = coverA
- 1 || n = state
.pagecount
- coverB
528 then state
.x + (wadjsb state
.winw
- w
) / 2
529 else dx + xoff
+ state
.x
536 let vw = wadjsb state
.winw
- pagedispx in
537 let pw = w
- pagex
in
540 let pagevh = min
(h
- pagey) (sh - pagedispy) in
541 if pagevw > 0 && pagevh > 0
552 ; pagedispx = pagedispx
553 ; pagedispy = pagedispy
565 if Array.length
b = 0
567 else List.rev
(fold [] (page_of_y
y))
570 let layoutS (columns
, b) y sh =
571 let sh = sh - hscrollh () in
572 let rec fold accu n =
573 if n = Array.length
b
576 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
583 let x = xoff
+ state
.x in
584 let pagey = max
0 (y - vy
) in
585 let pagedispy = if pagey > 0 then 0 else vy
- y in
586 let pagedispx, pagex
=
600 let pagecolw = pagew
/columns
in
602 if pagecolw < state
.winw
603 then pagedispx + ((wadjsb state
.winw
- pagecolw) / 2)
607 let vw = wadjsb state
.winw
- pagedispx in
608 let pw = pagew
- pagex
in
611 let pagevw = min
pagevw pagecolw in
612 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
613 if pagevw > 0 && pagevh > 0
624 ; pagedispx = pagedispx
625 ; pagedispy = pagedispy
626 ; pagecol
= n mod columns
641 if nogeomcmds state
.geomcmds
643 match conf
.columns
with
644 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
645 | Cmulti
c -> layoutN c y sh
646 | Csplit
s -> layoutS s y sh
651 let y = state
.y + incr
in
653 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
658 let tilex = l.pagex
mod conf
.tilew
in
659 let tiley = l.pagey mod conf
.tileh
in
661 let col = l.pagex
/ conf
.tilew
in
662 let row = l.pagey / conf
.tileh
in
664 let rec rowloop row y0 dispy h
=
668 let dh = conf
.tileh
- y0 in
670 let rec colloop col x0 dispx w
=
674 let dw = conf
.tilew
- x0 in
676 let dispx'
= xadjsb dispx in
677 f col row dispx' dispy
x0 y0 dw dh;
678 colloop (col+1) 0 (dispx+dw) (w
-dw)
681 colloop col tilex l.pagedispx l.pagevw;
682 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
685 if l.pagevw > 0 && l.pagevh > 0
686 then rowloop row tiley l.pagedispy l.pagevh;
689 let gettileopaque l col row =
691 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
693 try Some
(Hashtbl.find state
.tilemap
key)
694 with Not_found
-> None
697 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
698 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
699 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
702 let filledrect x0 y0 x1 y1 =
703 GlArray.disable `texture_coord
;
704 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
705 GlArray.vertex `two state
.vraw
;
706 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
707 GlArray.enable `texture_coord
;
710 let linerect x0 y0 x1 y1 =
711 GlArray.disable `texture_coord
;
712 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
713 GlArray.vertex `two state
.vraw
;
714 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
715 GlArray.enable `texture_coord
;
718 let drawtiles l color
=
721 let f col row x y tilex tiley w h
=
722 match gettileopaque l col row with
723 | Some
(opaque
, _
, t
) ->
724 let params = x, y, w
, h
, tilex, tiley in
726 then GlTex.env
(`mode `blend
);
727 drawtile
params opaque
;
729 then GlTex.env
(`mode `modulate
);
733 let s = Printf.sprintf
737 let w = measurestr fstate
.fontsize
s in
738 GlDraw.color
(0.0, 0.0, 0.0);
739 filledrect (float (x-2))
742 (float (y + fstate
.fontsize
+ 2));
743 GlDraw.color
(1.0, 1.0, 1.0);
744 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
754 let lw = wadjsb state
.winw
- x in
757 let lh = state
.winh
- y in
761 then GlTex.env
(`mode `blend
);
762 begin match state
.checkerstexid
with
764 Gl.enable `texture_2d
;
765 GlTex.bind_texture ~target
:`texture_2d id
;
769 and y1 = float (y+h
) in
771 let tw = float w /. 16.0
772 and th
= float h
/. 16.0 in
773 let tx0 = float tilex /. 16.0
774 and ty0
= float tiley /. 16.0 in
776 and ty1
= ty0
+. th
in
777 Raw.sets_float state
.vraw ~pos
:0
778 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
779 Raw.sets_float state
.traw ~pos
:0
780 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
781 GlArray.vertex `two state
.vraw
;
782 GlArray.tex_coord `two state
.traw
;
783 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
784 Gl.disable `texture_2d
;
787 GlDraw.color
(1.0, 1.0, 1.0);
788 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
791 then GlTex.env
(`mode `modulate
);
792 if w > 128 && h
> fstate
.fontsize
+ 10
794 let c = if conf
.invert
then 1.0 else 0.0 in
795 GlDraw.color
(c, c, c);
798 then (col*conf
.tilew
, row*conf
.tileh
)
801 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
810 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
812 let tilevisible1 l x y =
814 and ax1
= l.pagex
+ l.pagevw
816 and ay1
= l.pagey + l.pagevh in
820 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
821 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
823 let rx0 = max
ax0 bx0
824 and ry0
= max ay0 by0
825 and rx1
= min ax1
bx1
826 and ry1
= min ay1 by1
in
828 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
832 let tilevisible layout n x y =
833 let rec findpageinlayout m
= function
834 | l :: rest
when l.pageno
= n ->
835 tilevisible1 l x y || (
836 match conf
.columns
with
837 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
842 | _
:: rest
-> findpageinlayout 0 rest
845 findpageinlayout 0 layout;
848 let tileready l x y =
849 tilevisible1 l x y &&
850 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
853 let tilepage n p
layout =
854 let rec loop = function
858 let f col row _ _ _ _ _ _
=
859 if state
.currently
= Idle
861 match gettileopaque l col row with
864 let x = col*conf
.tilew
865 and y = row*conf
.tileh
in
867 let w = l.pagew
- x in
871 let h = l.pageh
- y in
876 then getpbo
w h conf
.colorspace
879 wcmd "tile %s %d %d %d %d %s"
880 (~
> p
) x y w h (~
> pbo);
883 l, p
, conf
.colorspace
, conf
.angle
,
884 state
.gen
, col, row, conf
.tilew
, conf
.tileh
893 if nogeomcmds state
.geomcmds
897 let preloadlayout y =
898 let y = if y < state
.winh
then 0 else y - state
.winh
in
899 let h = state
.winh
*3 in
905 if state
.currently
!= Idle
910 begin match getopaque l.pageno
with
912 wcmd "page %d %d" l.pageno
l.pagedimno
;
913 state
.currently
<- Loading
(l, state
.gen
);
915 tilepage l.pageno opaque pages
;
920 if nogeomcmds state
.geomcmds
926 if conf
.preload && state
.currently
= Idle
927 then load (preloadlayout state
.y);
930 let layoutready layout =
931 let rec fold all ls
=
934 let seen = ref false in
935 let allvisible = ref true in
936 let foo col row _ _ _ _ _ _
=
938 allvisible := !allvisible &&
939 begin match gettileopaque l col row with
945 fold (!seen && !allvisible) rest
948 let alltilesvisible = fold true layout in
953 let y = bound
y 0 state
.maxy
in
954 let y, layout, proceed
=
955 match conf
.maxwait
with
956 | Some time
when state
.ghyll
== noghyll
->
957 begin match state
.throttle
with
959 let layout = layout y state
.winh
in
960 let ready = layoutready layout in
964 state
.throttle
<- Some
(layout, y, now
());
966 else G.postRedisplay "gotoy showall (None)";
968 | Some
(_
, _
, started
) ->
969 let dt = now
() -. started
in
972 state
.throttle
<- None
;
973 let layout = layout y state
.winh
in
975 G.postRedisplay "maxwait";
982 let layout = layout y state
.winh
in
983 if not
!wtmode || layoutready layout
984 then G.postRedisplay "gotoy ready";
990 state
.layout <- layout;
991 begin match state
.mode
with
994 | Ltexact
(pageno
, linkno
) ->
995 let rec loop = function
997 state
.mode
<- LinkNav
(Ltgendir
0)
998 | l :: _
when l.pageno
= pageno
->
999 begin match getopaque pageno
with
1001 state
.mode
<- LinkNav
(Ltgendir
0)
1003 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
1004 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
1005 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
1006 then state
.mode
<- LinkNav
(Ltgendir
0)
1008 | _
:: rest
-> loop rest
1017 begin match state
.mode
with
1018 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1019 if not
(pagevisible layout pageno
)
1021 match state
.layout with
1024 state
.mode
<- Birdseye
(
1025 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1032 let rec loop = function
1035 match getopaque l.pageno
with
1041 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1043 if dir
> 0 then LDfirst
else LDlast
1049 | Lnotfound
-> loop rest
1051 showlinktype (getlink opaque
n);
1052 Ltexact
(l.pageno
, n)
1056 state
.mode
<- LinkNav
linknav
1064 state
.ghyll
<- noghyll
;
1067 let mx, my
= state
.mpos
in
1072 let conttiling pageno opaque
=
1073 tilepage pageno opaque
1074 (if conf
.preload then preloadlayout state
.y else state
.layout)
1077 let gotoy_and_clear_text y =
1078 if not conf
.verbose
then state
.text <- E.s;
1082 let getanchory (n, top
, dtop
) =
1083 let y, h = getpageyh
n in
1084 if conf
.presentation
1086 let ips = calcips
h in
1087 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1089 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1092 let gotoanchor anchor
=
1093 gotoy (getanchory anchor
);
1097 cbput state
.hists
.nav
(getanchor
());
1101 let anchor = cbgetc state
.hists
.nav dir
in
1105 let gotoghyll1 single
y =
1106 let scroll f n a
b =
1107 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1109 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1111 then s (float f /. float a
)
1114 then 1.0 -. s ((float (f-b) /. float (n-b)))
1120 let ins = float a
*. 0.5
1121 and outs
= float (n-b) *. 0.5 in
1123 ins +. outs
+. float ones
1125 let rec set nab
y sy
=
1126 let (_N
, _A
, _B
), y =
1129 let scl = if y > sy
then 2 else -2 in
1130 let _N, _
, _
= nab
in
1131 (_N,0,_N), y+conf
.scrollstep
*scl
1133 let sum = summa
_N _A _B
in
1134 let dy = float (y - sy
) in
1138 then state
.ghyll
<- noghyll
1141 let s = scroll n _N _A _B
in
1142 let y1 = y1 +. ((s *. dy) /. sum) in
1143 gotoy_and_clear_text (truncate
y1);
1144 state
.ghyll
<- gf (n+1) y1;
1148 | Some
y'
when single
-> set nab
y' state
.y
1149 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1151 gf 0 (float state
.y)
1154 match conf
.ghyllscroll
with
1155 | Some nab
when not conf
.presentation
->
1156 if state
.ghyll
== noghyll
1157 then set nab
y state
.y
1158 else state
.ghyll
(Some
y)
1160 gotoy_and_clear_text y
1163 let gotoghyll = gotoghyll1 false;;
1165 let gotopage n top
=
1166 let y, h = getpageyh
n in
1167 let y = y + (truncate
(top
*. float h)) in
1171 let gotopage1 n top
=
1172 let y = getpagey
n in
1177 let invalidate s f =
1182 match state
.geomcmds
with
1183 | ps
, [] when emptystr ps
->
1185 state
.geomcmds
<- s, [];
1188 state
.geomcmds
<- ps
, [s, f];
1190 | ps
, (s'
, _
) :: rest
when s'
= s ->
1191 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1194 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1198 Hashtbl.iter
(fun _ opaque
->
1199 wcmd "freepage %s" (~
> opaque
);
1201 Hashtbl.clear state
.pagemap
;
1205 if not
(Queue.is_empty state
.tilelru
)
1207 Queue.iter
(fun (k
, p
, s) ->
1208 wcmd "freetile %s" (~
> p
);
1209 state
.memused
<- state
.memused
- s;
1210 Hashtbl.remove state
.tilemap k
;
1212 state
.uioh#infochanged Memused
;
1213 Queue.clear state
.tilelru
;
1219 let h = truncate
(float h*.conf
.zoom
) in
1220 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1224 let opendoc path password
=
1226 state
.password
<- password
;
1227 state
.gen
<- state
.gen
+ 1;
1228 state
.docinfo
<- [];
1229 state
.outlines
<- [||];
1232 setaalevel conf
.aalevel
;
1234 if emptystr state
.origin
1238 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1239 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1240 invalidate "reqlayout"
1242 wcmd "reqlayout %d %d %d %s\000"
1243 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1244 (stateh state
.winh
) state
.nameddest
1249 state
.anchor <- getanchor
();
1250 opendoc state
.path state
.password
;
1254 let c = c *. conf
.colorscale
in
1258 let scalecolor2 (r
, g, b) =
1259 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1262 let docolumns = function
1264 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1265 let rec loop pageno
pdimno pdim
y ph pdims
=
1266 if pageno
= state
.pagecount
1269 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1271 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1272 pdimno+1, pdim
, rest
1276 let x = max
0 (((wadjsb state
.winw
- w) / 2) - xoff
) in
1278 (if conf
.presentation
1279 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1280 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1283 a.(pageno
) <- (pdimno, x, y, pdim
);
1284 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1286 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1287 conf
.columns
<- Csingle
a;
1289 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1290 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1291 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1292 let rec fixrow m
= if m
= pageno
then () else
1293 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1296 let y = y + (rowh
- h) / 2 in
1297 a.(m
) <- (pdimno, x, y, pdim
);
1301 if pageno
= state
.pagecount
1302 then fixrow (((pageno
- 1) / columns
) * columns
)
1304 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1306 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1307 pdimno+1, pdim
, rest
1312 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1314 let x = (wadjsb state
.winw
- w) / 2 in
1316 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1317 x, y + ips + rowh
, h
1320 if (pageno
- coverA
) mod columns
= 0
1322 let x = max
0 (wadjsb state
.winw
- state
.w) / 2 in
1324 if conf
.presentation
1326 let ips = calcips
h in
1327 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1329 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1333 else x, y, max rowh
h
1337 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1340 if pageno
= columns
&& conf
.presentation
1342 let ips = calcips rowh
in
1343 for i
= 0 to pred columns
1345 let (pdimno, x, y, pdim
) = a.(i
) in
1346 a.(i
) <- (pdimno, x, y+ips, pdim
)
1352 fixrow (pageno
- columns
);
1357 a.(pageno
) <- (pdimno, x, y, pdim
);
1358 let x = x + w + xoff
*2 + conf
.interpagespace
in
1359 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1361 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1362 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1365 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1366 let rec loop pageno
pdimno pdim
y pdims
=
1367 if pageno
= state
.pagecount
1370 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1372 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1373 pdimno+1, pdim
, rest
1378 let rec loop1 n x y =
1379 if n = c then y else (
1380 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1381 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1384 let y = loop1 0 0 y in
1385 loop (pageno
+1) pdimno pdim
y pdims
1387 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1388 conf
.columns
<- Csplit
(c, a);
1392 docolumns conf
.columns
;
1393 state
.maxy
<- calcheight
();
1394 if state
.reprf
== noreprf
1396 match state
.mode
with
1397 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1398 let y, h = getpageyh pageno
in
1399 let top = (state
.winh
- h) / 2 in
1400 gotoy (max
0 (y - top))
1403 | LinkNav _
-> gotoanchor state
.anchor
1407 state
.reprf
<- noreprf
;
1412 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1413 let firsttime = state
.geomcmds
== firstgeomcmds
in
1414 if not
firsttime && nogeomcmds state
.geomcmds
1415 then state
.anchor <- getanchor
();
1418 let w = wadjsb (truncate
(float w *. conf
.zoom
)) in
1421 setfontsize fstate
.fontsize
;
1422 GlMat.mode `modelview
;
1423 GlMat.load_identity
();
1425 GlMat.mode `projection
;
1426 GlMat.load_identity
();
1427 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1428 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1429 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1434 else float state
.x /. float state
.w
1436 invalidate "geometry"
1440 then state
.x <- truncate
(relx *. float w);
1442 match conf
.columns
with
1444 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1445 | Csplit
(c, _
) -> w * c
1447 wcmd "geometry %d %d %d"
1448 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1453 let len = String.length state
.text in
1454 let x0 = xadjsb 0 in
1457 match state
.mode
with
1458 | Textentry _
| View
| LinkNav _
->
1459 let h, _
, _
= state
.uioh#scrollpw
in
1464 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1465 (x+.w) (float (state
.winh
- hscrollh))
1468 let w = float (wadjsb state
.winw
- 1) in
1469 if state
.progress
>= 0.0 && state
.progress
< 1.0
1471 GlDraw.color
(0.3, 0.3, 0.3);
1472 let w1 = w *. state
.progress
in
1474 GlDraw.color
(0.0, 0.0, 0.0);
1475 rect (float x0+.w1) (float x0+.w-.w1)
1478 GlDraw.color
(0.0, 0.0, 0.0);
1482 GlDraw.color
(1.0, 1.0, 1.0);
1483 drawstring fstate
.fontsize
1484 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1485 (state
.winh
- hscrollh - 5) s;
1488 match state
.mode
with
1489 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1493 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1495 Printf.sprintf
"%s%s_" prefix
text
1501 | LinkNav _
-> state
.text
1506 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1508 let s1 = "(press 'e' to review error messasges)" in
1509 if nonemptystr
s then s ^
" " ^
s1 else s1
1519 let len = Queue.length state
.tilelru
in
1521 match state
.throttle
with
1524 then preloadlayout state
.y
1526 | Some
(layout, _
, _
) ->
1530 if state
.memused
<= conf
.memlimit
1535 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1536 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1537 let (_
, pw, ph
, _
) = getpagedim
n in
1540 && colorspace
= conf
.colorspace
1541 && angle
= conf
.angle
1545 let x = col*conf
.tilew
1546 and y = row*conf
.tileh
in
1547 tilevisible (Lazy.force_val
layout) n x y
1549 then Queue.push lruitem state
.tilelru
1552 wcmd "freetile %s" (~
> p
);
1553 state
.memused
<- state
.memused
- s;
1554 state
.uioh#infochanged Memused
;
1555 Hashtbl.remove state
.tilemap k
;
1563 let logcurrently = function
1564 | Idle
-> dolog
"Idle"
1565 | Loading
(l, gen
) ->
1566 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1567 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1569 "Tiling %d[%d,%d] page=%s cs=%s angle"
1570 l.pageno
col row (~
> pageopaque
)
1571 (CSTE.to_string colorspace
)
1573 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1574 angle gen conf
.angle state
.gen
1576 conf
.tilew conf
.tileh
1583 let r = Str.regexp
" " in
1584 fun s -> Str.bounded_split
r s 2;
1587 let onpagerect pageno
f =
1589 match conf
.columns
with
1590 | Cmulti
(_
, b) -> b
1592 | Csplit
(_
, b) -> b
1594 if pageno
>= 0 && pageno
< Array.length
b
1596 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1600 let gotopagexy1 pageno
x y =
1601 let _,w1,h1
,leftx
= getpagedim pageno
in
1602 let top = y /. (float h1
) in
1603 let left = x /. (float w1) in
1604 let py, w, h = getpageywh pageno
in
1605 let wh = state
.winh
- hscrollh () in
1606 let x = left *. (float w) in
1607 let x = leftx
+ state
.x + truncate
x in
1609 if x < 0 || x >= wadjsb state
.winw
1613 let pdy = truncate
(top *. float h) in
1614 let y'
= py + pdy in
1615 let dy = y'
- state
.y in
1617 if x != state
.x || not
(dy > 0 && dy < wh)
1619 if conf
.presentation
1621 if abs
(py - y'
) > wh
1628 if state
.x != sx || state
.y != sy
1633 let ww = wadjsb state
.winw
in
1635 and qy
= pdy / wh in
1637 and y = py + qy
* wh in
1638 let x = if -x + ww > w1 then -(w1-ww) else x
1639 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1641 if conf
.presentation
1643 if abs
(py - y'
) > wh
1653 gotoy_and_clear_text y;
1655 else gotoy_and_clear_text state
.y;
1658 let gotopagexy pageno
x y =
1659 match state
.mode
with
1660 | Birdseye
_ -> gotopage pageno
0.0
1663 | LinkNav
_ -> gotopagexy1 pageno
x y
1667 (* dolog "%S" cmds; *)
1668 let cl = splitatspace cmds
in
1670 try Scanf.sscanf
s fmt
f
1672 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1675 let addoutline outline
=
1676 match state
.currently
with
1677 | Outlining outlines
->
1678 state
.currently
<- Outlining
(outline
:: outlines
)
1679 | Idle
-> state
.currently
<- Outlining
[outline
]
1682 dolog
"invalid outlining state";
1683 logcurrently state
.currently
1687 state
.uioh#infochanged Pdim
;
1690 | "clearrects" :: [] ->
1691 state
.rects
<- state
.rects1
;
1692 G.postRedisplay "clearrects";
1694 | "continue" :: args
:: [] ->
1695 let n = scan args
"%u" (fun n -> n) in
1696 state
.pagecount
<- n;
1697 begin match state
.currently
with
1699 state
.currently
<- Idle
;
1700 state
.outlines
<- Array.of_list
(List.rev
l)
1706 let cur, cmds
= state
.geomcmds
in
1708 then failwith
"umpossible";
1710 begin match List.rev cmds
with
1712 state
.geomcmds
<- E.s, [];
1713 state
.throttle
<- None
;
1717 state
.geomcmds
<- s, List.rev rest
;
1719 if conf
.maxwait
= None
&& not
!wtmode
1720 then G.postRedisplay "continue";
1722 | "msg" :: args
:: [] ->
1725 | "vmsg" :: args
:: [] ->
1727 then showtext ' ' args
1729 | "emsg" :: args
:: [] ->
1730 Buffer.add_string state
.errmsgs args
;
1731 state
.newerrmsgs
<- true;
1732 G.postRedisplay "error message"
1734 | "progress" :: args
:: [] ->
1735 let progress, text =
1738 f, String.sub args pos
(String.length args
- pos
))
1741 state
.progress <- progress;
1742 G.postRedisplay "progress"
1744 | "firstmatch" :: args
:: [] ->
1745 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1746 scan args
"%u %d %f %f %f %f %f %f %f %f"
1747 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1748 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1750 let xoff = float (xadjsb 0) in
1754 and x3
= x3
+. xoff in
1755 let y = (getpagey
pageno) + truncate
y0 in
1758 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1760 | "match" :: args
:: [] ->
1761 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1762 scan args
"%u %d %f %f %f %f %f %f %f %f"
1763 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1764 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1766 let xoff = float (xadjsb 0) in
1770 and x3
= x3
+. xoff in
1772 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1774 | "page" :: args
:: [] ->
1775 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1776 let pageopaque = ~
< pageopaques in
1777 begin match state
.currently
with
1778 | Loading
(l, gen
) ->
1779 vlog "page %d took %f sec" l.pageno t
;
1780 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1781 begin match state
.throttle
with
1783 let preloadedpages =
1785 then preloadlayout state
.y
1790 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1791 IntSet.empty
preloadedpages
1794 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1795 if not
(IntSet.mem
pageno set)
1797 wcmd "freepage %s" (~
> opaque
);
1803 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1806 state
.currently
<- Idle
;
1809 tilepage l.pageno pageopaque state
.layout;
1811 load preloadedpages;
1812 if pagevisible state
.layout l.pageno
1813 && layoutready state
.layout
1814 then G.postRedisplay "page";
1817 | Some
(layout, _, _) ->
1818 state
.currently
<- Idle
;
1819 tilepage l.pageno pageopaque layout;
1826 dolog
"Inconsistent loading state";
1827 logcurrently state
.currently
;
1831 | "tile" :: args
:: [] ->
1832 let (x, y, opaques
, size
, t
) =
1833 scan args
"%u %u %s %u %f"
1834 (fun x y p size t
-> (x, y, p
, size
, t
))
1836 let opaque = ~
< opaques
in
1837 begin match state
.currently
with
1838 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1839 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1842 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1844 wcmd "freetile %s" (~
> opaque);
1845 state
.currently
<- Idle
;
1849 puttileopaque l col row gen cs angle
opaque size t
;
1850 state
.memused
<- state
.memused
+ size
;
1851 state
.uioh#infochanged Memused
;
1853 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1854 opaque, size
) state
.tilelru
;
1857 match state
.throttle
with
1858 | None
-> state
.layout
1859 | Some
(layout, _, _) -> layout
1862 state
.currently
<- Idle
;
1864 && conf
.colorspace
= cs
1865 && conf
.angle
= angle
1866 && tilevisible layout l.pageno x y
1867 then conttiling l.pageno pageopaque;
1869 begin match state
.throttle
with
1871 preload state
.layout;
1873 && conf
.colorspace
= cs
1874 && conf
.angle
= angle
1875 && tilevisible state
.layout l.pageno x y
1876 && (not
!wtmode || layoutready state
.layout)
1877 then G.postRedisplay "tile nothrottle";
1879 | Some
(layout, y, _) ->
1880 let ready = layoutready layout in
1884 state
.layout <- layout;
1885 state
.throttle
<- None
;
1886 G.postRedisplay "throttle";
1895 dolog
"Inconsistent tiling state";
1896 logcurrently state
.currently
;
1900 | "pdim" :: args
:: [] ->
1901 let (n, w, h, _) as pdim
=
1902 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1905 match conf
.fitmodel
with
1907 | FitPage
| FitProportional
->
1908 match conf
.columns
with
1909 | Csplit
_ -> (n, w, h, 0)
1910 | Csingle
_ | Cmulti
_ -> pdim
1912 state
.uioh#infochanged Pdim
;
1913 state
.pdims
<- pdim :: state
.pdims
1915 | "o" :: args
:: [] ->
1916 let (l, n, t
, h, pos
) =
1917 scan args
"%u %u %d %u %n"
1918 (fun l n t
h pos
-> l, n, t
, h, pos
)
1920 let s = String.sub args pos
(String.length args
- pos
) in
1921 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1923 | "ou" :: args
:: [] ->
1924 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1925 let s = String.sub args pos
len in
1926 let pos2 = pos
+ len + 1 in
1927 let uri = String.sub args
pos2 (String.length args
- pos2) in
1928 addoutline (s, l, Ouri
uri)
1930 | "on" :: args
:: [] ->
1931 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1932 let s = String.sub args pos
(String.length args
- pos
) in
1933 addoutline (s, l, Onone
)
1935 | "a" :: args
:: [] ->
1937 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1939 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1941 | "info" :: args
:: [] ->
1942 let pos = nindex args '
\t'
in
1943 if pos >= 0 && String.sub args
0 pos = "Title"
1945 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1948 state
.docinfo
<- (1, args
) :: state
.docinfo
1950 | "infoend" :: [] ->
1951 state
.uioh#infochanged Docinfo
;
1952 state
.docinfo
<- List.rev state
.docinfo
1955 error
"unknown cmd `%S'" cmds
1960 let action = function
1961 | HCprev
-> cbget cb ~
-1
1962 | HCnext
-> cbget cb
1
1963 | HCfirst
-> cbget cb ~
-(cb
.rc)
1964 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1965 and cancel
() = cb
.rc <- rc
1969 let search pattern forward
=
1970 match conf
.columns
with
1972 showtext '
!'
"searching does not work properly in split columns mode"
1975 if nonemptystr pattern
1978 match state
.layout with
1981 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1983 wcmd "search %d %d %d %d,%s\000"
1984 (btod conf
.icase
) pn py (btod forward
) pattern
;
1987 let intentry text key =
1989 if key >= 32 && key < 127
1995 let text = addchar text c in
1999 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2003 let linknentry text key =
2005 if key >= 32 && key < 127
2011 let text = addchar text c in
2015 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2023 let l = String.length
s in
2024 let rec loop pos n = if pos = l then n else
2025 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
2026 loop (pos+1) (n*26 + m)
2029 let rec loop n = function
2032 match getopaque l.pageno with
2033 | None
-> loop n rest
2035 let m = getlinkcount
opaque in
2038 let under = getlink
opaque n in
2041 else loop (n-m) rest
2043 loop n state
.layout;
2047 let textentry text key =
2048 if key land 0xff00 = 0xff00
2050 else TEcont
(text ^ toutf8
key)
2053 let reqlayout angle fitmodel
=
2054 match state
.throttle
with
2056 if nogeomcmds state
.geomcmds
2057 then state
.anchor <- getanchor
();
2058 conf
.angle
<- angle
mod 360;
2061 match state
.mode
with
2062 | LinkNav
_ -> state
.mode
<- View
2067 conf
.fitmodel
<- fitmodel
;
2068 invalidate "reqlayout"
2070 wcmd "reqlayout %d %d %d"
2071 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2076 let settrim trimmargins trimfuzz
=
2077 if nogeomcmds state
.geomcmds
2078 then state
.anchor <- getanchor
();
2079 conf
.trimmargins
<- trimmargins
;
2080 conf
.trimfuzz
<- trimfuzz
;
2081 let x0, y0, x1, y1 = trimfuzz
in
2082 invalidate "settrim"
2084 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2089 match state
.throttle
with
2091 let zoom = max
0.0001 zoom in
2092 if zoom <> conf
.zoom
2094 state
.prevzoom
<- (conf
.zoom, state
.x);
2096 reshape state
.winw state
.winh
;
2097 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2100 | Some
(layout, y, started
) ->
2102 match conf
.maxwait
with
2106 let dt = now
() -. started
in
2114 let setcolumns mode columns coverA coverB
=
2115 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2119 then showtext '
!'
"split mode doesn't work in bird's eye"
2121 conf
.columns
<- Csplit
(-columns
, E.a);
2129 conf
.columns
<- Csingle
E.a;
2134 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2138 reshape state
.winw state
.winh
;
2141 let resetmstate () =
2142 state
.mstate
<- Mnone
;
2143 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2146 let enterbirdseye () =
2147 let zoom = float conf
.thumbw
/. float state
.winw
in
2148 let birdseyepageno =
2149 let cy = state
.winh
/ 2 in
2153 let rec fold best
= function
2156 let d = cy - (l.pagedispy + l.pagevh/2)
2157 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2158 if abs
d < abs dbest
2165 state
.mode
<- Birdseye
(
2166 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2170 conf
.presentation
<- false;
2171 conf
.interpagespace
<- 10;
2172 conf
.hlinks
<- false;
2173 conf
.fitmodel
<- FitPage
;
2175 conf
.maxwait
<- None
;
2177 match conf
.beyecolumns
with
2180 Cmulti
((c, 0, 0), E.a)
2181 | None
-> Csingle
E.a
2185 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2190 reshape state
.winw state
.winh
;
2193 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2195 conf
.zoom <- c.zoom;
2196 conf
.presentation
<- c.presentation
;
2197 conf
.interpagespace
<- c.interpagespace
;
2198 conf
.maxwait
<- c.maxwait
;
2199 conf
.hlinks
<- c.hlinks
;
2200 conf
.fitmodel
<- c.fitmodel
;
2201 conf
.beyecolumns
<- (
2202 match conf
.columns
with
2203 | Cmulti
((c, _, _), _) -> Some
c
2205 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2208 match c.columns
with
2209 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2210 | Csingle
_ -> Csingle
E.a
2211 | Csplit
(c, _) -> Csplit
(c, E.a)
2215 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2218 reshape state
.winw state
.winh
;
2219 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2223 let togglebirdseye () =
2224 match state
.mode
with
2225 | Birdseye vals
-> leavebirdseye vals
true
2226 | View
-> enterbirdseye ()
2231 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2232 let pageno = max
0 (pageno - incr
) in
2233 let rec loop = function
2234 | [] -> gotopage1 pageno 0
2235 | l :: _ when l.pageno = pageno ->
2236 if l.pagedispy >= 0 && l.pagey = 0
2237 then G.postRedisplay "upbirdseye"
2238 else gotopage1 pageno 0
2239 | _ :: rest
-> loop rest
2243 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2246 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2247 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2248 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2249 let rec loop = function
2251 let y, h = getpageyh
pageno in
2252 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2254 | l :: _ when l.pageno = pageno ->
2255 if l.pagevh != l.pageh
2256 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2257 else G.postRedisplay "downbirdseye"
2258 | _ :: rest
-> loop rest
2264 let boundastep h step
=
2266 then bound step ~
-h 0
2270 let optentry mode
_ key =
2271 let btos b = if b then "on" else "off" in
2272 if key >= 32 && key < 127
2274 let c = Char.chr
key in
2278 try conf
.scrollstep
<- int_of_string
s with exc
->
2279 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2281 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2286 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2287 if state
.autoscroll
<> None
2288 then state
.autoscroll
<- Some conf
.autoscrollstep
2290 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2292 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2297 let n, a, b = multicolumns_of_string
s in
2298 setcolumns mode
n a b;
2300 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2302 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2307 let zoom = float (int_of_string
s) /. 100.0 in
2310 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2312 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2317 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2319 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2320 begin match mode
with
2322 leavebirdseye beye
false;
2329 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2331 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2336 Some
(int_of_string
s)
2338 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2342 | Some angle
-> reqlayout angle conf
.fitmodel
2345 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2348 conf
.icase
<- not conf
.icase
;
2349 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2352 conf
.preload <- not conf
.preload;
2354 TEdone
("preload " ^
(btos conf
.preload))
2357 conf
.verbose
<- not conf
.verbose
;
2358 TEdone
("verbose " ^
(btos conf
.verbose
))
2361 conf
.debug
<- not conf
.debug
;
2362 TEdone
("debug " ^
(btos conf
.debug
))
2365 conf
.maxhfit
<- not conf
.maxhfit
;
2366 state
.maxy
<- calcheight
();
2367 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2370 conf
.crophack
<- not conf
.crophack
;
2371 TEdone
("crophack " ^
btos conf
.crophack
)
2375 match conf
.maxwait
with
2377 conf
.maxwait
<- Some infinity
;
2378 "always wait for page to complete"
2380 conf
.maxwait
<- None
;
2381 "show placeholder if page is not ready"
2386 conf
.underinfo
<- not conf
.underinfo
;
2387 TEdone
("underinfo " ^
btos conf
.underinfo
)
2390 conf
.savebmarks
<- not conf
.savebmarks
;
2391 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2397 match state
.layout with
2402 conf
.interpagespace
<- int_of_string
s;
2403 docolumns conf
.columns
;
2404 state
.maxy
<- calcheight
();
2405 let y = getpagey
pageno in
2408 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2410 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2414 match conf
.fitmodel
with
2415 | FitProportional
-> FitWidth
2416 | FitWidth
| FitPage
-> FitProportional
2418 reqlayout conf
.angle
fm;
2419 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2422 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2423 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2426 conf
.invert
<- not conf
.invert
;
2427 TEdone
("invert colors " ^
btos conf
.invert
)
2431 cbput state
.hists
.sel
s;
2434 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2435 textentry, ondone, true)
2439 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2440 else conf
.pax
<- None
;
2441 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2444 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2450 class type lvsource
= object
2451 method getitemcount
: int
2452 method getitem
: int -> (string * int)
2453 method hasaction
: int -> bool
2461 method getactive
: int
2462 method getfirst
: int
2464 method getminfo
: (int * int) array
2467 class virtual lvsourcebase
= object
2468 val mutable m_active
= 0
2469 val mutable m_first
= 0
2470 val mutable m_pan
= 0
2471 method getactive
= m_active
2472 method getfirst
= m_first
2473 method getpan
= m_pan
2474 method getminfo
: (int * int) array
= E.a
2477 let withoutlastutf8 s =
2478 let len = String.length
s in
2486 let b = Char.code
s.[pos] in
2487 if b land 0b11000000 = 0b11000000
2492 if Char.code
s.[len-1] land 0x80 = 0
2496 String.sub
s 0 first;
2499 let textentrykeyboard
2500 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2502 if key >= 0xffb0 && key <= 0xffb9
2503 then key - 0xffb0 + 48 else key
2506 state
.mode
<- Textentry
(te
, onleave
);
2509 G.postRedisplay "textentrykeyboard enttext";
2511 let histaction cmd
=
2514 | Some
(action, _) ->
2515 state
.mode
<- Textentry
(
2516 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2518 G.postRedisplay "textentry histaction"
2522 if emptystr
text && cancelonempty
2525 G.postRedisplay "textentrykeyboard after cancel";
2528 let s = withoutlastutf8 text in
2529 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2531 | @enter
| @kpenter
->
2534 G.postRedisplay "textentrykeyboard after confirm"
2536 | @up
| @kpup
-> histaction HCprev
2537 | @down
| @kpdown
-> histaction HCnext
2538 | @home
| @kphome
-> histaction HCfirst
2539 | @jend
| @kpend
-> histaction HClast
2544 begin match opthist
with
2546 | Some
(_, onhistcancel
) -> onhistcancel
()
2550 G.postRedisplay "textentrykeyboard after cancel2"
2553 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2556 | @delete
| @kpdelete
-> ()
2559 && key land 0xff00 != 0xff00 (* keyboard *)
2560 && key land 0xfe00 != 0xfe00 (* xkb *)
2561 && key land 0xfd00 != 0xfd00 (* 3270 *)
2563 begin match onkey
text key with
2567 G.postRedisplay "textentrykeyboard after confirm2";
2570 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2574 G.postRedisplay "textentrykeyboard after cancel3"
2577 state
.mode
<- Textentry
(te
, onleave
);
2578 G.postRedisplay "textentrykeyboard switch";
2582 vlog "unhandled key %s" (Wsi.keyname
key)
2585 let firstof first active
=
2586 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2587 then max
0 (active
- (fstate
.maxrows
/2))
2591 let calcfirst first active
=
2594 let rows = active
- first in
2595 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2599 let scrollph y maxy
=
2600 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2601 let sh = float state
.winh
/. sh in
2602 let sh = max
sh (float conf
.scrollh
) in
2604 let percent = float y /. float maxy
in
2605 let position = (float state
.winh
-. sh) *. percent in
2608 if position +. sh > float state
.winh
2609 then float state
.winh
-. sh
2615 let coe s = (s :> uioh
);;
2617 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2619 val m_pan
= source#getpan
2620 val m_first
= source#getfirst
2621 val m_active
= source#getactive
2623 val m_prev_uioh
= state
.uioh
2625 method private elemunder
y =
2629 let n = y / (fstate
.fontsize
+1) in
2630 if m_first
+ n < source#getitemcount
2632 if source#hasaction
(m_first
+ n)
2633 then Some
(m_first
+ n)
2640 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2641 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2642 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2643 GlDraw.color
(1., 1., 1.);
2644 Gl.enable `texture_2d
;
2645 let fs = fstate
.fontsize
in
2647 let hw = (wadjsb (xadjsb state
.winw
))/3 in
2648 let ww = fstate
.wwidth
in
2649 let tabw = 17.0*.ww in
2650 let itemcount = source#getitemcount
in
2651 let minfo = source#getminfo
in
2654 then float (xadjsb 0), float (state
.winw
- 1)
2655 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2658 if (row - m_first
) > fstate
.maxrows
2661 if row >= 0 && row < itemcount
2663 let (s, level
) = source#getitem
row in
2664 let y = (row - m_first
) * nfs in
2666 (if conf
.leftscroll
then float (xadjsb 0) else 5.0)
2667 +. (float (level
+ m_pan
)) *. ww in
2670 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2674 Gl.disable `texture_2d
;
2675 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2676 GlDraw.color
(1., 1., 1.) ~
alpha;
2677 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2678 Gl.enable `texture_2d
;
2681 if zebra
&& row land 1 = 1
2685 GlDraw.color
(c,c,c);
2686 let drawtabularstring s =
2688 let x'
= truncate
(x0 +. x) in
2689 let pos = nindex
s '
\000'
in
2691 then drawstring1 fs x'
(y+nfs) s
2693 let s1 = String.sub
s 0 pos
2694 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2699 let s'
= withoutlastutf8 s in
2700 let s = s' ^
"@Uellipsis" in
2701 let w = measurestr
fs s in
2702 if float x'
+. w +. ww < float (hw + x'
)
2707 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2711 ignore
(drawstring1 fs x'
(y+nfs) s1);
2712 drawstring1 fs (hw + x'
) (y+nfs) s2
2716 let x = if helpmode
&& row > 0 then x +. ww else x in
2717 let tabpos = nindex
s '
\t'
in
2720 let len = String.length
s - tabpos - 1 in
2721 let s1 = String.sub
s 0 tabpos
2722 and s2
= String.sub
s (tabpos + 1) len in
2723 let nx = drawstr x s1 in
2725 let x = x +. (max
tabw sw) in
2728 let len = String.length
s - 2 in
2729 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2731 let s = String.sub
s 2 len in
2732 let x = if not helpmode
then x +. ww else x in
2733 GlDraw.color
(1.2, 1.2, 1.2);
2734 let vinc = drawstring1 (fs+fs/4)
2735 (truncate
(x -. ww)) (y+nfs) s in
2736 GlDraw.color
(1., 1., 1.);
2737 vinc +. (float fs *. 0.8)
2743 ignore
(drawtabularstring s);
2749 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2751 if (row - m_first
) > fstate
.maxrows
2754 if row >= 0 && row < itemcount
2756 let (s, level
) = source#getitem
row in
2757 let pos0 = nindex
s '
\000'
in
2758 let y = (row - m_first
) * nfs in
2759 let x = float (level
+ m_pan
) *. ww in
2760 let (first, last
) = minfo.(row) in
2762 if pos0 > 0 && first > pos0
2763 then String.sub
s (pos0+1) (first-pos0-1)
2764 else String.sub
s 0 first
2766 let suffix = String.sub
s first (last
- first) in
2767 let w1 = measurestr fstate
.fontsize
prefix in
2768 let w2 = measurestr fstate
.fontsize
suffix in
2769 let x = x +. if conf
.leftscroll
then float (xadjsb 5) else 5.0 in
2770 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2772 and y0 = float (y+2) in
2774 and y1 = float (y+fs+3) in
2775 filledrect x0 y0 x1 y1;
2780 Gl.disable `texture_2d
;
2781 if Array.length
minfo > 0 then loop m_first
;
2784 method updownlevel incr
=
2785 let len = source#getitemcount
in
2787 if m_active
>= 0 && m_active
< len
2788 then snd
(source#getitem m_active
)
2792 if i
= len then i
-1 else if i
= -1 then 0 else
2793 let _, l = source#getitem i
in
2794 if l != curlevel then i
else flow (i
+incr
)
2796 let active = flow m_active
in
2797 let first = calcfirst m_first
active in
2798 G.postRedisplay "outline updownlevel";
2799 {< m_active
= active; m_first
= first >}
2801 method private key1
key mask
=
2802 let set1 active first qsearch
=
2803 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2805 let search active pattern incr
=
2806 let active = if active = -1 then m_first
else active in
2809 if n >= 0 && n < source#getitemcount
2811 let s, _ = source#getitem
n in
2813 (try ignore
(Str.search_forward
re s 0); true
2814 with Not_found
-> false)
2816 else loop (n + incr
)
2823 let re = Str.regexp_case_fold pattern
in
2829 let itemcount = source#getitemcount
in
2830 let find start incr
=
2832 if i
= -1 || i
= itemcount
2835 if source#hasaction i
2837 else find (i
+ incr
)
2842 let set active first =
2843 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2845 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2848 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2850 let incr1 = if incr
> 0 then 1 else -1 in
2851 if isvisible m_first m_active
2854 let next = m_active
+ incr
in
2856 if next < 0 || next >= itemcount
2858 else find next incr1
2860 if abs
(m_active
- next) > fstate
.maxrows
2866 let first = m_first
+ incr
in
2867 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2869 let next = m_active
+ incr
in
2870 let next = bound
next 0 (itemcount - 1) in
2877 if isvisible first next
2884 let first = min
next m_first
in
2886 if abs
(next - first) > fstate
.maxrows
2892 let first = m_first
+ incr
in
2893 let first = bound
first 0 (itemcount - 1) in
2895 let next = m_active
+ incr
in
2896 let next = bound
next 0 (itemcount - 1) in
2897 let next = find next incr1 in
2899 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2901 let active = if m_active
= -1 then next else m_active
in
2906 if isvisible first active
2912 G.postRedisplay "listview navigate";
2916 | (@r|@s) when Wsi.withctrl mask
->
2917 let incr = if key = @r then -1 else 1 in
2919 match search (m_active
+ incr) m_qsearch
incr with
2921 state
.text <- m_qsearch ^
" [not found]";
2924 state
.text <- m_qsearch
;
2925 active, firstof m_first
active
2927 G.postRedisplay "listview ctrl-r/s";
2928 set1 active first m_qsearch
;
2930 | @insert
when Wsi.withctrl mask
->
2931 if m_active
>= 0 && m_active
< source#getitemcount
2933 let s, _ = source#getitem m_active
in
2939 if emptystr m_qsearch
2942 let qsearch = withoutlastutf8 m_qsearch
in
2946 G.postRedisplay "listview empty qsearch";
2947 set1 m_active m_first
E.s;
2951 match search m_active
qsearch ~
-1 with
2953 state
.text <- qsearch ^
" [not found]";
2956 state
.text <- qsearch;
2957 active, firstof m_first
active
2959 G.postRedisplay "listview backspace qsearch";
2960 set1 active first qsearch
2963 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2964 let pattern = m_qsearch ^ toutf8
key in
2966 match search m_active
pattern 1 with
2968 state
.text <- pattern ^
" [not found]";
2971 state
.text <- pattern;
2972 active, firstof m_first
active
2974 G.postRedisplay "listview qsearch add";
2975 set1 active first pattern;
2979 if emptystr m_qsearch
2981 G.postRedisplay "list view escape";
2984 source#exit ~uioh
:(coe self
)
2985 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2987 | None
-> m_prev_uioh
2992 G.postRedisplay "list view kill qsearch";
2993 coe {< m_qsearch
= E.s >}
2996 | @enter
| @kpenter
->
2998 let self = {< m_qsearch
= E.s >} in
3000 G.postRedisplay "listview enter";
3001 if m_active
>= 0 && m_active
< source#getitemcount
3003 source#exit ~uioh
:(coe self) ~cancel
:false
3004 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3007 source#exit ~uioh
:(coe self) ~cancel
:true
3008 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
3011 begin match opt with
3012 | None
-> m_prev_uioh
3016 | @delete
| @kpdelete
->
3019 | @up
| @kpup
-> navigate ~
-1
3020 | @down
| @kpdown
-> navigate 1
3021 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
3022 | @next | @kpnext
-> navigate fstate
.maxrows
3024 | @right
| @kpright
->
3026 G.postRedisplay "listview right";
3027 coe {< m_pan
= m_pan
- 1 >}
3029 | @left | @kpleft
->
3031 G.postRedisplay "listview left";
3032 coe {< m_pan
= m_pan
+ 1 >}
3034 | @home
| @kphome
->
3035 let active = find 0 1 in
3036 G.postRedisplay "listview home";
3040 let first = max
0 (itemcount - fstate
.maxrows
) in
3041 let active = find (itemcount - 1) ~
-1 in
3042 G.postRedisplay "listview end";
3045 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3049 dolog
"listview unknown key %#x" key; coe self
3051 method key key mask
=
3052 match state
.mode
with
3053 | Textentry te
-> textentrykeyboard key mask te
; coe self
3056 | LinkNav
_ -> self#key1
key mask
3058 method button button down
x y _ =
3061 | 1 when x > state
.winw
- conf
.scrollbw
->
3062 G.postRedisplay "listview scroll";
3065 let _, position, sh = self#
scrollph in
3066 if y > truncate
position && y < truncate
(position +. sh)
3068 state
.mstate
<- Mscrolly
;
3072 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3073 let first = truncate
(s *. float source#getitemcount
) in
3074 let first = min source#getitemcount
first in
3075 Some
(coe {< m_first
= first; m_active
= first >})
3077 state
.mstate
<- Mnone
;
3080 | 1 when not down
->
3081 begin match self#elemunder
y with
3083 G.postRedisplay "listview click";
3084 source#exit ~uioh
:(coe {< m_active
= n >})
3085 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3089 | n when (n == 4 || n == 5) && not down
->
3090 let len = source#getitemcount
in
3092 if n = 5 && m_first
+ fstate
.maxrows
>= len
3096 let first = m_first
+ (if n == 4 then -1 else 1) in
3097 bound
first 0 (len - 1)
3099 G.postRedisplay "listview wheel";
3100 Some
(coe {< m_first
= first >})
3101 | n when (n = 6 || n = 7) && not down
->
3102 let inc = if n = 7 then -1 else 1 in
3103 G.postRedisplay "listview hwheel";
3104 Some
(coe {< m_pan
= m_pan
+ inc >})
3109 | None
-> m_prev_uioh
3112 method multiclick
_ x y = self#button
1 true x y
3115 match state
.mstate
with
3117 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3118 let first = truncate
(s *. float source#getitemcount
) in
3119 let first = min source#getitemcount
first in
3120 G.postRedisplay "listview motion";
3121 coe {< m_first
= first; m_active
= first >}
3129 method pmotion
x y =
3130 if x < state
.winw
- conf
.scrollbw
3133 match self#elemunder
y with
3134 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3135 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3139 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3144 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3148 method infochanged
_ = ()
3150 method scrollpw
= (0, 0.0, 0.0)
3152 let nfs = fstate
.fontsize
+ 1 in
3153 let y = m_first
* nfs in
3154 let itemcount = source#getitemcount
in
3155 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3156 let maxy = maxi * nfs in
3157 let p, h = scrollph y maxy in
3160 method modehash
= modehash
3161 method eformsgs
= false
3164 class outlinelistview ~zebra ~source
=
3165 let settext autonarrow
s =
3168 let ss = source#statestr
in
3172 else "{" ^
ss ^
"} [" ^
s ^
"]"
3173 else state
.text <- s
3179 ~source
:(source
:> lvsource
)
3181 ~modehash
:(findkeyhash conf
"outline")
3184 val m_autonarrow
= false
3186 method! key key mask
=
3188 if emptystr state
.text
3190 else fstate
.maxrows - 2
3192 let calcfirst first active =
3195 let rows = active - first in
3196 if rows > maxrows then active - maxrows else first
3200 let active = m_active
+ incr in
3201 let active = bound
active 0 (source#getitemcount
- 1) in
3202 let first = calcfirst m_first
active in
3203 G.postRedisplay "outline navigate";
3204 coe {< m_active
= active; m_first
= first >}
3206 let navscroll first =
3208 let dist = m_active
- first in
3214 else first + maxrows
3217 G.postRedisplay "outline navscroll";
3218 coe {< m_first
= first; m_active
= active >}
3220 let ctrl = Wsi.withctrl mask
in
3225 then (source#denarrow
; E.s)
3227 let pattern = source#renarrow
in
3228 if nonemptystr m_qsearch
3229 then (source#narrow m_qsearch
; m_qsearch
)
3233 settext (not m_autonarrow
) text;
3234 G.postRedisplay "toggle auto narrowing";
3235 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3237 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3239 G.postRedisplay "toggle auto narrowing";
3240 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3243 source#narrow m_qsearch
;
3245 then source#add_narrow_pattern m_qsearch
;
3246 G.postRedisplay "outline ctrl-n";
3247 coe {< m_first
= 0; m_active
= 0 >}
3250 let active = source#calcactive
(getanchor
()) in
3251 let first = firstof m_first
active in
3252 G.postRedisplay "outline ctrl-s";
3253 coe {< m_first
= first; m_active
= active >}
3256 G.postRedisplay "outline ctrl-u";
3257 if m_autonarrow
&& nonemptystr m_qsearch
3259 ignore
(source#renarrow
);
3260 settext m_autonarrow
E.s;
3261 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3264 source#del_narrow_pattern
;
3265 let pattern = source#renarrow
in
3267 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3269 settext m_autonarrow
text;
3270 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3274 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3275 G.postRedisplay "outline ctrl-l";
3276 coe {< m_first
= first >}
3278 | @tab
when m_autonarrow
->
3279 if nonemptystr m_qsearch
3281 G.postRedisplay "outline list view tab";
3282 source#add_narrow_pattern m_qsearch
;
3284 coe {< m_qsearch
= E.s >}
3288 | @escape
when m_autonarrow
->
3289 if nonemptystr m_qsearch
3290 then source#add_narrow_pattern m_qsearch
;
3293 | @enter
| @kpenter
when m_autonarrow
->
3294 if nonemptystr m_qsearch
3295 then source#add_narrow_pattern m_qsearch
;
3298 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3299 let pattern = m_qsearch ^ toutf8
key in
3300 G.postRedisplay "outlinelistview autonarrow add";
3301 source#narrow
pattern;
3302 settext true pattern;
3303 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3305 | key when m_autonarrow
&& key = @backspace
->
3306 if emptystr m_qsearch
3309 let pattern = withoutlastutf8 m_qsearch
in
3310 G.postRedisplay "outlinelistview autonarrow backspace";
3311 ignore
(source#renarrow
);
3312 source#narrow
pattern;
3313 settext true pattern;
3314 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3316 | @delete
| @kpdelete
->
3317 source#remove m_active
;
3318 G.postRedisplay "outline delete";
3319 let active = max
0 (m_active
-1) in
3320 coe {< m_first
= firstof m_first
active;
3321 m_active
= active >}
3323 | @up
| @kpup
when ctrl ->
3324 navscroll (max
0 (m_first
- 1))
3326 | @down
| @kpdown
when ctrl ->
3327 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3329 | @up
| @kpup
-> navigate ~
-1
3330 | @down
| @kpdown
-> navigate 1
3331 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3332 | @next | @kpnext
-> navigate fstate
.maxrows
3334 | @right
| @kpright
->
3338 G.postRedisplay "outline ctrl right";
3339 {< m_pan
= m_pan
+ 1 >}
3341 else self#updownlevel
1
3345 | @left | @kpleft
->
3349 G.postRedisplay "outline ctrl left";
3350 {< m_pan
= m_pan
- 1 >}
3352 else self#updownlevel ~
-1
3356 | @home
| @kphome
->
3357 G.postRedisplay "outline home";
3358 coe {< m_first
= 0; m_active
= 0 >}
3361 let active = source#getitemcount
- 1 in
3362 let first = max
0 (active - fstate
.maxrows) in
3363 G.postRedisplay "outline end";
3364 coe {< m_active
= active; m_first
= first >}
3366 | _ -> super#
key key mask
3369 let gotounder under =
3370 let getpath filename
=
3372 if nonemptystr filename
3374 if Filename.is_relative filename
3376 let dir = Filename.dirname state
.path in
3378 if Filename.is_implicit
dir
3379 then Filename.concat
(Sys.getcwd
()) dir
3382 Filename.concat
dir filename
3386 if Sys.file_exists
path
3391 | Ulinkgoto
(pageno, top) ->
3395 gotopage1 pageno top;
3401 | Uremote
(filename
, pageno) ->
3402 let path = getpath filename
in
3407 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
3408 try popen
command []
3410 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
3413 let anchor = getanchor
() in
3414 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3415 state
.origin
<- E.s;
3416 state
.anchor <- (pageno, 0.0, 0.0);
3417 state
.ranchors
<- ranchor :: state
.ranchors
;
3420 else showtext '
!'
("Could not find " ^ filename
)
3422 | Uremotedest
(filename
, destname
) ->
3423 let path = getpath filename
in
3428 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
3429 try popen
command []
3432 "failed to execute `%s': %s\n" command (exntos exn
);
3435 let anchor = getanchor
() in
3436 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3437 state
.origin
<- E.s;
3438 state
.nameddest
<- destname
;
3439 state
.ranchors
<- ranchor :: state
.ranchors
;
3442 else showtext '
!'
("Could not find " ^ filename
)
3444 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
3445 | Uannotation
_ -> ()
3448 let gotohist (path, (c, bookmarks
, x, anchor)) =
3449 Config.save
leavebirdseye;
3450 state
.anchor <- anchor;
3452 state
.bookmarks
<- bookmarks
;
3453 state
.origin
<- E.s;
3455 let x0, y0, x1, y1 = conf
.trimfuzz
in
3456 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3460 let gotooutline (_, _, kind
) =
3464 let (pageno, y, _) = anchor in
3466 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3470 | Ouri
uri -> gotounder (Ulinkuri
uri)
3471 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3472 | Oremote remote
-> gotounder (Uremote remote
)
3473 | Ohistory hist
-> gotohist hist
3474 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3478 let genhistoutlines =
3479 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3481 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3482 | `
path -> compare p2 p1
3483 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3485 let e1 = emptystr c1
.title
3486 and e2
= emptystr c2
.title
in
3488 then compare
(Filename.basename p2
) (Filename.basename p1
)
3491 else compare c1
.title c2
.title
3493 let showfullpath = ref false in
3496 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3497 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3499 let list = ref [] in
3500 if Config.gethist
list
3504 (fun accu (path, c, b, x, a) ->
3505 let hist = (path, (c, b, x, a)) in
3506 let s = if !showfullpath then path else Filename.basename
path in
3507 let base = mbtoutf8
s in
3508 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3510 [ setorty "Sort by time of last visit" `lastvisit
;
3511 setorty "Sort by file name" `file
;
3512 setorty "Sort by path" `
path;
3513 setorty "Sort by title" `title
;
3514 (if !showfullpath then "@Uradical "
3515 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3516 showfullpath := not
!showfullpath; reeenterhist := true)
3517 ] (List.sort
(order orderty
) !list)
3523 let outlinesource sourcetype
=
3525 inherit lvsourcebase
3526 val mutable m_items
= E.a
3527 val mutable m_minfo
= E.a
3528 val mutable m_orig_items
= E.a
3529 val mutable m_orig_minfo
= E.a
3530 val mutable m_narrow_patterns
= []
3531 val mutable m_hadremovals
= false
3532 val mutable m_gen
= -1
3534 method getitemcount
=
3535 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3538 if n == Array.length m_items
&& m_hadremovals
3540 ("[Confirm removal]", 0)
3542 let s, n, _ = m_items
.(n) in
3545 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3546 ignore
(uioh
, first);
3547 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3549 if m_narrow_patterns
= []
3550 then m_orig_items
, m_orig_minfo
3551 else m_items
, m_minfo
3555 if not
confrimremoval
3557 gotooutline m_items
.(active);
3562 state
.bookmarks
<- Array.to_list m_items
;
3563 m_orig_items
<- m_items
;
3564 m_orig_minfo
<- m_minfo
;
3574 method hasaction
_ = true
3577 if Array.length m_items
!= Array.length m_orig_items
3580 match m_narrow_patterns
with
3582 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3584 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3588 match m_narrow_patterns
with
3591 | head
:: _ -> "@Uellipsis" ^ head
3593 method narrow
pattern =
3594 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3598 let rec loop accu minfo n =
3601 m_items
<- Array.of_list
accu;
3602 m_minfo
<- Array.of_list
minfo;
3605 let (s, _, t
) as o = m_items
.(n) in
3608 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3609 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3610 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3612 try Str.search_forward
re s 0
3613 with Not_found
-> -1
3616 then o :: accu, (first, Str.match_end
()) :: minfo
3619 loop accu minfo (n-1)
3621 loop [] [] (Array.length m_items
- 1)
3623 method! getminfo
= m_minfo
3627 match sourcetype
with
3628 | `bookmarks
-> Array.of_list state
.bookmarks
3629 | `outlines
-> state
.outlines
3630 | `history
-> genhistoutlines !Config.historder
3632 m_minfo
<- m_orig_minfo
;
3633 m_items
<- m_orig_items
3636 if sourcetype
= `bookmarks
3638 if m >= 0 && m < Array.length m_items
3640 m_hadremovals
<- true;
3641 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3642 let n = if n >= m then n+1 else n in
3647 method add_narrow_pattern
pattern =
3648 m_narrow_patterns
<- pattern :: m_narrow_patterns
3650 method del_narrow_pattern
=
3651 match m_narrow_patterns
with
3652 | _ :: rest
-> m_narrow_patterns
<- rest
3657 match m_narrow_patterns
with
3658 | pattern :: [] -> self#narrow
pattern; pattern
3660 List.fold_left
(fun accu pattern ->
3661 self#narrow
pattern;
3662 pattern ^
"@Uellipsis" ^
accu) E.s list
3664 method calcactive
anchor =
3665 let rely = getanchory anchor in
3666 let rec loop n best bestd
=
3667 if n = Array.length m_items
3670 let _, _, kind
= m_items
.(n) in
3673 let orely = getanchory anchor in
3674 let d = abs
(orely - rely) in
3677 else loop (n+1) best bestd
3678 | Onone
| Oremote
_ | Olaunch
_
3679 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3680 loop (n+1) best bestd
3684 method reset
anchor items =
3685 m_hadremovals
<- false;
3686 if state
.gen
!= m_gen
3688 m_orig_items
<- items;
3690 m_narrow_patterns
<- [];
3692 m_orig_minfo
<- E.a;
3696 if items != m_orig_items
3698 m_orig_items
<- items;
3699 if m_narrow_patterns
== []
3700 then m_items
<- items;
3703 let active = self#calcactive
anchor in
3705 m_first
<- firstof m_first
active
3709 let enterselector sourcetype
=
3711 let source = outlinesource sourcetype
in
3714 match sourcetype
with
3715 | `bookmarks
-> Array.of_list state
.bookmarks
3716 | `
outlines -> state
.outlines
3717 | `history
-> genhistoutlines !Config.historder
3719 if Array.length
outlines = 0
3721 showtext ' ' errmsg
;
3724 state
.text <- source#greetmsg
;
3725 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3726 let anchor = getanchor
() in
3727 source#reset
anchor outlines;
3729 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3730 G.postRedisplay "enter selector";
3734 let enteroutlinemode =
3735 let f = enterselector `
outlines in
3736 fun () -> f "Document has no outline";
3739 let enterbookmarkmode =
3740 let f = enterselector `bookmarks
in
3741 fun () -> f "Document has no bookmarks (yet)";
3744 let enterhistmode () = enterselector `history
"No history (yet)";;
3746 let makecheckers () =
3747 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3749 converted by Issac Trotts. July 25, 2002 *)
3750 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3751 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3752 let id = GlTex.gen_texture
() in
3753 GlTex.bind_texture ~target
:`texture_2d
id;
3754 GlPix.store
(`unpack_alignment
1);
3755 GlTex.image2d
image;
3756 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3757 [ `mag_filter `nearest
; `min_filter `nearest
];
3761 let setcheckers enabled
=
3762 match state
.checkerstexid
with
3764 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3766 | Some checkerstexid
->
3769 GlTex.delete_texture checkerstexid
;
3770 state
.checkerstexid
<- None
;
3774 let describe_location () =
3775 let fn = page_of_y state
.y in
3776 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3777 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3781 else (100. *. (float state
.y /. float maxy))
3785 Printf.sprintf
"page %d of %d [%.2f%%]"
3786 (fn+1) state
.pagecount
percent
3789 "pages %d-%d of %d [%.2f%%]"
3790 (fn+1) (ln+1) state
.pagecount
percent
3793 let setpresentationmode v
=
3794 let n = page_of_y state
.y in
3795 state
.anchor <- (n, 0.0, 1.0);
3796 conf
.presentation
<- v
;
3797 if conf
.fitmodel
= FitPage
3798 then reqlayout conf
.angle conf
.fitmodel
;
3803 let btos b = if b then "@Uradical" else E.s in
3804 let showextended = ref false in
3805 let leave mode
_ = state
.mode
<- mode
in
3808 val mutable m_first_time
= true
3809 val mutable m_l
= []
3810 val mutable m_a
= E.a
3811 val mutable m_prev_uioh
= nouioh
3812 val mutable m_prev_mode
= View
3814 inherit lvsourcebase
3816 method reset prev_mode prev_uioh
=
3817 m_a
<- Array.of_list
(List.rev m_l
);
3819 m_prev_mode
<- prev_mode
;
3820 m_prev_uioh
<- prev_uioh
;
3824 if n >= Array.length m_a
3828 | _, _, _, Action
_ -> m_active
<- n
3829 | _, _, _, Noaction
-> loop (n+1)
3832 m_first_time
<- false;
3835 method int name get
set =
3837 (name
, `
int get
, 1, Action
(
3840 try set (int_of_string
s)
3842 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3846 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3847 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3851 method int_with_suffix name get
set =
3853 (name
, `intws get
, 1, Action
(
3856 try set (int_of_string_with_suffix
s)
3858 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3863 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3865 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3869 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3871 (name
, `
bool (btos, get
), offset
, Action
(
3878 method color name get
set =
3880 (name
, `color get
, 1, Action
(
3882 let invalid = (nan
, nan
, nan
) in
3885 try color_of_string
s
3887 state
.text <- Printf.sprintf
"bad color `%s': %s"
3894 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3895 state
.text <- color_to_string
(get
());
3896 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3900 method string name get
set =
3902 (name
, `
string get
, 1, Action
(
3904 let ondone s = set s in
3905 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3906 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3910 method colorspace name get
set =
3912 (name
, `
string get
, 1, Action
(
3916 inherit lvsourcebase
3919 m_active
<- CSTE.to_int conf
.colorspace
;
3922 method getitemcount
=
3923 Array.length
CSTE.names
3926 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3927 ignore
(uioh
, first, pan
);
3928 if not cancel
then set active;
3930 method hasaction
_ = true
3934 let modehash = findkeyhash conf
"info" in
3935 coe (new listview ~zebra
:false ~helpmode
:false
3936 ~
source ~trusted
:true ~
modehash)
3939 method paxmark name get
set =
3941 (name
, `
string get
, 1, Action
(
3945 inherit lvsourcebase
3948 m_active
<- MTE.to_int conf
.paxmark
;
3951 method getitemcount
= Array.length
MTE.names
3952 method getitem
n = (MTE.names
.(n), 0)
3953 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3954 ignore
(uioh
, first, pan
);
3955 if not cancel
then set active;
3957 method hasaction
_ = true
3961 let modehash = findkeyhash conf
"info" in
3962 coe (new listview ~zebra
:false ~helpmode
:false
3963 ~
source ~trusted
:true ~
modehash)
3966 method fitmodel name get
set =
3968 (name
, `
string get
, 1, Action
(
3972 inherit lvsourcebase
3975 m_active
<- FMTE.to_int conf
.fitmodel
;
3978 method getitemcount
= Array.length
FMTE.names
3979 method getitem
n = (FMTE.names
.(n), 0)
3980 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3981 ignore
(uioh
, first, pan
);
3982 if not cancel
then set active;
3984 method hasaction
_ = true
3988 let modehash = findkeyhash conf
"info" in
3989 coe (new listview ~zebra
:false ~helpmode
:false
3990 ~
source ~trusted
:true ~
modehash)
3993 method caption
s offset
=
3994 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3996 method caption2
s f offset
=
3997 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3999 method getitemcount
= Array.length m_a
4002 let tostr = function
4003 | `
int f -> string_of_int
(f ())
4004 | `intws
f -> string_with_suffix_of_int
(f ())
4006 | `color
f -> color_to_string
(f ())
4007 | `
bool (btos, f) -> btos (f ())
4010 let name, t
, offset
, _ = m_a
.(n) in
4011 ((let s = tostr t
in
4013 then Printf.sprintf
"%s\t%s" name s
4017 method exit ~uioh ~cancel ~
active ~
first ~pan
=
4022 match m_a
.(active) with
4023 | _, _, _, Action
f -> f uioh
4024 | _, _, _, Noaction
-> uioh
4035 method hasaction
n =
4037 | _, _, _, Action
_ -> true
4038 | _, _, _, Noaction
-> false
4041 let rec fillsrc prevmode prevuioh
=
4042 let sep () = src#caption
E.s 0 in
4043 let colorp name get
set =
4045 (fun () -> color_to_string
(get
()))
4048 let c = color_of_string
v in
4051 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
4054 let oldmode = state
.mode
in
4055 let birdseye = isbirdseye state
.mode
in
4057 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4059 src#
bool "presentation mode"
4060 (fun () -> conf
.presentation
)
4061 (fun v -> setpresentationmode v);
4063 src#
bool "ignore case in searches"
4064 (fun () -> conf
.icase
)
4065 (fun v -> conf
.icase
<- v);
4068 (fun () -> conf
.preload)
4069 (fun v -> conf
.preload <- v);
4071 src#
bool "highlight links"
4072 (fun () -> conf
.hlinks
)
4073 (fun v -> conf
.hlinks
<- v);
4075 src#
bool "under info"
4076 (fun () -> conf
.underinfo
)
4077 (fun v -> conf
.underinfo
<- v);
4079 src#
bool "persistent bookmarks"
4080 (fun () -> conf
.savebmarks
)
4081 (fun v -> conf
.savebmarks
<- v);
4083 src#fitmodel
"fit model"
4084 (fun () -> FMTE.to_string conf
.fitmodel
)
4085 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4087 src#
bool "trim margins"
4088 (fun () -> conf
.trimmargins
)
4089 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4091 src#
bool "persistent location"
4092 (fun () -> conf
.jumpback
)
4093 (fun v -> conf
.jumpback
<- v);
4096 src#
int "inter-page space"
4097 (fun () -> conf
.interpagespace
)
4099 conf
.interpagespace
<- n;
4100 docolumns conf
.columns
;
4102 match state
.layout with
4107 state
.maxy <- calcheight
();
4108 let y = getpagey
pageno in
4113 (fun () -> conf
.pagebias
)
4114 (fun v -> conf
.pagebias
<- v);
4116 src#
int "scroll step"
4117 (fun () -> conf
.scrollstep
)
4118 (fun n -> conf
.scrollstep
<- n);
4120 src#
int "horizontal scroll step"
4121 (fun () -> conf
.hscrollstep
)
4122 (fun v -> conf
.hscrollstep
<- v);
4124 src#
int "auto scroll step"
4126 match state
.autoscroll
with
4128 | _ -> conf
.autoscrollstep
)
4130 let n = boundastep state
.winh
n in
4131 if state
.autoscroll
<> None
4132 then state
.autoscroll
<- Some
n;
4133 conf
.autoscrollstep
<- n);
4136 (fun () -> truncate
(conf
.zoom *. 100.))
4137 (fun v -> setzoom ((float v) /. 100.));
4140 (fun () -> conf
.angle
)
4141 (fun v -> reqlayout v conf
.fitmodel
);
4143 src#
int "scroll bar width"
4144 (fun () -> conf
.scrollbw
)
4147 reshape state
.winw state
.winh
;
4150 src#
int "scroll handle height"
4151 (fun () -> conf
.scrollh
)
4152 (fun v -> conf
.scrollh
<- v;);
4154 src#
int "thumbnail width"
4155 (fun () -> conf
.thumbw
)
4157 conf
.thumbw
<- min
4096 v;
4160 leavebirdseye beye
false;
4167 let mode = state
.mode in
4168 src#
string "columns"
4170 match conf
.columns
with
4172 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4173 | Csplit
(count
, _) -> "-" ^ string_of_int count
4176 let n, a, b = multicolumns_of_string
v in
4177 setcolumns mode n a b);
4180 src#caption
"Pixmap cache" 0;
4181 src#int_with_suffix
"size (advisory)"
4182 (fun () -> conf
.memlimit
)
4183 (fun v -> conf
.memlimit
<- v);
4186 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4187 (string_with_suffix_of_int state
.memused
)
4188 (Hashtbl.length state
.tilemap
)) 1;
4191 src#caption
"Layout" 0;
4192 src#caption2
"Dimension"
4194 Printf.sprintf
"%dx%d (virtual %dx%d)"
4195 state
.winw state
.winh
4200 src#caption2
"Position" (fun () ->
4201 Printf.sprintf
"%dx%d" state
.x state
.y
4204 src#caption2
"Position" (fun () -> describe_location ()) 1
4208 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4209 "Save these parameters as global defaults at exit"
4210 (fun () -> conf
.bedefault
)
4211 (fun v -> conf
.bedefault
<- v)
4215 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4216 src#
bool ~offset
:0 ~
btos "Extended parameters"
4217 (fun () -> !showextended)
4218 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4222 (fun () -> conf
.checkers
)
4223 (fun v -> conf
.checkers
<- v; setcheckers v);
4224 src#
bool "update cursor"
4225 (fun () -> conf
.updatecurs
)
4226 (fun v -> conf
.updatecurs
<- v);
4227 src#
bool "scroll-bar on the left"
4228 (fun () -> conf
.leftscroll
)
4229 (fun v -> conf
.leftscroll
<- v);
4231 (fun () -> conf
.verbose
)
4232 (fun v -> conf
.verbose
<- v);
4233 src#
bool "invert colors"
4234 (fun () -> conf
.invert
)
4235 (fun v -> conf
.invert
<- v);
4237 (fun () -> conf
.maxhfit
)
4238 (fun v -> conf
.maxhfit
<- v);
4239 src#
bool "redirect stderr"
4240 (fun () -> conf
.redirectstderr)
4241 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4243 (fun () -> conf
.pax
!= None
)
4246 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4247 else conf
.pax
<- None
);
4248 src#
string "uri launcher"
4249 (fun () -> conf
.urilauncher
)
4250 (fun v -> conf
.urilauncher
<- v);
4251 src#
string "path launcher"
4252 (fun () -> conf
.pathlauncher
)
4253 (fun v -> conf
.pathlauncher
<- v);
4254 src#
string "tile size"
4255 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4258 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4259 conf
.tilew
<- max
64 w;
4260 conf
.tileh
<- max
64 h;
4263 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4266 src#
int "texture count"
4267 (fun () -> conf
.texcount
)
4270 then conf
.texcount
<- v
4271 else showtext '
!'
" Failed to set texture count please retry later"
4273 src#
int "slice height"
4274 (fun () -> conf
.sliceheight
)
4276 conf
.sliceheight
<- v;
4277 wcmd "sliceh %d" conf
.sliceheight
;
4279 src#
int "anti-aliasing level"
4280 (fun () -> conf
.aalevel
)
4282 conf
.aalevel
<- bound
v 0 8;
4283 state
.anchor <- getanchor
();
4284 opendoc state
.path state
.password
;
4286 src#
string "page scroll scaling factor"
4287 (fun () -> string_of_float conf
.pgscale)
4290 let s = float_of_string
v in
4293 state
.text <- Printf.sprintf
4294 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4297 src#
int "ui font size"
4298 (fun () -> fstate
.fontsize
)
4299 (fun v -> setfontsize (bound
v 5 100));
4300 src#
int "hint font size"
4301 (fun () -> conf
.hfsize
)
4302 (fun v -> conf
.hfsize
<- bound
v 5 100);
4303 colorp "background color"
4304 (fun () -> conf
.bgcolor
)
4305 (fun v -> conf
.bgcolor
<- v);
4306 src#
bool "crop hack"
4307 (fun () -> conf
.crophack
)
4308 (fun v -> conf
.crophack
<- v);
4309 src#
string "trim fuzz"
4310 (fun () -> irect_to_string conf
.trimfuzz
)
4313 conf
.trimfuzz
<- irect_of_string
v;
4315 then settrim true conf
.trimfuzz
;
4317 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4319 src#
string "throttle"
4321 match conf
.maxwait
with
4322 | None
-> "show place holder if page is not ready"
4325 then "wait for page to fully render"
4327 "wait " ^ string_of_float
time
4328 ^
" seconds before showing placeholder"
4332 let f = float_of_string
v in
4334 then conf
.maxwait
<- None
4335 else conf
.maxwait
<- Some
f
4337 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4339 src#
string "ghyll scroll"
4341 match conf
.ghyllscroll
with
4343 | Some nab
-> ghyllscroll_to_string nab
4346 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4348 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4350 src#
string "selection command"
4351 (fun () -> conf
.selcmd
)
4352 (fun v -> conf
.selcmd
<- v);
4353 src#
string "synctex command"
4354 (fun () -> conf
.stcmd
)
4355 (fun v -> conf
.stcmd
<- v);
4356 src#
string "pax command"
4357 (fun () -> conf
.paxcmd
)
4358 (fun v -> conf
.paxcmd
<- v);
4359 src#colorspace
"color space"
4360 (fun () -> CSTE.to_string conf
.colorspace
)
4362 conf
.colorspace
<- CSTE.of_int
v;
4366 src#paxmark
"pax mark method"
4367 (fun () -> MTE.to_string conf
.paxmark
)
4368 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4372 (fun () -> conf
.usepbo
)
4373 (fun v -> conf
.usepbo
<- v);
4374 src#
bool "mouse wheel scrolls pages"
4375 (fun () -> conf
.wheelbypage
)
4376 (fun v -> conf
.wheelbypage
<- v);
4377 src#
bool "open remote links in a new instance"
4378 (fun () -> conf
.riani
)
4379 (fun v -> conf
.riani
<- v);
4383 src#caption
"Document" 0;
4384 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4385 src#caption2
"Pages"
4386 (fun () -> string_of_int state
.pagecount
) 1;
4387 src#caption2
"Dimensions"
4388 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4392 src#caption
"Trimmed margins" 0;
4393 src#caption2
"Dimensions"
4394 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4398 src#caption
"OpenGL" 0;
4399 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4400 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4403 src#caption
"Location" 0;
4404 if nonemptystr state
.origin
4405 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4406 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4408 src#reset prevmode prevuioh
;
4413 let prevmode = state
.mode
4414 and prevuioh
= state
.uioh in
4415 fillsrc prevmode prevuioh
;
4416 let source = (src :> lvsource
) in
4417 let modehash = findkeyhash conf
"info" in
4418 state
.uioh <- coe (object (self)
4419 inherit listview ~zebra
:false ~helpmode
:false
4420 ~
source ~trusted
:true ~
modehash as super
4421 val mutable m_prevmemused
= 0
4422 method! infochanged
= function
4424 if m_prevmemused
!= state
.memused
4426 m_prevmemused
<- state
.memused
;
4427 G.postRedisplay "memusedchanged";
4429 | Pdim
-> G.postRedisplay "pdimchanged"
4430 | Docinfo
-> fillsrc prevmode prevuioh
4432 method! key key mask
=
4433 if not
(Wsi.withctrl mask
)
4436 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4437 | @right
| @kpright
-> coe (self#updownlevel
1)
4438 | _ -> super#
key key mask
4439 else super#
key key mask
4441 G.postRedisplay "info";
4447 inherit lvsourcebase
4448 method getitemcount
= Array.length state
.help
4450 let s, l, _ = state
.help
.(n) in
4453 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4457 match state
.help
.(active) with
4458 | _, _, Action
f -> Some
(f uioh)
4459 | _, _, Noaction
-> Some
uioh
4468 method hasaction
n =
4469 match state
.help
.(n) with
4470 | _, _, Action
_ -> true
4471 | _, _, Noaction
-> false
4477 let modehash = findkeyhash conf
"help" in
4479 state
.uioh <- coe (new listview
4480 ~zebra
:false ~helpmode
:true
4481 ~
source ~trusted
:true ~
modehash);
4482 G.postRedisplay "help";
4487 let re = Str.regexp
"[\r\n]" in
4489 inherit lvsourcebase
4490 val mutable m_items
= E.a
4492 method getitemcount
= 1 + Array.length m_items
4497 else m_items
.(n-1), 0
4499 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4504 then Buffer.clear state
.errmsgs
;
4511 method hasaction
n =
4515 state
.newerrmsgs
<- false;
4516 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4517 m_items
<- Array.of_list
l
4526 let source = (msgsource :> lvsource
) in
4527 let modehash = findkeyhash conf
"listview" in
4528 state
.uioh <- coe (object
4529 inherit listview ~zebra
:false ~helpmode
:false
4530 ~
source ~trusted
:false ~
modehash as super
4533 then msgsource#reset
;
4536 G.postRedisplay "msgs";
4539 let enterannotmode =
4542 inherit lvsourcebase
4543 val mutable m_items
= E.a
4545 method getitemcount
= Array.length m_items
4550 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4551 ignore
(uioh, cancel
, active, first, pan
);
4554 method hasaction
_ = true
4557 state
.newerrmsgs
<- false;
4558 let rec split accu b i
=
4560 if p = String.length
s
4561 then String.sub
s b (p-b) :: accu
4563 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4565 let ss = if i
= 0 then E.s else String.sub
s b i
in
4566 split (ss::accu) (p+1) 0
4570 m_items
<- split [] 0 0 |> List.rev
|> Array.of_list
4579 let source = (msgsource :> lvsource
) in
4580 let modehash = findkeyhash conf
"listview" in
4581 state
.uioh <- coe (object
4582 inherit listview ~zebra
:false ~helpmode
:false
4583 ~
source ~trusted
:false ~
modehash
4585 G.postRedisplay "annot";
4588 let quickbookmark ?title
() =
4589 match state
.layout with
4595 let tm = Unix.localtime
(now
()) in
4596 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4600 (tm.Unix.tm_year
+ 1900)
4603 | Some
title -> title
4605 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4608 let setautoscrollspeed step goingdown
=
4609 let incr = max
1 ((abs step
) / 2) in
4610 let incr = if goingdown
then incr else -incr in
4611 let astep = boundastep state
.winh
(step
+ incr) in
4612 state
.autoscroll
<- Some
astep;
4616 match conf
.columns
with
4618 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4621 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4623 let existsinrow pageno (columns
, coverA
, coverB
) p =
4624 let last = ((pageno - coverA
) mod columns
) + columns
in
4625 let rec any = function
4628 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4632 then (if l.pageno = last then false else any rest
)
4640 match state
.layout with
4642 let pageno = page_of_y state
.y in
4643 gotoghyll (getpagey
(pageno+1))
4645 match conf
.columns
with
4647 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4649 let y = clamp (pgscale state
.winh
) in
4652 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4653 gotoghyll (getpagey
pageno)
4654 | Cmulti
((c, _, _) as cl, _) ->
4655 if conf
.presentation
4656 && (existsinrow l.pageno cl
4657 (fun l -> l.pageh
> l.pagey + l.pagevh))
4659 let y = clamp (pgscale state
.winh
) in
4662 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4663 gotoghyll (getpagey
pageno)
4665 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4667 let pagey, pageh
= getpageyh
l.pageno in
4668 let pagey = pagey + pageh
* l.pagecol
in
4669 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4670 gotoghyll (pagey + pageh
+ ips)
4674 match state
.layout with
4676 let pageno = page_of_y state
.y in
4677 gotoghyll (getpagey
(pageno-1))
4679 match conf
.columns
with
4681 if conf
.presentation
&& l.pagey != 0
4683 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4685 let pageno = max
0 (l.pageno-1) in
4686 gotoghyll (getpagey
pageno)
4687 | Cmulti
((c, _, coverB
) as cl, _) ->
4688 if conf
.presentation
&&
4689 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4691 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4694 if l.pageno = state
.pagecount
- coverB
4698 let pageno = max
0 (l.pageno-decr) in
4699 gotoghyll (getpagey
pageno)
4707 let pageno = max
0 (l.pageno-1) in
4708 let pagey, pageh
= getpageyh
pageno in
4711 let pagey, pageh
= getpageyh
l.pageno in
4712 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4717 let viewkeyboard key mask
=
4719 let mode = state
.mode in
4720 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4723 G.postRedisplay "view:enttext"
4725 let ctrl = Wsi.withctrl mask
in
4727 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4732 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4734 state
.mode <- LinkNav
(Ltgendir
0);
4737 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4740 begin match state
.mstate
with
4743 G.postRedisplay "kill zoom rect";
4746 | Mscrolly
| Mscrollx
4749 begin match state
.mode with
4752 G.postRedisplay "esc leave linknav"
4756 match state
.ranchors
with
4758 | (path, password
, anchor, origin
) :: rest
->
4759 state
.ranchors
<- rest
;
4760 state
.anchor <- anchor;
4761 state
.origin
<- origin
;
4762 state
.nameddest
<- E.s;
4763 opendoc path password
4768 gotoghyll (getnav ~
-1)
4779 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4780 G.postRedisplay "dehighlight";
4782 | @slash
| @question
->
4783 let ondone isforw
s =
4784 cbput state
.hists
.pat
s;
4785 state
.searchpattern
<- s;
4788 let s = String.make
1 (Char.chr
key) in
4789 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4790 textentry, ondone (key = @slash
), true)
4792 | @plus
| @kpplus
| @equals
when ctrl ->
4793 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4794 setzoom (conf
.zoom +. incr)
4796 | @plus
| @kpplus
->
4799 try int_of_string
s with exc
->
4800 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4806 state
.text <- "page bias is now " ^ string_of_int
n;
4809 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4811 | @minus
| @kpminus
when ctrl ->
4812 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4813 setzoom (max
0.01 (conf
.zoom -. decr))
4815 | @minus
| @kpminus
->
4816 let ondone msg
= state
.text <- msg
in
4818 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4819 optentry state
.mode, ondone, true
4830 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4832 match conf
.columns
with
4833 | Csingle
_ | Cmulti
_ -> 1
4834 | Csplit
(n, _) -> n
4836 let h = state
.winh
-
4837 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4839 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4840 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4845 match conf
.fitmodel
with
4846 | FitWidth
-> FitProportional
4847 | FitProportional
-> FitPage
4848 | FitPage
-> FitWidth
4850 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4851 reqlayout conf
.angle
fm
4859 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4860 when not
ctrl -> (* 0..9 *)
4863 try int_of_string
s with exc
->
4864 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4870 cbput state
.hists
.pag
(string_of_int
n);
4871 gotopage1 (n + conf
.pagebias
- 1) 0;
4874 let pageentry text key =
4875 match Char.unsafe_chr
key with
4876 | '
g'
-> TEdone
text
4877 | _ -> intentry text key
4879 let text = String.make
1 (Char.chr
key) in
4880 enttext (":", text, Some
(onhist state
.hists
.pag
),
4881 pageentry, ondone, true)
4884 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4885 reshape state
.winw state
.winh
;
4888 state
.bzoom
<- not state
.bzoom
;
4890 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4893 conf
.hlinks
<- not conf
.hlinks
;
4894 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4895 G.postRedisplay "toggle highlightlinks";
4898 state
.glinks
<- true;
4899 let mode = state
.mode in
4900 state
.mode <- Textentry
(
4901 (":", E.s, None
, linknentry, linkndone gotounder, false),
4903 state
.glinks
<- false;
4907 G.postRedisplay "view:linkent(F)"
4910 state
.glinks
<- true;
4911 let mode = state
.mode in
4912 state
.mode <- Textentry
(
4914 ":", E.s, None
, linknentry, linkndone (fun under ->
4915 selstring (undertext under);
4919 state
.glinks
<- false;
4923 G.postRedisplay "view:linkent"
4926 begin match state
.autoscroll
with
4928 conf
.autoscrollstep
<- step
;
4929 state
.autoscroll
<- None
4931 if conf
.autoscrollstep
= 0
4932 then state
.autoscroll
<- Some
1
4933 else state
.autoscroll
<- Some conf
.autoscrollstep
4940 setpresentationmode (not conf
.presentation
);
4941 showtext ' '
("presentation mode " ^
4942 if conf
.presentation
then "on" else "off");
4945 if List.mem
Wsi.Fullscreen state
.winstate
4946 then Wsi.reshape conf
.cwinw conf
.cwinh
4947 else Wsi.fullscreen
()
4950 search state
.searchpattern
false
4953 search state
.searchpattern
true
4956 begin match state
.layout with
4959 gotoghyll (getpagey
l.pageno)
4965 | @delete
| @kpdelete
-> (* delete *)
4969 showtext ' '
(describe_location ());
4972 begin match state
.layout with
4975 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4980 enterbookmarkmode ()
4988 | @e when Buffer.length state
.errmsgs
> 0 ->
4993 match state
.layout with
4998 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5001 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5005 showtext ' '
"Quick bookmark added";
5008 begin match state
.layout with
5010 let rect = getpdimrect
l.pagedimno
in
5014 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5015 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5017 (truncate
(rect.(1) -. rect.(0)),
5018 truncate
(rect.(3) -. rect.(0)))
5020 let w = truncate
((float w)*.conf
.zoom)
5021 and h = truncate
((float h)*.conf
.zoom) in
5024 state
.anchor <- getanchor
();
5025 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5027 G.postRedisplay "z";
5032 | @x -> state
.roam
()
5035 reqlayout (conf
.angle
+
5036 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5040 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5042 G.postRedisplay "brightness";
5044 | @c when state
.mode = View
->
5049 let m = (wadjsb state
.winw
- state
.w) / 2 in
5051 gotoy_and_clear_text state
.y
5055 match state
.prevcolumns
with
5056 | None
-> (1, 0, 0), 1.0
5057 | Some
(columns
, z
) ->
5060 | Csplit
(c, _) -> -c, 0, 0
5061 | Cmulti
((c, a, b), _) -> c, a, b
5062 | Csingle
_ -> 1, 0, 0
5066 setcolumns View
c a b;
5069 | @down
| @up
when ctrl && Wsi.withshift mask
->
5070 let zoom, x = state
.prevzoom
in
5074 | @k
| @up
| @kpup
->
5075 begin match state
.autoscroll
with
5077 begin match state
.mode with
5078 | Birdseye beye
-> upbirdseye 1 beye
5083 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5085 if not
(Wsi.withshift mask
) && conf
.presentation
5087 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5091 setautoscrollspeed n false
5094 | @j
| @down
| @kpdown
->
5095 begin match state
.autoscroll
with
5097 begin match state
.mode with
5098 | Birdseye beye
-> downbirdseye 1 beye
5103 then gotoy_and_clear_text (clamp (state
.winh
/2))
5105 if not
(Wsi.withshift mask
) && conf
.presentation
5107 else gotoghyll1 true (clamp (conf
.scrollstep
))
5111 setautoscrollspeed n true
5114 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5120 else conf
.hscrollstep
5122 let dx = if key = @left || key = @kpleft
then dx else -dx in
5123 state
.x <- panbound (state
.x + dx);
5124 gotoy_and_clear_text state
.y
5127 G.postRedisplay "left/right"
5130 | @prior
| @kpprior
->
5134 match state
.layout with
5136 | l :: _ -> state
.y - l.pagey
5138 clamp (pgscale (-state
.winh
))
5142 | @next | @kpnext
->
5146 match List.rev state
.layout with
5148 | l :: _ -> getpagey
l.pageno
5150 clamp (pgscale state
.winh
)
5154 | @g | @home
| @kphome
->
5157 | @G
| @jend
| @kpend
->
5159 gotoghyll (clamp state
.maxy)
5161 | @right
| @kpright
when Wsi.withalt mask
->
5162 gotoghyll (getnav 1)
5163 | @left | @kpleft
when Wsi.withalt mask
->
5164 gotoghyll (getnav ~
-1)
5169 | @v when conf
.debug
->
5172 match getopaque l.pageno with
5175 let x0, y0, x1, y1 = pagebbox
opaque in
5176 let a,b = float x0, float y0 in
5177 let c,d = float x1, float y0 in
5178 let e,f = float x1, float y1 in
5179 let h,j
= float x0, float y1 in
5180 let rect = (a,b,c,d,e,f,h,j
) in
5182 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5184 G.postRedisplay "v";
5187 let mode = state
.mode in
5188 let cmd = ref E.s in
5189 let onleave = function
5190 | Cancel
-> state
.mode <- mode
5193 match getopaque l.pageno with
5194 | Some
opaque -> pipesel opaque !cmd
5195 | None
-> ()) state
.layout;
5199 cbput state
.hists
.sel
s;
5203 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5205 G.postRedisplay "|";
5206 state
.mode <- Textentry
(te, onleave);
5209 vlog "huh? %s" (Wsi.keyname
key)
5212 let linknavkeyboard key mask
linknav =
5213 let getpage pageno =
5214 let rec loop = function
5216 | l :: _ when l.pageno = pageno -> Some
l
5217 | _ :: rest
-> loop rest
5218 in loop state
.layout
5220 let doexact (pageno, n) =
5221 match getopaque pageno, getpage pageno with
5222 | Some
opaque, Some
l ->
5223 if key = @enter
|| key = @kpenter
5225 let under = getlink
opaque n in
5226 G.postRedisplay "link gotounder";
5233 Some
(findlink
opaque LDfirst
), -1
5236 Some
(findlink
opaque LDlast
), 1
5239 Some
(findlink
opaque (LDleft
n)), -1
5242 Some
(findlink
opaque (LDright
n)), 1
5245 Some
(findlink
opaque (LDup
n)), -1
5248 Some
(findlink
opaque (LDdown
n)), 1
5253 begin match findpwl
l.pageno dir with
5257 state
.mode <- LinkNav
(Ltgendir
dir);
5258 let y, h = getpageyh
pageno in
5261 then y + h - state
.winh
5266 begin match getopaque pageno, getpage pageno with
5267 | Some
opaque, Some
_ ->
5269 let ld = if dir > 0 then LDfirst
else LDlast
in
5272 begin match link with
5274 showlinktype (getlink
opaque m);
5275 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5276 G.postRedisplay "linknav jpage";
5277 | Lnotfound
-> notfound dir
5283 begin match opt with
5284 | Some Lnotfound
-> pwl l dir;
5285 | Some
(Lfound
m) ->
5289 let _, y0, _, y1 = getlinkrect
opaque m in
5291 then gotopage1 l.pageno y0
5293 let d = fstate
.fontsize
+ 1 in
5294 if y1 - l.pagey > l.pagevh - d
5295 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5296 else G.postRedisplay "linknav";
5298 showlinktype (getlink
opaque m);
5299 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5302 | None
-> viewkeyboard key mask
5304 | _ -> viewkeyboard key mask
5309 G.postRedisplay "leave linknav"
5313 | Ltgendir
_ -> viewkeyboard key mask
5314 | Ltexact exact
-> doexact exact
5317 let keyboard key mask
=
5318 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5319 then wcmd "interrupt"
5320 else state
.uioh <- state
.uioh#
key key mask
5323 let birdseyekeyboard key mask
5324 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5326 match conf
.columns
with
5328 | Cmulti
((c, _, _), _) -> c
5329 | Csplit
_ -> failwith
"bird's eye split mode"
5331 let pgh layout = List.fold_left
5332 (fun m l -> max
l.pageh
m) state
.winh
layout in
5334 | @l when Wsi.withctrl mask
->
5335 let y, h = getpageyh
pageno in
5336 let top = (state
.winh
- h) / 2 in
5337 gotoy (max
0 (y - top))
5338 | @enter
| @kpenter
-> leavebirdseye beye
false
5339 | @escape
-> leavebirdseye beye
true
5340 | @up
-> upbirdseye incr beye
5341 | @down
-> downbirdseye incr beye
5342 | @left -> upbirdseye 1 beye
5343 | @right
-> downbirdseye 1 beye
5346 begin match state
.layout with
5350 state
.mode <- Birdseye
(
5351 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5353 gotopage1 l.pageno 0;
5356 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5358 | [] -> gotoy (clamp (-state
.winh
))
5360 state
.mode <- Birdseye
(
5361 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5363 gotopage1 l.pageno 0
5366 | [] -> gotoy (clamp (-state
.winh
))
5370 begin match List.rev state
.layout with
5372 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5373 begin match layout with
5375 let incr = l.pageh
- l.pagevh in
5380 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5382 G.postRedisplay "birdseye pagedown";
5384 else gotoy (clamp (incr + conf
.interpagespace
*2));
5388 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5389 gotopage1 l.pageno 0;
5392 | [] -> gotoy (clamp state
.winh
)
5396 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5400 let pageno = state
.pagecount
- 1 in
5401 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5402 if not
(pagevisible state
.layout pageno)
5405 match List.rev state
.pdims
with
5407 | (_, _, h, _) :: _ -> h
5409 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5410 else G.postRedisplay "birdseye end";
5412 | _ -> viewkeyboard key mask
5417 match state
.mode with
5418 | Textentry
_ -> scalecolor 0.4
5420 | View
-> scalecolor 1.0
5421 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5422 if l.pageno = hooverpageno
5425 if l.pageno = pageno
5427 let c = scalecolor 1.0 in
5429 GlDraw.line_width
3.0;
5430 let dispx = xadjsb l.pagedispx in
5432 (float (dispx-1)) (float (l.pagedispy-1))
5433 (float (dispx+l.pagevw+1))
5434 (float (l.pagedispy+l.pagevh+1))
5436 GlDraw.line_width
1.0;
5445 let postdrawpage l linkindexbase
=
5446 match getopaque l.pageno with
5448 if tileready l l.pagex
l.pagey
5450 let x = l.pagedispx - l.pagex
+ xadjsb 0
5451 and y = l.pagedispy - l.pagey in
5453 match conf
.columns
with
5454 | Csingle
_ | Cmulti
_ ->
5455 (if conf
.hlinks
then 1 else 0)
5457 && not
(isbirdseye state
.mode) then 2 else 0)
5461 match state
.mode with
5462 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5468 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5473 let scrollindicator () =
5474 let sbw, ph
, sh = state
.uioh#
scrollph in
5475 let sbh, pw, sw = state
.uioh#scrollpw
in
5480 else (state
.winw
- sbw), state
.winw
5483 GlDraw.color (0.64, 0.64, 0.64);
5484 filledrect (float x0) 0. (float x1) (float state
.winh
);
5486 0. (float (state
.winh
- sbh))
5487 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5489 GlDraw.color (0.0, 0.0, 0.0);
5491 filledrect (float x0) ph
(float x1) (ph
+. sh);
5492 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5496 match state
.mstate
with
5497 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5500 | Msel
((x0, y0), (x1, y1)) ->
5501 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5502 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5503 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5504 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5507 let showrects = function [] -> () | rects
->
5509 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5510 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5512 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5514 if l.pageno = pageno
5516 let dx = float (l.pagedispx - l.pagex
) in
5517 let dy = float (l.pagedispy - l.pagey) in
5518 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5519 Raw.sets_float state
.vraw ~
pos:0
5524 GlArray.vertex `two state
.vraw
;
5525 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5534 GlClear.color (scalecolor2 conf
.bgcolor
);
5535 GlClear.clear
[`
color];
5536 List.iter
drawpage state
.layout;
5538 match state
.mode with
5539 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5540 begin match getopaque pageno with
5542 let dx = xadjsb 0 in
5543 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5544 let x0 = x0 + dx and x1 = x1 + dx in
5551 | None
-> state
.rects
5553 | LinkNav
(Ltgendir
_)
5556 | View
-> state
.rects
5559 let rec postloop linkindexbase
= function
5561 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5562 postloop linkindexbase rest
5566 postloop 0 state
.layout;
5568 begin match state
.mstate
with
5569 | Mzoomrect
((x0, y0), (x1, y1)) ->
5571 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5572 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5573 filledrect (float x0) (float y0) (float x1) (float y1);
5577 | Mscrolly
| Mscrollx
5586 let zoomrect x y x1 y1 =
5589 and y0 = min
y y1 in
5590 gotoy (state
.y + y0);
5591 state
.anchor <- getanchor
();
5592 let zoom = (float state
.w) /. float (x1 - x0) in
5595 let adjw = wadjsb state
.winw
in
5597 then (adjw - state
.w) / 2
5600 match conf
.fitmodel
with
5601 | FitWidth
| FitProportional
-> simple ()
5603 match conf
.columns
with
5605 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5606 | Cmulti
_ | Csingle
_ -> simple ()
5608 state
.x <- (state
.x + margin) - x0;
5614 let g opaque l px py =
5615 match rectofblock
opaque px py with
5617 let x0 = a.(0) -. 20. in
5618 let x1 = a.(1) +. 20. in
5619 let y0 = a.(2) -. 20. in
5620 let zoom = (float state
.w) /. (x1 -. x0) in
5621 let pagey = getpagey
l.pageno in
5622 gotoy_and_clear_text (pagey + truncate
y0);
5623 state
.anchor <- getanchor
();
5624 let margin = (state
.w - l.pagew
)/2 in
5625 state
.x <- -truncate
x0 - margin;
5630 match conf
.columns
with
5632 showtext '
!'
"block zooming does not work properly in split columns mode"
5633 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5637 let winw = wadjsb state
.winw - 1 in
5638 let s = float x /. float winw in
5639 let destx = truncate
(float (state
.w + winw) *. s) in
5640 state
.x <- winw - destx;
5641 gotoy_and_clear_text state
.y;
5642 state
.mstate
<- Mscrollx
;
5646 let s = float y /. float state
.winh
in
5647 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5648 gotoy_and_clear_text desty;
5649 state
.mstate
<- Mscrolly
;
5652 let viewmulticlick clicks
x y mask
=
5653 let g opaque l px py =
5661 if markunder
opaque px py mark
5665 match getopaque l.pageno with
5667 | Some
opaque -> pipesel opaque cmd
5669 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5670 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5675 G.postRedisplay "viewmulticlick";
5676 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5680 match conf
.columns
with
5682 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5685 let viewmouse button down
x y mask
=
5687 | n when (n == 4 || n == 5) && not down
->
5688 if Wsi.withctrl mask
5690 match state
.mstate
with
5691 | Mzoom
(oldn
, i
) ->
5699 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5701 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5703 let zoom = conf
.zoom -. incr in
5705 state
.mstate
<- Mzoom
(n, 0);
5707 state
.mstate
<- Mzoom
(n, i
+1);
5709 else state
.mstate
<- Mzoom
(n, 0)
5713 | Mscrolly
| Mscrollx
5715 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5718 match state
.autoscroll
with
5719 | Some step
-> setautoscrollspeed step
(n=4)
5721 if conf
.wheelbypage
|| conf
.presentation
5730 then -conf
.scrollstep
5731 else conf
.scrollstep
5733 let incr = incr * 2 in
5734 let y = clamp incr in
5735 gotoy_and_clear_text y
5738 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5740 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5741 gotoy_and_clear_text state
.y
5743 | 1 when Wsi.withshift mask
->
5744 state
.mstate
<- Mnone
;
5747 match unproject x y with
5748 | Some
(pageno, ux
, uy
) ->
5749 let cmd = Printf.sprintf
5751 conf
.stcmd state
.path pageno ux uy
5757 | 1 when Wsi.withctrl mask
->
5760 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5761 state
.mstate
<- Mpan
(x, y)
5764 state
.mstate
<- Mnone
5769 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5771 state
.mstate
<- Mzoomrect
(p, p)
5774 match state
.mstate
with
5775 | Mzoomrect
((x0, y0), _) ->
5776 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5777 then zoomrect x0 y0 x y
5780 G.postRedisplay "kill accidental zoom rect";
5784 | Mscrolly
| Mscrollx
5790 | 1 when x > state
.winw - vscrollw () ->
5793 let _, position, sh = state
.uioh#
scrollph in
5794 if y > truncate
position && y < truncate
(position +. sh)
5795 then state
.mstate
<- Mscrolly
5798 state
.mstate
<- Mnone
5800 | 1 when y > state
.winh
- hscrollh () ->
5803 let _, position, sw = state
.uioh#scrollpw
in
5804 if x > truncate
position && x < truncate
(position +. sw)
5805 then state
.mstate
<- Mscrollx
5808 state
.mstate
<- Mnone
5810 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5813 let dest = if down
then getunder x y else Unone
in
5814 begin match dest with
5817 | Uremote
_ | Uremotedest
_
5818 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5821 | Unone
when down
->
5822 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5823 state
.mstate
<- Mpan
(x, y);
5825 | Uannotation contents
-> enterannotmode contents
5827 | Unone
| Utext
_ ->
5832 state
.mstate
<- Msel
((x, y), (x, y));
5833 G.postRedisplay "mouse select";
5837 match state
.mstate
with
5840 | Mzoom
_ | Mscrollx
| Mscrolly
->
5841 state
.mstate
<- Mnone
5843 | Mzoomrect
((x0, y0), _) ->
5847 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5848 state
.mstate
<- Mnone
5850 | Msel
((x0, y0), (x1, y1)) ->
5851 let rec loop = function
5855 let a0 = l.pagedispy in
5856 let a1 = a0 + l.pagevh in
5857 let b0 = l.pagedispx in
5858 let b1 = b0 + l.pagevw in
5859 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5860 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5864 match getopaque l.pageno with
5867 match Unix.pipe
() with
5871 "can not create sel pipe: %s"
5875 Ne.clo fd
(fun msg
->
5876 dolog
"%s close failed: %s" what msg
)
5879 try popen
cmd [r, 0; w, -1]; true
5881 dolog
"can not execute %S: %s"
5888 G.postRedisplay "copysel";
5890 else clo "Msel pipe/w" w;
5891 clo "Msel pipe/r" r;
5893 dosel conf
.selcmd
();
5894 state
.roam
<- dosel conf
.paxcmd
;
5906 let birdseyemouse button down
x y mask
5907 (conf
, leftx
, _, hooverpageno
, anchor) =
5910 let rec loop = function
5913 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5914 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5916 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5922 | _ -> viewmouse button down
x y mask
5928 method key key mask
=
5929 begin match state
.mode with
5930 | Textentry
textentry -> textentrykeyboard key mask
textentry
5931 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5932 | View
-> viewkeyboard key mask
5933 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5937 method button button bstate
x y mask
=
5938 begin match state
.mode with
5940 | View
-> viewmouse button bstate
x y mask
5941 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5946 method multiclick clicks
x y mask
=
5947 begin match state
.mode with
5949 | View
-> viewmulticlick clicks
x y mask
5956 begin match state
.mode with
5958 | View
| Birdseye
_ | LinkNav
_ ->
5959 match state
.mstate
with
5960 | Mzoom
_ | Mnone
-> ()
5965 state
.mstate
<- Mpan
(x, y);
5967 then state
.x <- panbound (state
.x + dx);
5969 gotoy_and_clear_text y
5972 state
.mstate
<- Msel
(a, (x, y));
5973 G.postRedisplay "motion select";
5976 let y = min state
.winh
(max
0 y) in
5980 let x = min state
.winw (max
0 x) in
5983 | Mzoomrect
(p0
, _) ->
5984 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5985 G.postRedisplay "motion zoomrect";
5989 method pmotion
x y =
5990 begin match state
.mode with
5991 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5992 let rec loop = function
5994 if hooverpageno
!= -1
5996 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5997 G.postRedisplay "pmotion birdseye no hoover";
6000 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6001 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6003 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6004 G.postRedisplay "pmotion birdseye hoover";
6014 match state
.mstate
with
6015 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
6024 let past, _, _ = !r in
6026 let delta = now -. past in
6029 else r := (now, x, y)
6033 method infochanged
_ = ()
6036 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6039 then 0.0, float state
.winh
6040 else scrollph state
.y maxy
6045 let winw = wadjsb state
.winw in
6046 let fwinw = float winw in
6048 let sw = fwinw /. float state
.w in
6049 let sw = fwinw *. sw in
6050 max
sw (float conf
.scrollh
)
6053 let maxx = state
.w + winw in
6054 let x = winw - state
.x in
6055 let percent = float x /. float maxx in
6056 (fwinw -. sw) *. percent
6058 hscrollh (), position, sw
6062 match state
.mode with
6063 | LinkNav
_ -> "links"
6064 | Textentry
_ -> "textentry"
6065 | Birdseye
_ -> "birdseye"
6068 findkeyhash conf
modename
6070 method eformsgs
= true
6073 let adderrmsg src msg
=
6074 Buffer.add_string state
.errmsgs msg
;
6075 state
.newerrmsgs
<- true;
6079 let adderrfmt src fmt
=
6080 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6084 let cl = splitatspace cmds
in
6086 try Scanf.sscanf
s fmt
f
6088 adderrfmt "remote exec"
6089 "error processing '%S': %s\n" cmds
(exntos exn
)
6092 | "reload" :: [] -> reload ()
6093 | "goto" :: args
:: [] ->
6094 scan args
"%u %f %f"
6096 let cmd, _ = state
.geomcmds
in
6098 then gotopagexy pageno x y
6101 gotopagexy pageno x y;
6104 state
.reprf
<- f state
.reprf
6106 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6107 | "gotor" :: args
:: [] ->
6109 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6110 | "gotord" :: args
:: [] ->
6112 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6113 | "rect" :: args
:: [] ->
6114 scan args
"%u %u %f %f %f %f"
6115 (fun pageno color x0 y0 x1 y1 ->
6116 onpagerect pageno (fun w h ->
6117 let _,w1,h1
,_ = getpagedim
pageno in
6118 let sw = float w1 /. float w
6119 and sh = float h1
/. float h in
6123 and y1s
= y1 *. sh in
6124 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6126 state
.rects <- (pageno, color, rect) :: state
.rects;
6127 G.postRedisplay "rect";
6130 | "activatewin" :: [] -> Wsi.activatewin
()
6131 | "quit" :: [] -> raise Quit
6133 adderrfmt "remote command"
6134 "error processing remote command: %S\n" cmds
;
6138 let scratch = Bytes.create
80 in
6139 let buf = Buffer.create
80 in
6142 try Some
(Unix.read fd
scratch 0 80)
6144 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6145 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6148 match tempfr () with
6154 if Buffer.length
buf > 0
6156 let s = Buffer.contents
buf in
6166 let pos = Bytes.index_from
scratch ppos '
\n'
in
6167 if pos >= n then -1 else pos
6168 with Not_found
-> -1
6172 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6173 let s = Buffer.contents
buf in
6179 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6185 let remoteopen path =
6186 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6188 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6193 let gcconfig = ref E.s in
6194 let trimcachepath = ref E.s in
6195 let rcmdpath = ref E.s in
6196 let pageno = ref None
in
6197 let rootwid = ref 0 in
6198 let openlast = ref false in
6199 let nofc = ref false in
6200 selfexec := Sys.executable_name
;
6203 [("-p", Arg.String
(fun s -> state
.password
<- s),
6204 "<password> Set password");
6208 Config.fontpath
:= s;
6209 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6211 "<path> Set path to the user interface font");
6215 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6216 Config.confpath
:= s),
6217 "<path> Set path to the configuration file");
6219 ("-last", Arg.Set
openlast, " Open last document");
6221 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6222 "<page-number> Jump to page");
6224 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6225 "<path> Set path to the trim cache file");
6227 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6228 "<named-destination> Set named destination");
6230 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6231 ("-cxack", Arg.Set
cxack, " Cut corners");
6233 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6234 "<path> Set path to the remote commands source");
6236 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6237 "<original-path> Set original path");
6239 ("-gc", Arg.Set_string
gcconfig,
6240 "<script-path> Collect garbage with the help of a script");
6242 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6244 ("-v", Arg.Unit
(fun () ->
6246 "%s\nconfiguration path: %s\n"
6250 exit
0), " Print version and exit");
6252 ("-embed", Arg.Set_int
rootwid,
6253 "<window-id> Embed into window")
6256 (fun s -> state
.path <- s)
6257 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6260 then selfexec := !selfexec ^
" -wtmode";
6262 let histmode = emptystr state
.path && not
!openlast in
6264 if not
(Config.load !openlast)
6265 then prerr_endline
"failed to load configuration";
6266 begin match !pageno with
6267 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6271 if not
(emptystr
!gcconfig)
6274 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6276 error
"gc socketpair failed: %s" (exntos exn
)
6279 match popen
!gcconfig [(c, 0); (c, 1)] with
6284 error
"failed to popen gc script: %s" (exntos exn
);
6287 let wsfd, winw, winh
= Wsi.init
(object (self)
6288 val mutable m_clicks
= 0
6289 val mutable m_click_x
= 0
6290 val mutable m_click_y
= 0
6291 val mutable m_lastclicktime
= infinity
6293 method private cleanup
=
6294 state
.roam
<- noroam
;
6295 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6296 method expose
= G.postRedisplay"expose"
6300 | Wsi.Unobscured
-> "unobscured"
6301 | Wsi.PartiallyObscured
-> "partiallyobscured"
6302 | Wsi.FullyObscured
-> "fullyobscured"
6304 vlog "visibility change %s" name
6305 method display = display ()
6306 method map mapped
= vlog "mappped %b" mapped
6307 method reshape w h =
6310 method mouse
b d x y m =
6311 if d && canselect ()
6313 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6319 if abs
x - m_click_x
> 10
6320 || abs
y - m_click_y
> 10
6321 || abs_float
(t -. m_lastclicktime
) > 0.3
6323 m_clicks
<- m_clicks
+ 1;
6324 m_lastclicktime
<- t;
6328 G.postRedisplay "cleanup";
6329 state
.uioh <- state
.uioh#button
b d x y m;
6331 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6336 m_lastclicktime
<- infinity
;
6337 state
.uioh <- state
.uioh#button
b d x y m
6341 state
.uioh <- state
.uioh#button
b d x y m
6344 state
.mpos
<- (x, y);
6345 state
.uioh <- state
.uioh#motion
x y
6346 method pmotion
x y =
6347 state
.mpos
<- (x, y);
6348 state
.uioh <- state
.uioh#pmotion
x y
6350 let mascm = m land (
6351 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6354 let x = state
.x and y = state
.y in
6356 if x != state
.x || y != state
.y then self#cleanup
6358 match state
.keystate
with
6360 let km = k
, mascm in
6363 let modehash = state
.uioh#
modehash in
6364 try Hashtbl.find modehash km
6366 try Hashtbl.find (findkeyhash conf
"global") km
6367 with Not_found
-> KMinsrt
(k
, m)
6369 | KMinsrt
(k
, m) -> keyboard k
m
6370 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6371 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6373 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6374 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6375 state
.keystate
<- KSnone
6376 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6377 state
.keystate
<- KSinto
(keys
, insrt
)
6378 | KSinto
_ -> state
.keystate
<- KSnone
6381 state
.mpos
<- (x, y);
6382 state
.uioh <- state
.uioh#pmotion
x y
6383 method leave = state
.mpos
<- (-1, -1)
6384 method winstate wsl
= state
.winstate
<- wsl
6385 method quit
= raise Quit
6386 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6391 List.exists
GlMisc.check_extension
6392 [ "GL_ARB_texture_rectangle"
6393 ; "GL_EXT_texture_recangle"
6394 ; "GL_NV_texture_rectangle" ]
6396 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6399 let r = GlMisc.get_string `renderer
in
6400 let p = "Mesa DRI Intel(" in
6401 let l = String.length
p in
6402 String.length
r > l && String.sub
r 0 l = p
6405 defconf
.sliceheight
<- 1024;
6406 defconf
.texcount
<- 32;
6407 defconf
.usepbo
<- true;
6411 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6413 Printf.eprintf
"socketpair failed: %s" (exntos exn
);
6421 setcheckers conf
.checkers
;
6423 if conf
.redirectstderr
6427 (Buffer.to_bytes state
.errmsgs
)
6428 (match state
.errfd
with
6430 let s = Bytes.create
(80*24) in
6433 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6435 then Unix.read fd
s 0 (Bytes.length
s)
6441 else Bytes.sub
s 0 n
6445 try ignore
(Unix.write state
.stderr
s 0 (Bytes.length
s))
6446 with exn
-> print_endline
(exntos exn
)
6451 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6452 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6453 !Config.fontpath
, !trimcachepath,
6454 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6457 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6463 Wsi.settitle
"llpp (history)";
6467 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6468 opendoc state
.path state
.password
;
6473 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6476 if nonemptystr
!rcmdpath
6477 then remoteopen !rcmdpath
6482 let rec loop deadline
=
6484 match state
.errfd
with
6485 | None
-> [state
.ss; state
.wsfd]
6486 | Some fd
-> [state
.ss; state
.wsfd; fd
]
6491 | Some fd
-> fd
:: r
6495 state
.redisplay
<- false;
6502 if deadline
= infinity
6504 else max
0.0 (deadline
-. now)
6509 try Unix.select
r [] [] timeout
6510 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6516 if state
.ghyll
== noghyll
6518 match state
.autoscroll
with
6519 | Some step
when step
!= 0 ->
6520 let y = state
.y + step
in
6524 else if y >= state
.maxy then 0 else y
6527 if state
.mode = View
6528 then state
.text <- E.s;
6531 else deadline
+. 0.01
6536 let rec checkfds = function
6538 | fd
:: rest
when fd
= state
.ss ->
6539 let cmd = readcmd state
.ss in
6543 | fd
:: rest
when fd
= state
.wsfd ->
6547 | fd
:: rest
when Some fd
= !optrfd ->
6548 begin match remote fd
with
6549 | None
-> optrfd := remoteopen !rcmdpath;
6550 | opt -> optrfd := opt
6555 let s = Bytes.create
80 in
6556 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6557 if conf
.redirectstderr
6559 Buffer.add_substring state
.errmsgs
(Bytes.to_string
s) 0 n;
6560 state
.newerrmsgs
<- true;
6561 state
.redisplay
<- true;
6564 prerr_string
(String.sub
(Bytes.to_string
s) 0 n);
6570 if !reeenterhist then (
6572 reeenterhist := false;
6576 if deadline
= infinity
6580 match state
.autoscroll
with
6581 | Some step
when step
!= 0 -> deadline1
6582 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6590 Config.save
leavebirdseye;