6 type pipe
= (Unix.file_descr
* Unix.file_descr
);;
8 external init
: pipe
-> params
-> unit = "ml_init";;
9 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
10 external hassel
: opaque
-> bool = "ml_hassel";;
11 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
12 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
13 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
14 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
15 external clearmark
: opaque
-> unit = "ml_clearmark";;
16 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
17 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
18 external measurestr
: int -> string -> float = "ml_measure_string";;
19 external postprocess
:
20 opaque
-> int -> int -> int -> (int * string * int) -> int
22 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
23 external setaalevel
: int -> unit = "ml_setaalevel";;
24 external realloctexts
: int -> bool = "ml_realloctexts";;
25 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
26 external getlink
: opaque
-> int -> under
= "ml_getlink";;
27 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
28 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
29 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links"
30 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
31 external freepbo
: opaque
-> unit = "ml_freepbo";;
32 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
33 external pbousable
: unit -> bool = "ml_pbo_usable";;
34 external unproject
: opaque
-> int -> int -> (int * int) option
36 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
37 external rectofblock
: opaque
-> int -> int -> float array
option
39 external begintiles
: unit -> unit = "ml_begintiles";;
40 external endtiles
: unit -> unit = "ml_endtiles";;
42 let reeenterhist = ref false;;
43 let selfexec = ref E.s
;;
45 let drawstring size x y s
=
47 Gl.enable `texture_2d
;
48 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
49 ignore
(drawstr size x y s
);
51 Gl.disable `texture_2d
;
54 let drawstring1 size x y s
=
58 let drawstring2 size x y fmt
=
59 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
63 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
64 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
65 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
66 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
67 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
68 dolog
" column %d" l
.pagecol
;
72 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
74 dolog
" x0,y0=(% f, % f)" x0 y0
;
75 dolog
" x1,y1=(% f, % f)" x1 y1
;
76 dolog
" x2,y2=(% f, % f)" x2 y2
;
77 dolog
" x3,y3=(% f, % f)" x3 y3
;
81 let isbirdseye = function Birdseye _
-> true | _
-> false;;
82 let istextentry = function Textentry _
-> true | _
-> false;;
84 let wtmode = ref false;;
85 let cxack = ref false;;
87 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
90 if (conf
.scrollb
land scrollbhv
= 0)
91 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
97 if (conf
.scrollb
land scrollbvv
= 0)
102 let wadjsb w
= w
- vscrollw ();;
103 let xadjsb x
= if conf
.leftscroll
then x
+ vscrollw () else x
;;
106 fstate
.fontsize
<- n
;
107 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
108 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
114 Printf.kprintf prerr_endline fmt
116 Printf.kprintf ignore fmt
120 if emptystr conf
.pathlauncher
121 then print_endline state
.path
123 let re = Str.regexp
"%s" in
124 let command = Str.global_replace
re state
.path conf
.pathlauncher
in
127 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
133 type 'a t
= | Res
of 'a
| Exn
of exn
;;
141 try tempfailureretry
Unix.close fd
142 with exn
-> f
(exntos exn
)
146 try Res
(tempfailureretry
Unix.dup fd
)
151 try Res
(tempfailureretry
(Unix.dup2 fd1
) fd2
)
156 let redirectstderr () =
157 let clofail what errmsg
= dolog
"failed to close %s: %s" what errmsg
in
158 if conf
.redirectstderr
160 match Ne.res Unix.pipe
with
162 dolog
"failed to create stderr redirection pipes: %s" (exntos exn
)
165 begin match Ne.dup Unix.stderr
with
167 dolog
"failed to dup stderr: %s" (exntos exn
);
168 Ne.clo r
(clofail "pipe/r");
169 Ne.clo w
(clofail "pipe/w");
171 | Ne.Res dupstderr
->
172 begin match Ne.dup2 w
Unix.stderr
with
174 dolog
"failed to dup2 to stderr: %s" (exntos exn
);
175 Ne.clo dupstderr
(clofail "stderr duplicate");
176 Ne.clo r
(clofail "redir pipe/r");
177 Ne.clo w
(clofail "redir pipe/w");
180 state
.stderr
<- dupstderr
;
181 state
.errfd
<- Some r
;
185 state
.newerrmsgs
<- false;
186 begin match state
.errfd
with
188 begin match Ne.dup2 state
.stderr
Unix.stderr
with
190 dolog
"failed to dup2 original stderr: %s" (exntos exn
)
192 Ne.clo fd
(clofail "dup of stderr");
197 prerr_string
(Buffer.contents state
.errmsgs
);
199 Buffer.clear state
.errmsgs
;
205 let postRedisplay who
=
207 then prerr_endline
("redisplay for " ^ who
);
208 state
.redisplay
<- true;
212 let getopaque pageno
=
213 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
214 with Not_found
-> None
217 let putopaque pageno opaque
=
218 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
221 let pagetranslatepoint l x y
=
222 let dy = y
- l
.pagedispy
in
223 let y = dy + l
.pagey
in
224 let dx = x
- l
.pagedispx
in
225 let x = dx + l
.pagex
in
229 let onppundermouse g
x y d
=
232 begin match getopaque l
.pageno
with
234 let x0 = l
.pagedispx
in
235 let x1 = x0 + l
.pagevw
in
236 let y0 = l
.pagedispy
in
237 let y1 = y0 + l
.pagevh
in
238 if y >= y0 && y <= y1 && x >= x0 && x <= x1
240 let px, py
= pagetranslatepoint l
x y in
241 match g opaque l
px py
with
254 let g opaque l
px py
=
257 match rectofblock opaque
px py
with
259 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
260 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
261 G.postRedisplay "getunder";
264 match whatsunder opaque
px py
with
266 | under
-> Some under
268 onppundermouse g x y Unone
273 match unproject opaque
x y with
274 | Some
(x, y) -> Some
(Some
(l
.pageno
, x, y))
277 onppundermouse g x y None
;
281 state
.text
<- Printf.sprintf
"%c%s" c s
;
282 G.postRedisplay "showtext";
285 let pipesel opaque cmd
=
288 match Ne.res Unix.pipe
with
291 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
293 let doclose what fd
=
294 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
297 try popen cmd
[r
, 0; w
, -1]; true
299 dolog
"can not execute %S: %s" cmd
(exntos exn
);
305 G.postRedisplay "pipesel";
307 else doclose "pipesel pipe/w" w
;
308 doclose "pipesel pipe/r" r
;
312 let g opaque l
px py
=
313 if markunder opaque
px py conf
.paxmark
316 match getopaque l
.pageno
with
318 | Some opaque
-> pipesel opaque conf
.paxcmd
323 G.postRedisplay "paxunder";
324 if conf
.paxmark
= Mark_page
327 match getopaque l
.pageno
with
329 | Some opaque
-> clearmark opaque
) state
.layout
;
331 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
335 match Ne.res Unix.pipe
with
337 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
340 Ne.clo fd
(fun msg
->
341 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
345 try popen conf
.selcmd
[r
, 0; w
, -1]; true
348 (Printf.sprintf
"failed to execute %s: %s"
349 conf
.selcmd
(exntos exn
));
355 let l = String.length s
in
356 let n = tempfailureretry
(Unix.write w s
0) l in
361 "failed to write %d characters to sel pipe, wrote %d"
366 (Printf.sprintf
"failed to write to sel pipe: %s"
371 clo "selstring pipe/r" r
;
372 clo "selstring pipe/w" w
;
375 let undertext = function
378 | Ulinkgoto
(pageno
, _
) -> Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
379 | Utext s
-> "font: " ^ s
380 | Uunexpected s
-> "unexpected: " ^ s
381 | Ulaunch s
-> "launch: " ^ s
382 | Unamed s
-> "named: " ^ s
383 | Uremote
(filename
, pageno
) ->
384 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
385 | Uremotedest
(filename
, destname
) ->
386 Printf.sprintf
"%s: destination %S" filename destname
389 let updateunder x y =
390 match getunder x y with
391 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
393 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
394 Wsi.setcursor
Wsi.CURSOR_INFO
395 | Ulinkgoto
(pageno
, _
) ->
397 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
398 Wsi.setcursor
Wsi.CURSOR_INFO
400 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
401 Wsi.setcursor
Wsi.CURSOR_TEXT
403 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
404 Wsi.setcursor
Wsi.CURSOR_INHERIT
406 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
407 Wsi.setcursor
Wsi.CURSOR_INHERIT
409 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
410 Wsi.setcursor
Wsi.CURSOR_INHERIT
411 | Uremote
(filename
, pageno
) ->
412 if conf
.underinfo
then showtext 'r'
413 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
414 Wsi.setcursor
Wsi.CURSOR_INFO
415 | Uremotedest
(filename
, destname
) ->
416 if conf
.underinfo
then showtext 'r'
417 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
418 Wsi.setcursor
Wsi.CURSOR_INFO
421 let showlinktype under
=
427 let s = undertext under
in
432 let b = Buffer.create
(String.length
s + 1) in
433 Buffer.add_string
b s;
438 let intentry_with_suffix text key
=
440 if key
>= 32 && key
< 127
444 match Char.lowercase
c with
446 let text = addchar text c in
450 let text = addchar text c in
454 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
460 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
461 if n != 4 then error
"incomplete read(len) = %d" n;
463 lor (Char.code
s.[0] lsl 24)
464 lor (Char.code
s.[1] lsl 16)
465 lor (Char.code
s.[2] lsl 8)
466 lor (Char.code
s.[3] lsl 0)
468 let s = String.create
len in
469 let n = tempfailureretry
(Unix.read fd
s 0) len in
470 if n != len then error
"incomplete read(data) %d vs %d" n len;
474 let btod b = if b then 1 else 0;;
477 let b = Buffer.create
16 in
478 Buffer.add_string
b "llll";
481 let s = Buffer.contents
b in
482 let n = String.length
s in
484 (* dolog "wcmd %S" (String.sub s 4 len); *)
485 s.[0] <- Char.chr
((len lsr 24) land 0xff);
486 s.[1] <- Char.chr
((len lsr 16) land 0xff);
487 s.[2] <- Char.chr
((len lsr 8) land 0xff);
488 s.[3] <- Char.chr
(len land 0xff);
489 let n'
= tempfailureretry
(Unix.write state
.sw
s 0) n in
490 if n'
!= n then error
"write failed %d vs %d" n'
n;
494 let nogeomcmds cmds
=
496 | s, [] -> emptystr
s
500 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
501 let sh = sh - (hscrollh ()) in
502 let rec fold accu
n =
503 if n = Array.length
b
506 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
509 || n = state
.pagecount
- coverB
510 || (n - coverA
) mod columns
= columns
- 1)
516 let pagey = max
0 (y - vy
) in
517 let pagedispy = if pagey > 0 then 0 else vy
- y in
518 let pagedispx, pagex
=
520 if n = coverA
- 1 || n = state
.pagecount
- coverB
521 then state
.x + (wadjsb state
.winw
- w
) / 2
522 else dx + xoff
+ state
.x
529 let vw = wadjsb state
.winw
- pagedispx in
530 let pw = w
- pagex
in
533 let pagevh = min
(h
- pagey) (sh - pagedispy) in
534 if pagevw > 0 && pagevh > 0
545 ; pagedispx = pagedispx
546 ; pagedispy = pagedispy
558 if Array.length
b = 0
560 else List.rev
(fold [] (page_of_y
y))
563 let layoutS (columns
, b) y sh =
564 let sh = sh - hscrollh () in
565 let rec fold accu n =
566 if n = Array.length
b
569 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
576 let x = xoff
+ state
.x in
577 let pagey = max
0 (y - vy
) in
578 let pagedispy = if pagey > 0 then 0 else vy
- y in
579 let pagedispx, pagex
=
593 let pagecolw = pagew
/columns
in
595 if pagecolw < state
.winw
596 then pagedispx + ((wadjsb state
.winw
- pagecolw) / 2)
600 let vw = wadjsb state
.winw
- pagedispx in
601 let pw = pagew
- pagex
in
604 let pagevw = min
pagevw pagecolw in
605 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
606 if pagevw > 0 && pagevh > 0
617 ; pagedispx = pagedispx
618 ; pagedispy = pagedispy
619 ; pagecol
= n mod columns
634 if nogeomcmds state
.geomcmds
636 match conf
.columns
with
637 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
638 | Cmulti
c -> layoutN c y sh
639 | Csplit
s -> layoutS s y sh
644 let y = state
.y + incr
in
646 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
651 let tilex = l.pagex
mod conf
.tilew
in
652 let tiley = l.pagey mod conf
.tileh
in
654 let col = l.pagex
/ conf
.tilew
in
655 let row = l.pagey / conf
.tileh
in
657 let rec rowloop row y0 dispy h
=
661 let dh = conf
.tileh
- y0 in
663 let rec colloop col x0 dispx w
=
667 let dw = conf
.tilew
- x0 in
669 let dispx'
= xadjsb dispx in
670 f col row dispx' dispy
x0 y0 dw dh;
671 colloop (col+1) 0 (dispx+dw) (w
-dw)
674 colloop col tilex l.pagedispx l.pagevw;
675 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
678 if l.pagevw > 0 && l.pagevh > 0
679 then rowloop row tiley l.pagedispy l.pagevh;
682 let gettileopaque l col row =
684 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
686 try Some
(Hashtbl.find state
.tilemap
key)
687 with Not_found
-> None
690 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
691 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
692 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
695 let filledrect x0 y0 x1 y1 =
696 GlArray.disable `texture_coord
;
697 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
698 GlArray.vertex `two state
.vraw
;
699 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
700 GlArray.enable `texture_coord
;
703 let linerect x0 y0 x1 y1 =
704 GlArray.disable `texture_coord
;
705 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
706 GlArray.vertex `two state
.vraw
;
707 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
708 GlArray.enable `texture_coord
;
711 let drawtiles l color
=
714 let f col row x y tilex tiley w h
=
715 match gettileopaque l col row with
716 | Some
(opaque
, _
, t
) ->
717 let params = x, y, w
, h
, tilex, tiley in
719 then GlTex.env
(`mode `blend
);
720 drawtile
params opaque
;
722 then GlTex.env
(`mode `modulate
);
726 let s = Printf.sprintf
730 let w = measurestr fstate
.fontsize
s in
731 GlDraw.color
(0.0, 0.0, 0.0);
732 filledrect (float (x-2))
735 (float (y + fstate
.fontsize
+ 2));
736 GlDraw.color
(1.0, 1.0, 1.0);
737 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
747 let lw = wadjsb state
.winw
- x in
750 let lh = state
.winh
- y in
754 then GlTex.env
(`mode `blend
);
755 begin match state
.checkerstexid
with
757 Gl.enable `texture_2d
;
758 GlTex.bind_texture ~target
:`texture_2d id
;
762 and y1 = float (y+h
) in
764 let tw = float w /. 16.0
765 and th
= float h
/. 16.0 in
766 let tx0 = float tilex /. 16.0
767 and ty0
= float tiley /. 16.0 in
769 and ty1
= ty0
+. th
in
770 Raw.sets_float state
.vraw ~pos
:0
771 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
772 Raw.sets_float state
.traw ~pos
:0
773 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
774 GlArray.vertex `two state
.vraw
;
775 GlArray.tex_coord `two state
.traw
;
776 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
777 Gl.disable `texture_2d
;
780 GlDraw.color
(1.0, 1.0, 1.0);
781 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
784 then GlTex.env
(`mode `modulate
);
785 if w > 128 && h
> fstate
.fontsize
+ 10
787 let c = if conf
.invert
then 1.0 else 0.0 in
788 GlDraw.color
(c, c, c);
791 then (col*conf
.tilew
, row*conf
.tileh
)
794 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
803 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
805 let tilevisible1 l x y =
807 and ax1
= l.pagex
+ l.pagevw
809 and ay1
= l.pagey + l.pagevh in
813 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
814 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
816 let rx0 = max
ax0 bx0
817 and ry0
= max ay0 by0
818 and rx1
= min ax1
bx1
819 and ry1
= min ay1 by1
in
821 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
825 let tilevisible layout n x y =
826 let rec findpageinlayout m
= function
827 | l :: rest
when l.pageno
= n ->
828 tilevisible1 l x y || (
829 match conf
.columns
with
830 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
833 | _
:: rest
-> findpageinlayout 0 rest
836 findpageinlayout 0 layout;
839 let tileready l x y =
840 tilevisible1 l x y &&
841 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
844 let tilepage n p
layout =
845 let rec loop = function
849 let f col row _ _ _ _ _ _
=
850 if state
.currently
= Idle
852 match gettileopaque l col row with
855 let x = col*conf
.tilew
856 and y = row*conf
.tileh
in
858 let w = l.pagew
- x in
862 let h = l.pageh
- y in
867 then getpbo
w h conf
.colorspace
870 wcmd "tile %s %d %d %d %d %s"
871 (~
> p
) x y w h (~
> pbo);
874 l, p
, conf
.colorspace
, conf
.angle
,
875 state
.gen
, col, row, conf
.tilew
, conf
.tileh
884 if nogeomcmds state
.geomcmds
888 let preloadlayout y =
889 let y = if y < state
.winh
then 0 else y - state
.winh
in
890 let h = state
.winh
*3 in
896 if state
.currently
!= Idle
901 begin match getopaque l.pageno
with
903 wcmd "page %d %d" l.pageno
l.pagedimno
;
904 state
.currently
<- Loading
(l, state
.gen
);
906 tilepage l.pageno opaque pages
;
911 if nogeomcmds state
.geomcmds
917 if conf
.preload && state
.currently
= Idle
918 then load (preloadlayout state
.y);
921 let layoutready layout =
922 let rec fold all ls
=
925 let seen = ref false in
926 let allvisible = ref true in
927 let foo col row _ _ _ _ _ _
=
929 allvisible := !allvisible &&
930 begin match gettileopaque l col row with
936 fold (!seen && !allvisible) rest
939 let alltilesvisible = fold true layout in
944 let y = bound
y 0 state
.maxy
in
945 let y, layout, proceed
=
946 match conf
.maxwait
with
947 | Some time
when state
.ghyll
== noghyll
->
948 begin match state
.throttle
with
950 let layout = layout y state
.winh
in
951 let ready = layoutready layout in
955 state
.throttle
<- Some
(layout, y, now
());
957 else G.postRedisplay "gotoy showall (None)";
959 | Some
(_
, _
, started
) ->
960 let dt = now
() -. started
in
963 state
.throttle
<- None
;
964 let layout = layout y state
.winh
in
966 G.postRedisplay "maxwait";
973 let layout = layout y state
.winh
in
974 if not
!wtmode || layoutready layout
975 then G.postRedisplay "gotoy ready";
981 state
.layout <- layout;
982 begin match state
.mode
with
983 | LinkNav
(Ltexact
(pageno
, linkno
)) ->
984 let rec loop = function
986 state
.mode
<- LinkNav
(Ltgendir
0)
987 | l :: _
when l.pageno
= pageno
->
988 begin match getopaque pageno
with
990 state
.mode
<- LinkNav
(Ltgendir
0)
992 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
993 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
994 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
995 then state
.mode
<- LinkNav
(Ltgendir
0)
997 | _
:: rest
-> loop rest
1002 begin match state
.mode
with
1003 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
1004 if not
(pagevisible layout pageno
)
1006 match state
.layout with
1009 state
.mode
<- Birdseye
(
1010 conf
, leftx
, l.pageno
, hooverpageno
, anchor
1013 | LinkNav
(Ltgendir dir
as lt
) ->
1015 let rec loop = function
1018 match getopaque l.pageno
with
1024 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1026 if dir
> 0 then LDfirst
else LDlast
1032 | Lnotfound
-> loop rest
1034 showlinktype (getlink opaque
n);
1035 Ltexact
(l.pageno
, n)
1039 state
.mode
<- LinkNav
linknav
1044 state
.ghyll
<- noghyll
;
1047 let mx, my
= state
.mpos
in
1052 let conttiling pageno opaque
=
1053 tilepage pageno opaque
1054 (if conf
.preload then preloadlayout state
.y else state
.layout)
1057 let gotoy_and_clear_text y =
1058 if not conf
.verbose
then state
.text <- E.s;
1062 let getanchory (n, top
, dtop
) =
1063 let y, h = getpageyh
n in
1064 if conf
.presentation
1066 let ips = calcips
h in
1067 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1069 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1072 let gotoanchor anchor
=
1073 gotoy (getanchory anchor
);
1077 cbput state
.hists
.nav
(getanchor
());
1081 let anchor = cbgetc state
.hists
.nav dir
in
1085 let gotoghyll1 single
y =
1086 let scroll f n a
b =
1087 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1089 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1091 then s (float f /. float a
)
1094 then 1.0 -. s ((float (f-b) /. float (n-b)))
1100 let ins = float a
*. 0.5
1101 and outs
= float (n-b) *. 0.5 in
1103 ins +. outs
+. float ones
1105 let rec set nab
y sy
=
1106 let (_N
, _A
, _B
), y =
1109 let scl = if y > sy
then 2 else -2 in
1110 let _N, _
, _
= nab
in
1111 (_N,0,_N), y+conf
.scrollstep
*scl
1113 let sum = summa
_N _A _B
in
1114 let dy = float (y - sy
) in
1118 then state
.ghyll
<- noghyll
1121 let s = scroll n _N _A _B
in
1122 let y1 = y1 +. ((s *. dy) /. sum) in
1123 gotoy_and_clear_text (truncate
y1);
1124 state
.ghyll
<- gf (n+1) y1;
1128 | Some
y'
when single
-> set nab
y' state
.y
1129 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1131 gf 0 (float state
.y)
1134 match conf
.ghyllscroll
with
1135 | Some nab
when not conf
.presentation
->
1136 if state
.ghyll
== noghyll
1137 then set nab
y state
.y
1138 else state
.ghyll
(Some
y)
1140 gotoy_and_clear_text y
1143 let gotoghyll = gotoghyll1 false;;
1145 let gotopage n top
=
1146 let y, h = getpageyh
n in
1147 let y = y + (truncate
(top
*. float h)) in
1151 let gotopage1 n top
=
1152 let y = getpagey
n in
1157 let invalidate s f =
1162 match state
.geomcmds
with
1163 | ps
, [] when emptystr ps
->
1165 state
.geomcmds
<- s, [];
1168 state
.geomcmds
<- ps
, [s, f];
1170 | ps
, (s'
, _
) :: rest
when s'
= s ->
1171 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1174 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1178 Hashtbl.iter
(fun _ opaque
->
1179 wcmd "freepage %s" (~
> opaque
);
1181 Hashtbl.clear state
.pagemap
;
1185 if not
(Queue.is_empty state
.tilelru
)
1187 Queue.iter
(fun (k
, p
, s) ->
1188 wcmd "freetile %s" (~
> p
);
1189 state
.memused
<- state
.memused
- s;
1190 Hashtbl.remove state
.tilemap k
;
1192 state
.uioh#infochanged Memused
;
1193 Queue.clear state
.tilelru
;
1199 let h = truncate
(float h*.conf
.zoom
) in
1200 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1204 let opendoc path password
=
1206 state
.password
<- password
;
1207 state
.gen
<- state
.gen
+ 1;
1208 state
.docinfo
<- [];
1211 setaalevel conf
.aalevel
;
1213 if emptystr state
.origin
1217 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1218 wcmd "open %d %d %s\000%s\000" (btod !wtmode) (btod !cxack) path password
;
1219 invalidate "reqlayout"
1221 wcmd "reqlayout %d %d %d %s\000"
1222 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1223 (stateh state
.winh
) state
.nameddest
1228 state
.anchor <- getanchor
();
1229 opendoc state
.path state
.password
;
1233 let c = c *. conf
.colorscale
in
1237 let scalecolor2 (r
, g, b) =
1238 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1241 let docolumns = function
1243 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1244 let rec loop pageno
pdimno pdim
y ph pdims
=
1245 if pageno
= state
.pagecount
1248 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1250 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1251 pdimno+1, pdim
, rest
1255 let x = max
0 (((wadjsb state
.winw
- w) / 2) - xoff
) in
1257 (if conf
.presentation
1258 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1259 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1262 a.(pageno
) <- (pdimno, x, y, pdim
);
1263 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1265 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1266 conf
.columns
<- Csingle
a;
1268 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1269 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1270 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1271 let rec fixrow m
= if m
= pageno
then () else
1272 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1275 let y = y + (rowh
- h) / 2 in
1276 a.(m
) <- (pdimno, x, y, pdim
);
1280 if pageno
= state
.pagecount
1281 then fixrow (((pageno
- 1) / columns
) * columns
)
1283 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1285 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1286 pdimno+1, pdim
, rest
1291 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1293 let x = (wadjsb state
.winw
- w) / 2 in
1295 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1296 x, y + ips + rowh
, h
1299 if (pageno
- coverA
) mod columns
= 0
1301 let x = max
0 (wadjsb state
.winw
- state
.w) / 2 in
1303 if conf
.presentation
1305 let ips = calcips
h in
1306 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1308 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1312 else x, y, max rowh
h
1316 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1319 if pageno
= columns
&& conf
.presentation
1321 let ips = calcips rowh
in
1322 for i
= 0 to pred columns
1324 let (pdimno, x, y, pdim
) = a.(i
) in
1325 a.(i
) <- (pdimno, x, y+ips, pdim
)
1331 fixrow (pageno
- columns
);
1336 a.(pageno
) <- (pdimno, x, y, pdim
);
1337 let x = x + w + xoff
*2 + conf
.interpagespace
in
1338 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1340 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1341 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1344 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1345 let rec loop pageno
pdimno pdim
y pdims
=
1346 if pageno
= state
.pagecount
1349 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1351 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1352 pdimno+1, pdim
, rest
1357 let rec loop1 n x y =
1358 if n = c then y else (
1359 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1360 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1363 let y = loop1 0 0 y in
1364 loop (pageno
+1) pdimno pdim
y pdims
1366 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1367 conf
.columns
<- Csplit
(c, a);
1371 docolumns conf
.columns
;
1372 state
.maxy
<- calcheight
();
1373 if state
.reprf
== noreprf
1375 match state
.mode
with
1376 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1377 let y, h = getpageyh pageno
in
1378 let top = (state
.winh
- h) / 2 in
1379 gotoy (max
0 (y - top))
1380 | _
-> gotoanchor state
.anchor
1384 state
.reprf
<- noreprf
;
1389 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1390 let firsttime = state
.geomcmds
== firstgeomcmds
in
1391 if not
firsttime && nogeomcmds state
.geomcmds
1392 then state
.anchor <- getanchor
();
1395 let w = wadjsb (truncate
(float w *. conf
.zoom
)) in
1398 setfontsize fstate
.fontsize
;
1399 GlMat.mode `modelview
;
1400 GlMat.load_identity
();
1402 GlMat.mode `projection
;
1403 GlMat.load_identity
();
1404 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1405 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1406 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1411 else float state
.x /. float state
.w
1413 invalidate "geometry"
1417 then state
.x <- truncate
(relx *. float w);
1419 match conf
.columns
with
1421 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1422 | Csplit
(c, _
) -> w * c
1424 wcmd "geometry %d %d %d"
1425 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1430 let len = String.length state
.text in
1431 let x0 = xadjsb 0 in
1434 match state
.mode
with
1435 | Textentry _
| View
| LinkNav _
->
1436 let h, _
, _
= state
.uioh#scrollpw
in
1441 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1442 (x+.w) (float (state
.winh
- hscrollh))
1445 let w = float (wadjsb state
.winw
- 1) in
1446 if state
.progress
>= 0.0 && state
.progress
< 1.0
1448 GlDraw.color
(0.3, 0.3, 0.3);
1449 let w1 = w *. state
.progress
in
1451 GlDraw.color
(0.0, 0.0, 0.0);
1452 rect (float x0+.w1) (float x0+.w-.w1)
1455 GlDraw.color
(0.0, 0.0, 0.0);
1459 GlDraw.color
(1.0, 1.0, 1.0);
1460 drawstring fstate
.fontsize
1461 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1462 (state
.winh
- hscrollh - 5) s;
1465 match state
.mode
with
1466 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1470 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1472 Printf.sprintf
"%s%s_" prefix
text
1481 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1483 let s1 = "(press 'e' to review error messasges)" in
1484 if nonemptystr
s then s ^
" " ^
s1 else s1
1494 let len = Queue.length state
.tilelru
in
1496 match state
.throttle
with
1499 then preloadlayout state
.y
1501 | Some
(layout, _
, _
) ->
1505 if state
.memused
<= conf
.memlimit
1510 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1511 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1512 let (_
, pw, ph
, _
) = getpagedim
n in
1515 && colorspace
= conf
.colorspace
1516 && angle
= conf
.angle
1520 let x = col*conf
.tilew
1521 and y = row*conf
.tileh
in
1522 tilevisible (Lazy.force_val
layout) n x y
1524 then Queue.push lruitem state
.tilelru
1527 wcmd "freetile %s" (~
> p
);
1528 state
.memused
<- state
.memused
- s;
1529 state
.uioh#infochanged Memused
;
1530 Hashtbl.remove state
.tilemap k
;
1538 let logcurrently = function
1539 | Idle
-> dolog
"Idle"
1540 | Loading
(l, gen
) ->
1541 dolog
"Loading %d gen=%d curgen=%d" l.pageno gen state
.gen
1542 | Tiling
(l, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1544 "Tiling %d[%d,%d] page=%s cs=%s angle"
1545 l.pageno
col row (~
> pageopaque
)
1546 (CSTE.to_string colorspace
)
1548 dolog
"gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1549 angle gen conf
.angle state
.gen
1551 conf
.tilew conf
.tileh
1558 let r = Str.regexp
" " in
1559 fun s -> Str.bounded_split
r s 2;
1562 let onpagerect pageno
f =
1564 match conf
.columns
with
1565 | Cmulti
(_
, b) -> b
1567 | Csplit
(_
, b) -> b
1569 if pageno
>= 0 && pageno
< Array.length
b
1571 let (_
, _
, _
, (w, h, _
, _
)) = b.(pageno
) in
1575 let gotopagexy1 pageno
x y =
1576 let _,w1,h1
,leftx
= getpagedim pageno
in
1577 let top = y /. (float h1
) in
1578 let left = x /. (float w1) in
1579 let py, w, h = getpageywh pageno
in
1580 let wh = state
.winh
- hscrollh () in
1581 let x = left *. (float w) in
1582 let x = leftx
+ state
.x + truncate
x in
1584 if x < 0 || x >= wadjsb state
.winw
1588 let pdy = truncate
(top *. float h) in
1589 let y'
= py + pdy in
1590 let dy = y'
- state
.y in
1592 if x != state
.x || not
(dy > 0 && dy < wh)
1594 if conf
.presentation
1596 if abs
(py - y'
) > wh
1603 if state
.x != sx || state
.y != sy
1608 let ww = wadjsb state
.winw
in
1610 and qy
= pdy / wh in
1612 and y = py + qy
* wh in
1613 let x = if -x + ww > w1 then -(w1-ww) else x
1614 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1616 if conf
.presentation
1618 if abs
(py - y'
) > wh
1628 gotoy_and_clear_text y;
1630 else gotoy_and_clear_text state
.y;
1633 let gotopagexy pageno
x y =
1634 match state
.mode
with
1635 | Birdseye
_ -> gotopage pageno
0.0
1636 | _ -> gotopagexy1 pageno
x y
1640 (* dolog "%S" cmds; *)
1641 let cl = splitatspace cmds
in
1643 try Scanf.sscanf
s fmt
f
1645 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1648 let addoutline outline
=
1649 match state
.currently
with
1650 | Outlining outlines
->
1651 state
.currently
<- Outlining
(outline
:: outlines
)
1652 | Idle
-> state
.currently
<- Outlining
[outline
]
1654 dolog
"invalid outlining state";
1655 logcurrently currently
1659 state
.uioh#infochanged Pdim
;
1662 | "clearrects" :: [] ->
1663 state
.rects
<- state
.rects1
;
1664 G.postRedisplay "clearrects";
1666 | "continue" :: args
:: [] ->
1667 let n = scan args
"%u" (fun n -> n) in
1668 state
.pagecount
<- n;
1669 begin match state
.currently
with
1671 state
.currently
<- Idle
;
1672 state
.outlines
<- Array.of_list
(List.rev
l)
1676 let cur, cmds
= state
.geomcmds
in
1678 then failwith
"umpossible";
1680 begin match List.rev cmds
with
1682 state
.geomcmds
<- E.s, [];
1683 state
.throttle
<- None
;
1687 state
.geomcmds
<- s, List.rev rest
;
1689 if conf
.maxwait
= None
&& not
!wtmode
1690 then G.postRedisplay "continue";
1692 | "title" :: args
:: [] ->
1696 | "msg" :: args
:: [] ->
1699 | "vmsg" :: args
:: [] ->
1701 then showtext ' ' args
1703 | "emsg" :: args
:: [] ->
1704 Buffer.add_string state
.errmsgs args
;
1705 state
.newerrmsgs
<- true;
1706 G.postRedisplay "error message"
1708 | "progress" :: args
:: [] ->
1709 let progress, text =
1712 f, String.sub args pos
(String.length args
- pos
))
1715 state
.progress <- progress;
1716 G.postRedisplay "progress"
1718 | "firstmatch" :: args
:: [] ->
1719 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1720 scan args
"%u %d %f %f %f %f %f %f %f %f"
1721 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1722 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1724 let xoff = float (xadjsb 0) in
1728 and x3
= x3
+. xoff in
1729 let y = (getpagey
pageno) + truncate
y0 in
1732 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1734 | "match" :: args
:: [] ->
1735 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1736 scan args
"%u %d %f %f %f %f %f %f %f %f"
1737 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1738 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1740 let xoff = float (xadjsb 0) in
1744 and x3
= x3
+. xoff in
1746 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1748 | "page" :: args
:: [] ->
1749 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1750 let pageopaque = ~
< pageopaques in
1751 begin match state
.currently
with
1752 | Loading
(l, gen
) ->
1753 vlog "page %d took %f sec" l.pageno t
;
1754 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1755 begin match state
.throttle
with
1757 let preloadedpages =
1759 then preloadlayout state
.y
1764 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1765 IntSet.empty
preloadedpages
1768 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1769 if not
(IntSet.mem
pageno set)
1771 wcmd "freepage %s" (~
> opaque
);
1777 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1780 state
.currently
<- Idle
;
1783 tilepage l.pageno pageopaque state
.layout;
1785 load preloadedpages;
1786 if pagevisible state
.layout l.pageno
1787 && layoutready state
.layout
1788 then G.postRedisplay "page";
1791 | Some
(layout, _, _) ->
1792 state
.currently
<- Idle
;
1793 tilepage l.pageno pageopaque layout;
1798 dolog
"Inconsistent loading state";
1799 logcurrently state
.currently
;
1803 | "tile" :: args
:: [] ->
1804 let (x, y, opaques
, size
, t
) =
1805 scan args
"%u %u %s %u %f"
1806 (fun x y p size t
-> (x, y, p
, size
, t
))
1808 let opaque = ~
< opaques
in
1809 begin match state
.currently
with
1810 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1811 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1814 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1816 wcmd "freetile %s" (~
> opaque);
1817 state
.currently
<- Idle
;
1821 puttileopaque l col row gen cs angle
opaque size t
;
1822 state
.memused
<- state
.memused
+ size
;
1823 state
.uioh#infochanged Memused
;
1825 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1826 opaque, size
) state
.tilelru
;
1829 match state
.throttle
with
1830 | None
-> state
.layout
1831 | Some
(layout, _, _) -> layout
1834 state
.currently
<- Idle
;
1836 && conf
.colorspace
= cs
1837 && conf
.angle
= angle
1838 && tilevisible layout l.pageno x y
1839 then conttiling l.pageno pageopaque;
1841 begin match state
.throttle
with
1843 preload state
.layout;
1845 && conf
.colorspace
= cs
1846 && conf
.angle
= angle
1847 && tilevisible state
.layout l.pageno x y
1848 && (not
!wtmode || layoutready state
.layout)
1849 then G.postRedisplay "tile nothrottle";
1851 | Some
(layout, y, _) ->
1852 let ready = layoutready layout in
1856 state
.layout <- layout;
1857 state
.throttle
<- None
;
1858 G.postRedisplay "throttle";
1865 dolog
"Inconsistent tiling state";
1866 logcurrently state
.currently
;
1870 | "pdim" :: args
:: [] ->
1871 let (n, w, h, _) as pdim
=
1872 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1875 match conf
.fitmodel
, conf
.columns
with
1876 | (FitPage
| FitProportional
), Csplit
_ -> (n, w, h, 0)
1879 state
.uioh#infochanged Pdim
;
1880 state
.pdims
<- pdim :: state
.pdims
1882 | "o" :: args
:: [] ->
1883 let (l, n, t
, h, pos
) =
1884 scan args
"%u %u %d %u %n"
1885 (fun l n t
h pos
-> l, n, t
, h, pos
)
1887 let s = String.sub args pos
(String.length args
- pos
) in
1888 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1890 | "ou" :: args
:: [] ->
1891 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1892 let s = String.sub args pos
len in
1893 let pos2 = pos
+ len + 1 in
1894 let uri = String.sub args
pos2 (String.length args
- pos2) in
1895 addoutline (s, l, Ouri
uri)
1897 | "on" :: args
:: [] ->
1898 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1899 let s = String.sub args pos
(String.length args
- pos
) in
1900 addoutline (s, l, Onone
)
1902 | "a" :: args
:: [] ->
1904 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1906 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1908 | "info" :: args
:: [] ->
1909 state
.docinfo
<- (1, args
) :: state
.docinfo
1911 | "infoend" :: [] ->
1912 state
.uioh#infochanged Docinfo
;
1913 state
.docinfo
<- List.rev state
.docinfo
1916 error
"unknown cmd `%S'" cmds
1921 let action = function
1922 | HCprev
-> cbget cb ~
-1
1923 | HCnext
-> cbget cb
1
1924 | HCfirst
-> cbget cb ~
-(cb
.rc)
1925 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1926 and cancel
() = cb
.rc <- rc
1930 let search pattern forward
=
1931 match conf
.columns
with
1933 showtext '
!'
"searching does not work properly in split columns mode"
1935 if nonemptystr pattern
1938 match state
.layout with
1941 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1943 wcmd "search %d %d %d %d,%s\000"
1944 (btod conf
.icase
) pn py (btod forward
) pattern
;
1947 let intentry text key =
1949 if key >= 32 && key < 127
1955 let text = addchar text c in
1959 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1963 let linknentry text key =
1965 if key >= 32 && key < 127
1971 let text = addchar text c in
1975 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1983 let l = String.length
s in
1984 let rec loop pos
n = if pos
= l then n else
1985 let m = Char.code
s.[pos
] - (if pos
= 0 && l > 1 then 96 else 97) in
1986 loop (pos
+1) (n*26 + m)
1989 let rec loop n = function
1992 match getopaque l.pageno with
1993 | None
-> loop n rest
1995 let m = getlinkcount
opaque in
1998 let under = getlink
opaque n in
2001 else loop (n-m) rest
2003 loop n state
.layout;
2007 let textentry text key =
2008 if key land 0xff00 = 0xff00
2010 else TEcont
(text ^ toutf8
key)
2013 let reqlayout angle fitmodel
=
2014 match state
.throttle
with
2016 if nogeomcmds state
.geomcmds
2017 then state
.anchor <- getanchor
();
2018 conf
.angle
<- angle
mod 360;
2021 match state
.mode
with
2022 | LinkNav
_ -> state
.mode
<- View
2025 conf
.fitmodel
<- fitmodel
;
2026 invalidate "reqlayout"
2028 wcmd "reqlayout %d %d %d"
2029 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2034 let settrim trimmargins trimfuzz
=
2035 if nogeomcmds state
.geomcmds
2036 then state
.anchor <- getanchor
();
2037 conf
.trimmargins
<- trimmargins
;
2038 conf
.trimfuzz
<- trimfuzz
;
2039 let x0, y0, x1, y1 = trimfuzz
in
2040 invalidate "settrim"
2042 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2047 match state
.throttle
with
2049 let zoom = max
0.0001 zoom in
2050 if zoom <> conf
.zoom
2052 state
.prevzoom
<- (conf
.zoom, state
.x);
2054 reshape state
.winw state
.winh
;
2055 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2058 | Some
(layout, y, started
) ->
2060 match conf
.maxwait
with
2064 let dt = now
() -. started
in
2072 let setcolumns mode columns coverA coverB
=
2073 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2077 then showtext '
!'
"split mode doesn't work in bird's eye"
2079 conf
.columns
<- Csplit
(-columns
, E.a);
2087 conf
.columns
<- Csingle
E.a;
2092 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2096 reshape state
.winw state
.winh
;
2099 let resetmstate () =
2100 state
.mstate
<- Mnone
;
2101 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2104 let enterbirdseye () =
2105 let zoom = float conf
.thumbw
/. float state
.winw
in
2106 let birdseyepageno =
2107 let cy = state
.winh
/ 2 in
2111 let rec fold best
= function
2114 let d = cy - (l.pagedispy + l.pagevh/2)
2115 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2116 if abs
d < abs dbest
2123 state
.mode
<- Birdseye
(
2124 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2128 conf
.presentation
<- false;
2129 conf
.interpagespace
<- 10;
2130 conf
.hlinks
<- false;
2131 conf
.fitmodel
<- FitProportional
;
2133 conf
.maxwait
<- None
;
2135 match conf
.beyecolumns
with
2138 Cmulti
((c, 0, 0), E.a)
2139 | None
-> Csingle
E.a
2143 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2148 reshape state
.winw state
.winh
;
2151 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2153 conf
.zoom <- c.zoom;
2154 conf
.presentation
<- c.presentation
;
2155 conf
.interpagespace
<- c.interpagespace
;
2156 conf
.maxwait
<- c.maxwait
;
2157 conf
.hlinks
<- c.hlinks
;
2158 conf
.fitmodel
<- c.fitmodel
;
2159 conf
.beyecolumns
<- (
2160 match conf
.columns
with
2161 | Cmulti
((c, _, _), _) -> Some
c
2163 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2166 match c.columns
with
2167 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2168 | Csingle
_ -> Csingle
E.a
2169 | Csplit
(c, _) -> Csplit
(c, E.a)
2173 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2176 reshape state
.winw state
.winh
;
2177 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2181 let togglebirdseye () =
2182 match state
.mode
with
2183 | Birdseye vals
-> leavebirdseye vals
true
2184 | View
-> enterbirdseye ()
2188 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2189 let pageno = max
0 (pageno - incr
) in
2190 let rec loop = function
2191 | [] -> gotopage1 pageno 0
2192 | l :: _ when l.pageno = pageno ->
2193 if l.pagedispy >= 0 && l.pagey = 0
2194 then G.postRedisplay "upbirdseye"
2195 else gotopage1 pageno 0
2196 | _ :: rest
-> loop rest
2200 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2203 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2204 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2205 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2206 let rec loop = function
2208 let y, h = getpageyh
pageno in
2209 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2211 | l :: _ when l.pageno = pageno ->
2212 if l.pagevh != l.pageh
2213 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2214 else G.postRedisplay "downbirdseye"
2215 | _ :: rest
-> loop rest
2221 let boundastep h step
=
2223 then bound step ~
-h 0
2227 let optentry mode
_ key =
2228 let btos b = if b then "on" else "off" in
2229 if key >= 32 && key < 127
2231 let c = Char.chr
key in
2235 try conf
.scrollstep
<- int_of_string
s with exc
->
2236 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2238 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2243 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2244 if state
.autoscroll
<> None
2245 then state
.autoscroll
<- Some conf
.autoscrollstep
2247 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2249 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2254 let n, a, b = multicolumns_of_string
s in
2255 setcolumns mode
n a b;
2257 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2259 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2264 let zoom = float (int_of_string
s) /. 100.0 in
2267 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2269 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2274 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2276 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2277 begin match mode
with
2279 leavebirdseye beye
false;
2284 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2286 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2291 Some
(int_of_string
s)
2293 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2297 | Some angle
-> reqlayout angle conf
.fitmodel
2300 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2303 conf
.icase
<- not conf
.icase
;
2304 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2307 conf
.preload <- not conf
.preload;
2309 TEdone
("preload " ^
(btos conf
.preload))
2312 conf
.verbose
<- not conf
.verbose
;
2313 TEdone
("verbose " ^
(btos conf
.verbose
))
2316 conf
.debug
<- not conf
.debug
;
2317 TEdone
("debug " ^
(btos conf
.debug
))
2320 conf
.maxhfit
<- not conf
.maxhfit
;
2321 state
.maxy
<- calcheight
();
2322 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2325 conf
.crophack
<- not conf
.crophack
;
2326 TEdone
("crophack " ^
btos conf
.crophack
)
2330 match conf
.maxwait
with
2332 conf
.maxwait
<- Some infinity
;
2333 "always wait for page to complete"
2335 conf
.maxwait
<- None
;
2336 "show placeholder if page is not ready"
2341 conf
.underinfo
<- not conf
.underinfo
;
2342 TEdone
("underinfo " ^
btos conf
.underinfo
)
2345 conf
.savebmarks
<- not conf
.savebmarks
;
2346 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2352 match state
.layout with
2357 conf
.interpagespace
<- int_of_string
s;
2358 docolumns conf
.columns
;
2359 state
.maxy
<- calcheight
();
2360 let y = getpagey
pageno in
2363 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2365 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2369 match conf
.fitmodel
with
2370 | FitProportional
-> FitWidth
2371 | _ -> FitProportional
2373 reqlayout conf
.angle
fm;
2374 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2377 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2378 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2381 conf
.invert
<- not conf
.invert
;
2382 TEdone
("invert colors " ^
btos conf
.invert
)
2386 cbput state
.hists
.sel
s;
2389 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2390 textentry, ondone, true)
2394 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2395 else conf
.pax
<- None
;
2396 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2399 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2405 class type lvsource
= object
2406 method getitemcount
: int
2407 method getitem
: int -> (string * int)
2408 method hasaction
: int -> bool
2416 method getactive
: int
2417 method getfirst
: int
2419 method getminfo
: (int * int) array
2422 class virtual lvsourcebase
= object
2423 val mutable m_active
= 0
2424 val mutable m_first
= 0
2425 val mutable m_pan
= 0
2426 method getactive
= m_active
2427 method getfirst
= m_first
2428 method getpan
= m_pan
2429 method getminfo
: (int * int) array
= E.a
2432 let withoutlastutf8 s =
2433 let len = String.length
s in
2441 let b = Char.code
s.[pos
] in
2442 if b land 0b11000000 = 0b11000000
2447 if Char.code
s.[len-1] land 0x80 = 0
2451 String.sub
s 0 first;
2454 let textentrykeyboard
2455 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2457 if key >= 0xffb0 && key <= 0xffb9
2458 then key - 0xffb0 + 48 else key
2461 state
.mode
<- Textentry
(te
, onleave
);
2464 G.postRedisplay "textentrykeyboard enttext";
2466 let histaction cmd
=
2469 | Some
(action, _) ->
2470 state
.mode
<- Textentry
(
2471 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2473 G.postRedisplay "textentry histaction"
2477 if emptystr
text && cancelonempty
2480 G.postRedisplay "textentrykeyboard after cancel";
2483 let s = withoutlastutf8 text in
2484 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2486 | @enter
| @kpenter
->
2489 G.postRedisplay "textentrykeyboard after confirm"
2491 | @up
| @kpup
-> histaction HCprev
2492 | @down
| @kpdown
-> histaction HCnext
2493 | @home
| @kphome
-> histaction HCfirst
2494 | @jend
| @kpend
-> histaction HClast
2499 begin match opthist
with
2501 | Some
(_, onhistcancel
) -> onhistcancel
()
2505 G.postRedisplay "textentrykeyboard after cancel2"
2508 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2511 | @delete
| @kpdelete
-> ()
2514 && key land 0xff00 != 0xff00 (* keyboard *)
2515 && key land 0xfe00 != 0xfe00 (* xkb *)
2516 && key land 0xfd00 != 0xfd00 (* 3270 *)
2518 begin match onkey
text key with
2522 G.postRedisplay "textentrykeyboard after confirm2";
2525 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2529 G.postRedisplay "textentrykeyboard after cancel3"
2532 state
.mode
<- Textentry
(te
, onleave
);
2533 G.postRedisplay "textentrykeyboard switch";
2537 vlog "unhandled key %s" (Wsi.keyname
key)
2540 let firstof first active
=
2541 if first > active
|| abs
(first - active
) > fstate
.maxrows
- 1
2542 then max
0 (active
- (fstate
.maxrows
/2))
2546 let calcfirst first active
=
2549 let rows = active
- first in
2550 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2554 let scrollph y maxy
=
2555 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2556 let sh = float state
.winh
/. sh in
2557 let sh = max
sh (float conf
.scrollh
) in
2559 let percent = float y /. float maxy
in
2560 let position = (float state
.winh
-. sh) *. percent in
2563 if position +. sh > float state
.winh
2564 then float state
.winh
-. sh
2570 let coe s = (s :> uioh
);;
2572 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2574 val m_pan
= source#getpan
2575 val m_first
= source#getfirst
2576 val m_active
= source#getactive
2578 val m_prev_uioh
= state
.uioh
2580 method private elemunder
y =
2584 let n = y / (fstate
.fontsize
+1) in
2585 if m_first
+ n < source#getitemcount
2587 if source#hasaction
(m_first
+ n)
2588 then Some
(m_first
+ n)
2595 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2596 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2597 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2598 GlDraw.color
(1., 1., 1.);
2599 Gl.enable `texture_2d
;
2600 let fs = fstate
.fontsize
in
2602 let hw = (wadjsb (xadjsb state
.winw
))/3 in
2603 let ww = fstate
.wwidth
in
2604 let tabw = 17.0*.ww in
2605 let itemcount = source#getitemcount
in
2606 let minfo = source#getminfo
in
2609 then float (xadjsb 0), float (state
.winw
- 1)
2610 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2613 if (row - m_first
) > fstate
.maxrows
2616 if row >= 0 && row < itemcount
2618 let (s, level
) = source#getitem
row in
2619 let y = (row - m_first
) * nfs in
2621 (if conf
.leftscroll
then float (xadjsb 0) else 5.0)
2622 +. (float (level
+ m_pan
)) *. ww in
2625 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2629 Gl.disable `texture_2d
;
2630 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2631 GlDraw.color
(1., 1., 1.) ~
alpha;
2632 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2633 Gl.enable `texture_2d
;
2636 if zebra
&& row land 1 = 1
2640 GlDraw.color
(c,c,c);
2641 let drawtabularstring s =
2643 let x'
= truncate
(x0 +. x) in
2644 let pos = nindex
s '
\000'
in
2646 then drawstring1 fs x'
(y+nfs) s
2648 let s1 = String.sub
s 0 pos
2649 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2654 let s'
= withoutlastutf8 s in
2655 let s = s' ^
"@Uellipsis" in
2656 let w = measurestr
fs s in
2657 if float x'
+. w +. ww < float (hw + x'
)
2662 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2666 ignore
(drawstring1 fs x'
(y+nfs) s1);
2667 drawstring1 fs (hw + x'
) (y+nfs) s2
2671 let x = if helpmode
&& row > 0 then x +. ww else x in
2672 let tabpos = nindex
s '
\t'
in
2675 let len = String.length
s - tabpos - 1 in
2676 let s1 = String.sub
s 0 tabpos
2677 and s2
= String.sub
s (tabpos + 1) len in
2678 let nx = drawstr x s1 in
2680 let x = x +. (max
tabw sw) in
2683 let len = String.length
s - 2 in
2684 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2686 let s = String.sub
s 2 len in
2687 let x = if not helpmode
then x +. ww else x in
2688 GlDraw.color
(1.2, 1.2, 1.2);
2689 let vinc = drawstring1 (fs+fs/4)
2690 (truncate
(x -. ww)) (y+nfs) s in
2691 GlDraw.color
(1., 1., 1.);
2692 vinc +. (float fs *. 0.8)
2698 ignore
(drawtabularstring s);
2704 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2706 if (row - m_first
) > fstate
.maxrows
2709 if row >= 0 && row < itemcount
2711 let (s, level
) = source#getitem
row in
2712 let pos0 = nindex
s '
\000'
in
2713 let y = (row - m_first
) * nfs in
2714 let x = float (level
+ m_pan
) *. ww in
2715 let (first, last
) = minfo.(row) in
2717 if pos0 > 0 && first > pos0
2718 then String.sub
s (pos0+1) (first-pos0-1)
2719 else String.sub
s 0 first
2721 let suffix = String.sub
s first (last
- first) in
2722 let w1 = measurestr fstate
.fontsize
prefix in
2723 let w2 = measurestr fstate
.fontsize
suffix in
2724 let x = x +. if conf
.leftscroll
then float (xadjsb 5) else 5.0 in
2725 let x = if pos0 > 0 && first > pos0 then x +. float hw else x in
2727 and y0 = float (y+2) in
2729 and y1 = float (y+fs+3) in
2730 filledrect x0 y0 x1 y1;
2735 Gl.disable `texture_2d
;
2736 if Array.length
minfo > 0 then loop m_first
;
2739 method updownlevel incr
=
2740 let len = source#getitemcount
in
2742 if m_active
>= 0 && m_active
< len
2743 then snd
(source#getitem m_active
)
2747 if i
= len then i
-1 else if i
= -1 then 0 else
2748 let _, l = source#getitem i
in
2749 if l != curlevel then i
else flow (i
+incr
)
2751 let active = flow m_active
in
2752 let first = calcfirst m_first
active in
2753 G.postRedisplay "outline updownlevel";
2754 {< m_active
= active; m_first
= first >}
2756 method private key1
key mask
=
2757 let set1 active first qsearch
=
2758 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2760 let search active pattern incr
=
2761 let active = if active = -1 then m_first
else active in
2764 if n >= 0 && n < source#getitemcount
2766 let s, _ = source#getitem
n in
2768 (try ignore
(Str.search_forward
re s 0); true
2769 with Not_found
-> false)
2771 else loop (n + incr
)
2778 let re = Str.regexp_case_fold pattern
in
2784 let itemcount = source#getitemcount
in
2785 let find start incr
=
2787 if i
= -1 || i
= itemcount
2790 if source#hasaction i
2792 else find (i
+ incr
)
2797 let set active first =
2798 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2800 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2803 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2805 let incr1 = if incr
> 0 then 1 else -1 in
2806 if isvisible m_first m_active
2809 let next = m_active
+ incr
in
2811 if next < 0 || next >= itemcount
2813 else find next incr1
2815 if abs
(m_active
- next) > fstate
.maxrows
2821 let first = m_first
+ incr
in
2822 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2824 let next = m_active
+ incr
in
2825 let next = bound
next 0 (itemcount - 1) in
2832 if isvisible first next
2839 let first = min
next m_first
in
2841 if abs
(next - first) > fstate
.maxrows
2847 let first = m_first
+ incr
in
2848 let first = bound
first 0 (itemcount - 1) in
2850 let next = m_active
+ incr
in
2851 let next = bound
next 0 (itemcount - 1) in
2852 let next = find next incr1 in
2854 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2856 let active = if m_active
= -1 then next else m_active
in
2861 if isvisible first active
2867 G.postRedisplay "listview navigate";
2871 | (@r|@s) when Wsi.withctrl mask
->
2872 let incr = if key = @r then -1 else 1 in
2874 match search (m_active
+ incr) m_qsearch
incr with
2876 state
.text <- m_qsearch ^
" [not found]";
2879 state
.text <- m_qsearch
;
2880 active, firstof m_first
active
2882 G.postRedisplay "listview ctrl-r/s";
2883 set1 active first m_qsearch
;
2885 | @insert
when Wsi.withctrl mask
->
2886 if m_active
>= 0 && m_active
< source#getitemcount
2888 let s, _ = source#getitem m_active
in
2894 if emptystr m_qsearch
2897 let qsearch = withoutlastutf8 m_qsearch
in
2901 G.postRedisplay "listview empty qsearch";
2902 set1 m_active m_first
E.s;
2906 match search m_active
qsearch ~
-1 with
2908 state
.text <- qsearch ^
" [not found]";
2911 state
.text <- qsearch;
2912 active, firstof m_first
active
2914 G.postRedisplay "listview backspace qsearch";
2915 set1 active first qsearch
2918 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2919 let pattern = m_qsearch ^ toutf8
key in
2921 match search m_active
pattern 1 with
2923 state
.text <- pattern ^
" [not found]";
2926 state
.text <- pattern;
2927 active, firstof m_first
active
2929 G.postRedisplay "listview qsearch add";
2930 set1 active first pattern;
2934 if emptystr m_qsearch
2936 G.postRedisplay "list view escape";
2939 source#exit ~uioh
:(coe self
)
2940 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2942 | None
-> m_prev_uioh
2947 G.postRedisplay "list view kill qsearch";
2948 coe {< m_qsearch
= E.s >}
2951 | @enter
| @kpenter
->
2953 let self = {< m_qsearch
= E.s >} in
2955 G.postRedisplay "listview enter";
2956 if m_active
>= 0 && m_active
< source#getitemcount
2958 source#exit ~uioh
:(coe self) ~cancel
:false
2959 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2962 source#exit ~uioh
:(coe self) ~cancel
:true
2963 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2966 begin match opt with
2967 | None
-> m_prev_uioh
2971 | @delete
| @kpdelete
->
2974 | @up
| @kpup
-> navigate ~
-1
2975 | @down
| @kpdown
-> navigate 1
2976 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2977 | @next | @kpnext
-> navigate fstate
.maxrows
2979 | @right
| @kpright
->
2981 G.postRedisplay "listview right";
2982 coe {< m_pan
= m_pan
- 1 >}
2984 | @left | @kpleft
->
2986 G.postRedisplay "listview left";
2987 coe {< m_pan
= m_pan
+ 1 >}
2989 | @home
| @kphome
->
2990 let active = find 0 1 in
2991 G.postRedisplay "listview home";
2995 let first = max
0 (itemcount - fstate
.maxrows
) in
2996 let active = find (itemcount - 1) ~
-1 in
2997 G.postRedisplay "listview end";
3000 | key when (key = 0 || key land 0xff00 = 0xff00) ->
3004 dolog
"listview unknown key %#x" key; coe self
3006 method key key mask
=
3007 match state
.mode
with
3008 | Textentry te
-> textentrykeyboard key mask te
; coe self
3009 | _ -> self#key1
key mask
3011 method button button down
x y _ =
3014 | 1 when x > state
.winw
- conf
.scrollbw
->
3015 G.postRedisplay "listview scroll";
3018 let _, position, sh = self#
scrollph in
3019 if y > truncate
position && y < truncate
(position +. sh)
3021 state
.mstate
<- Mscrolly
;
3025 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3026 let first = truncate
(s *. float source#getitemcount
) in
3027 let first = min source#getitemcount
first in
3028 Some
(coe {< m_first
= first; m_active
= first >})
3030 state
.mstate
<- Mnone
;
3033 | 1 when not down
->
3034 begin match self#elemunder
y with
3036 G.postRedisplay "listview click";
3037 source#exit ~uioh
:(coe {< m_active
= n >})
3038 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3042 | n when (n == 4 || n == 5) && not down
->
3043 let len = source#getitemcount
in
3045 if n = 5 && m_first
+ fstate
.maxrows
>= len
3049 let first = m_first
+ (if n == 4 then -1 else 1) in
3050 bound
first 0 (len - 1)
3052 G.postRedisplay "listview wheel";
3053 Some
(coe {< m_first
= first >})
3054 | n when (n = 6 || n = 7) && not down
->
3055 let inc = if n = 7 then -1 else 1 in
3056 G.postRedisplay "listview hwheel";
3057 Some
(coe {< m_pan
= m_pan
+ inc >})
3062 | None
-> m_prev_uioh
3065 method multiclick
_ x y = self#button
1 true x y
3068 match state
.mstate
with
3070 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3071 let first = truncate
(s *. float source#getitemcount
) in
3072 let first = min source#getitemcount
first in
3073 G.postRedisplay "listview motion";
3074 coe {< m_first
= first; m_active
= first >}
3077 method pmotion
x y =
3078 if x < state
.winw
- conf
.scrollbw
3081 match self#elemunder
y with
3082 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3083 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3087 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3092 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3096 method infochanged
_ = ()
3098 method scrollpw
= (0, 0.0, 0.0)
3100 let nfs = fstate
.fontsize
+ 1 in
3101 let y = m_first
* nfs in
3102 let itemcount = source#getitemcount
in
3103 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3104 let maxy = maxi * nfs in
3105 let p, h = scrollph y maxy in
3108 method modehash
= modehash
3109 method eformsgs
= false
3112 class outlinelistview ~zebra ~source
=
3113 let settext autonarrow
s =
3116 let ss = source#statestr
in
3120 else "{" ^
ss ^
"} [" ^
s ^
"]"
3121 else state
.text <- s
3127 ~source
:(source
:> lvsource
)
3129 ~modehash
:(findkeyhash conf
"outline")
3132 val m_autonarrow
= false
3134 method! key key mask
=
3136 if emptystr state
.text
3138 else fstate
.maxrows - 2
3140 let calcfirst first active =
3143 let rows = active - first in
3144 if rows > maxrows then active - maxrows else first
3148 let active = m_active
+ incr in
3149 let active = bound
active 0 (source#getitemcount
- 1) in
3150 let first = calcfirst m_first
active in
3151 G.postRedisplay "outline navigate";
3152 coe {< m_active
= active; m_first
= first >}
3154 let navscroll first =
3156 let dist = m_active
- first in
3162 else first + maxrows
3165 G.postRedisplay "outline navscroll";
3166 coe {< m_first
= first; m_active
= active >}
3168 let ctrl = Wsi.withctrl mask
in
3173 then (source#denarrow
; E.s)
3175 let pattern = source#renarrow
in
3176 if nonemptystr m_qsearch
3177 then (source#narrow m_qsearch
; m_qsearch
)
3181 settext (not m_autonarrow
) text;
3182 G.postRedisplay "toggle auto narrowing";
3183 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3185 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3187 G.postRedisplay "toggle auto narrowing";
3188 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3191 source#narrow m_qsearch
;
3193 then source#add_narrow_pattern m_qsearch
;
3194 G.postRedisplay "outline ctrl-n";
3195 coe {< m_first
= 0; m_active
= 0 >}
3198 let active = source#calcactive
(getanchor
()) in
3199 let first = firstof m_first
active in
3200 G.postRedisplay "outline ctrl-s";
3201 coe {< m_first
= first; m_active
= active >}
3204 G.postRedisplay "outline ctrl-u";
3205 if m_autonarrow
&& nonemptystr m_qsearch
3207 ignore
(source#renarrow
);
3208 settext m_autonarrow
E.s;
3209 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3212 source#del_narrow_pattern
;
3213 let pattern = source#renarrow
in
3215 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3217 settext m_autonarrow
text;
3218 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3222 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3223 G.postRedisplay "outline ctrl-l";
3224 coe {< m_first
= first >}
3226 | @tab
when m_autonarrow
->
3227 if nonemptystr m_qsearch
3229 G.postRedisplay "outline list view tab";
3230 source#add_narrow_pattern m_qsearch
;
3232 coe {< m_qsearch
= E.s >}
3236 | @escape
when m_autonarrow
->
3237 if nonemptystr m_qsearch
3238 then source#add_narrow_pattern m_qsearch
;
3241 | @enter
| @kpenter
when m_autonarrow
->
3242 if nonemptystr m_qsearch
3243 then source#add_narrow_pattern m_qsearch
;
3246 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3247 let pattern = m_qsearch ^ toutf8
key in
3248 G.postRedisplay "outlinelistview autonarrow add";
3249 source#narrow
pattern;
3250 settext true pattern;
3251 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3253 | key when m_autonarrow
&& key = @backspace
->
3254 if emptystr m_qsearch
3257 let pattern = withoutlastutf8 m_qsearch
in
3258 G.postRedisplay "outlinelistview autonarrow backspace";
3259 ignore
(source#renarrow
);
3260 source#narrow
pattern;
3261 settext true pattern;
3262 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3264 | @delete
| @kpdelete
->
3265 source#remove m_active
;
3266 G.postRedisplay "outline delete";
3267 let active = max
0 (m_active
-1) in
3268 coe {< m_first
= firstof m_first
active;
3269 m_active
= active >}
3271 | @up
| @kpup
when ctrl ->
3272 navscroll (max
0 (m_first
- 1))
3274 | @down
| @kpdown
when ctrl ->
3275 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3277 | @up
| @kpup
-> navigate ~
-1
3278 | @down
| @kpdown
-> navigate 1
3279 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3280 | @next | @kpnext
-> navigate fstate
.maxrows
3282 | @right
| @kpright
->
3286 G.postRedisplay "outline ctrl right";
3287 {< m_pan
= m_pan
+ 1 >}
3289 else self#updownlevel
1
3293 | @left | @kpleft
->
3297 G.postRedisplay "outline ctrl left";
3298 {< m_pan
= m_pan
- 1 >}
3300 else self#updownlevel ~
-1
3304 | @home
| @kphome
->
3305 G.postRedisplay "outline home";
3306 coe {< m_first
= 0; m_active
= 0 >}
3309 let active = source#getitemcount
- 1 in
3310 let first = max
0 (active - fstate
.maxrows) in
3311 G.postRedisplay "outline end";
3312 coe {< m_active
= active; m_first
= first >}
3314 | _ -> super#
key key mask
3317 let gotounder under =
3318 let getpath filename
=
3320 if nonemptystr filename
3322 if Filename.is_relative filename
3324 let dir = Filename.dirname state
.path in
3326 if Filename.is_implicit
dir
3327 then Filename.concat
(Sys.getcwd
()) dir
3330 Filename.concat
dir filename
3334 if Sys.file_exists
path
3339 | Ulinkgoto
(pageno, top) ->
3343 gotopage1 pageno top;
3349 | Uremote
(filename
, pageno) ->
3350 let path = getpath filename
in
3355 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
3356 try popen
command []
3358 Printf.eprintf
"failed to execute `%s': %s\n" command (exntos exn
);
3361 let anchor = getanchor
() in
3362 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3363 state
.origin
<- E.s;
3364 state
.anchor <- (pageno, 0.0, 0.0);
3365 state
.ranchors
<- ranchor :: state
.ranchors
;
3368 else showtext '
!'
("Could not find " ^ filename
)
3370 | Uremotedest
(filename
, destname
) ->
3371 let path = getpath filename
in
3376 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
3377 try popen
command []
3380 "failed to execute `%s': %s\n" command (exntos exn
);
3383 let anchor = getanchor
() in
3384 let ranchor = state
.path, state
.password
, anchor, state
.origin
in
3385 state
.origin
<- E.s;
3386 state
.nameddest
<- destname
;
3387 state
.ranchors
<- ranchor :: state
.ranchors
;
3390 else showtext '
!'
("Could not find " ^ filename
)
3392 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
3395 let gotohist (path, (c, bookmarks
, x, anchor)) =
3396 Config.save
leavebirdseye;
3397 state
.anchor <- anchor;
3399 state
.bookmarks
<- bookmarks
;
3400 state
.origin
<- E.s;
3405 let gotooutline (_, _, kind
) =
3409 let (pageno, y, _) = anchor in
3411 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
3415 | Ouri
uri -> gotounder (Ulinkuri
uri)
3416 | Olaunch cmd
-> gotounder (Ulaunch cmd
)
3417 | Oremote remote
-> gotounder (Uremote remote
)
3418 | Ohistory hist
-> gotohist hist
3419 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
)
3423 let genhistoutlines =
3424 let order ty
(p1
, c1
, _, _, _) (p2
, c2
, _, _, _) =
3426 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3427 | `
path -> compare p2 p1
3428 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3430 let e1 = emptystr c1
.title
3431 and e2
= emptystr c2
.title
in
3433 then compare
(Filename.basename p2
) (Filename.basename p1
)
3436 else compare c1
.title c2
.title
3438 let showfullpath = ref false in
3441 let s = if orderty
= t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3442 s, 0, Oaction
(fun () -> Config.historder
:= t
; reeenterhist := true)
3444 let list = ref [] in
3445 if Config.gethist
list
3449 (fun accu (path, c, b, x, a) ->
3450 let hist = (path, (c, b, x, a)) in
3451 let s = if !showfullpath then path else Filename.basename
path in
3452 let base = mbtoutf8
s in
3453 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3455 [ setorty "Sort by time of last visit" `lastvisit
;
3456 setorty "Sort by file name" `file
;
3457 setorty "Sort by path" `
path;
3458 setorty "Sort by title" `title
;
3459 (if !showfullpath then "@Uradical "
3460 else " ") ^
"Show full path", 0, Oaction
(fun () ->
3461 showfullpath := not
!showfullpath; reeenterhist := true)
3462 ] (List.sort
(order orderty
) !list)
3468 let outlinesource sourcetype
=
3470 inherit lvsourcebase
3471 val mutable m_items
= E.a
3472 val mutable m_minfo
= E.a
3473 val mutable m_orig_items
= E.a
3474 val mutable m_orig_minfo
= E.a
3475 val mutable m_narrow_patterns
= []
3476 val mutable m_hadremovals
= false
3477 val mutable m_gen
= -1
3479 method getitemcount
=
3480 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
3483 if n == Array.length m_items
&& m_hadremovals
3485 ("[Confirm removal]", 0)
3487 let s, n, _ = m_items
.(n) in
3490 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3491 ignore
(uioh
, first);
3492 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
3494 if m_narrow_patterns
= []
3495 then m_orig_items
, m_orig_minfo
3496 else m_items
, m_minfo
3500 if not
confrimremoval
3502 gotooutline m_items
.(active);
3507 state
.bookmarks
<- Array.to_list m_items
;
3508 m_orig_items
<- m_items
;
3509 m_orig_minfo
<- m_minfo
;
3519 method hasaction
_ = true
3522 if Array.length m_items
!= Array.length m_orig_items
3525 match m_narrow_patterns
with
3527 | many
-> String.concat
"@Uellipsis" (List.rev many
)
3529 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
3533 match m_narrow_patterns
with
3536 | head
:: _ -> "@Uellipsis" ^ head
3538 method narrow
pattern =
3539 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
3543 let rec loop accu minfo n =
3546 m_items
<- Array.of_list
accu;
3547 m_minfo
<- Array.of_list
minfo;
3550 let (s, _, t
) as o = m_items
.(n) in
3553 | Oaction
_ -> o :: accu, (0, 0) :: minfo
3554 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
3555 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
3557 try Str.search_forward
re s 0
3558 with Not_found
-> -1
3561 then o :: accu, (first, Str.match_end
()) :: minfo
3564 loop accu minfo (n-1)
3566 loop [] [] (Array.length m_items
- 1)
3568 method! getminfo
= m_minfo
3572 match sourcetype
with
3573 | `bookmarks
-> Array.of_list state
.bookmarks
3574 | `outlines
-> state
.outlines
3575 | `history
-> genhistoutlines !Config.historder
3577 m_minfo
<- m_orig_minfo
;
3578 m_items
<- m_orig_items
3581 if sourcetype
= `bookmarks
3583 if m >= 0 && m < Array.length m_items
3585 m_hadremovals
<- true;
3586 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
3587 let n = if n >= m then n+1 else n in
3592 method add_narrow_pattern
pattern =
3593 m_narrow_patterns
<- pattern :: m_narrow_patterns
3595 method del_narrow_pattern
=
3596 match m_narrow_patterns
with
3597 | _ :: rest
-> m_narrow_patterns
<- rest
3602 match m_narrow_patterns
with
3603 | pattern :: [] -> self#narrow
pattern; pattern
3605 List.fold_left
(fun accu pattern ->
3606 self#narrow
pattern;
3607 pattern ^
"@Uellipsis" ^
accu) E.s list
3609 method calcactive
anchor =
3610 let rely = getanchory anchor in
3611 let rec loop n best bestd
=
3612 if n = Array.length m_items
3615 let _, _, kind
= m_items
.(n) in
3618 let orely = getanchory anchor in
3619 let d = abs
(orely - rely) in
3622 else loop (n+1) best bestd
3623 | Onone
| Oremote
_ | Olaunch
_
3624 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ ->
3625 loop (n+1) best bestd
3629 method reset
anchor items =
3630 m_hadremovals
<- false;
3631 if state
.gen
!= m_gen
3633 m_orig_items
<- items;
3635 m_narrow_patterns
<- [];
3637 m_orig_minfo
<- E.a;
3641 if items != m_orig_items
3643 m_orig_items
<- items;
3644 if m_narrow_patterns
== []
3645 then m_items
<- items;
3648 let active = self#calcactive
anchor in
3650 m_first
<- firstof m_first
active
3654 let enterselector sourcetype
=
3656 let source = outlinesource sourcetype
in
3659 match sourcetype
with
3660 | `bookmarks
-> Array.of_list state
.bookmarks
3661 | `
outlines -> state
.outlines
3662 | `history
-> genhistoutlines !Config.historder
3664 if Array.length
outlines = 0
3666 showtext ' ' errmsg
;
3669 state
.text <- source#greetmsg
;
3670 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3671 let anchor = getanchor
() in
3672 source#reset
anchor outlines;
3674 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
3675 G.postRedisplay "enter selector";
3679 let enteroutlinemode =
3680 let f = enterselector `
outlines in
3681 fun () -> f "Document has no outline";
3684 let enterbookmarkmode =
3685 let f = enterselector `bookmarks
in
3686 fun () -> f "Document has no bookmarks (yet)";
3689 let enterhistmode () = enterselector `history
"No history (yet)";;
3691 let makecheckers () =
3692 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3694 converted by Issac Trotts. July 25, 2002 *)
3695 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3696 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3697 let id = GlTex.gen_texture
() in
3698 GlTex.bind_texture ~target
:`texture_2d
id;
3699 GlPix.store
(`unpack_alignment
1);
3700 GlTex.image2d
image;
3701 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3702 [ `mag_filter `nearest
; `min_filter `nearest
];
3706 let setcheckers enabled
=
3707 match state
.checkerstexid
with
3709 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3711 | Some checkerstexid
->
3714 GlTex.delete_texture checkerstexid
;
3715 state
.checkerstexid
<- None
;
3719 let describe_location () =
3720 let fn = page_of_y state
.y in
3721 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3722 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3726 else (100. *. (float state
.y /. float maxy))
3730 Printf.sprintf
"page %d of %d [%.2f%%]"
3731 (fn+1) state
.pagecount
percent
3734 "pages %d-%d of %d [%.2f%%]"
3735 (fn+1) (ln+1) state
.pagecount
percent
3738 let setpresentationmode v
=
3739 let n = page_of_y state
.y in
3740 state
.anchor <- (n, 0.0, 1.0);
3741 conf
.presentation
<- v
;
3742 if conf
.fitmodel
= FitPage
3743 then reqlayout conf
.angle conf
.fitmodel
;
3748 let btos b = if b then "@Uradical" else E.s in
3749 let showextended = ref false in
3750 let leave mode
= function
3751 | Confirm
-> state
.mode
<- mode
3752 | Cancel
-> state
.mode
<- mode
in
3755 val mutable m_first_time
= true
3756 val mutable m_l
= []
3757 val mutable m_a
= E.a
3758 val mutable m_prev_uioh
= nouioh
3759 val mutable m_prev_mode
= View
3761 inherit lvsourcebase
3763 method reset prev_mode prev_uioh
=
3764 m_a
<- Array.of_list
(List.rev m_l
);
3766 m_prev_mode
<- prev_mode
;
3767 m_prev_uioh
<- prev_uioh
;
3771 if n >= Array.length m_a
3775 | _, _, _, Action
_ -> m_active
<- n
3779 m_first_time
<- false;
3782 method int name get
set =
3784 (name
, `
int get
, 1, Action
(
3787 try set (int_of_string
s)
3789 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3793 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3794 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3798 method int_with_suffix name get
set =
3800 (name
, `intws get
, 1, Action
(
3803 try set (int_of_string_with_suffix
s)
3805 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3810 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3812 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3816 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3818 (name
, `
bool (btos, get
), offset
, Action
(
3825 method color name get
set =
3827 (name
, `color get
, 1, Action
(
3829 let invalid = (nan
, nan
, nan
) in
3832 try color_of_string
s
3834 state
.text <- Printf.sprintf
"bad color `%s': %s"
3841 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3842 state
.text <- color_to_string
(get
());
3843 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3847 method string name get
set =
3849 (name
, `
string get
, 1, Action
(
3851 let ondone s = set s in
3852 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3853 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3857 method colorspace name get
set =
3859 (name
, `
string get
, 1, Action
(
3863 inherit lvsourcebase
3866 m_active
<- CSTE.to_int conf
.colorspace
;
3869 method getitemcount
=
3870 Array.length
CSTE.names
3873 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3874 ignore
(uioh
, first, pan
);
3875 if not cancel
then set active;
3877 method hasaction
_ = true
3881 let modehash = findkeyhash conf
"info" in
3882 coe (new listview ~zebra
:false ~helpmode
:false
3883 ~
source ~trusted
:true ~
modehash)
3886 method paxmark name get
set =
3888 (name
, `
string get
, 1, Action
(
3892 inherit lvsourcebase
3895 m_active
<- MTE.to_int conf
.paxmark
;
3898 method getitemcount
= Array.length
MTE.names
3899 method getitem
n = (MTE.names
.(n), 0)
3900 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3901 ignore
(uioh
, first, pan
);
3902 if not cancel
then set active;
3904 method hasaction
_ = true
3908 let modehash = findkeyhash conf
"info" in
3909 coe (new listview ~zebra
:false ~helpmode
:false
3910 ~
source ~trusted
:true ~
modehash)
3913 method fitmodel name get
set =
3915 (name
, `
string get
, 1, Action
(
3919 inherit lvsourcebase
3922 m_active
<- FMTE.to_int conf
.fitmodel
;
3925 method getitemcount
= Array.length
FMTE.names
3926 method getitem
n = (FMTE.names
.(n), 0)
3927 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3928 ignore
(uioh
, first, pan
);
3929 if not cancel
then set active;
3931 method hasaction
_ = true
3935 let modehash = findkeyhash conf
"info" in
3936 coe (new listview ~zebra
:false ~helpmode
:false
3937 ~
source ~trusted
:true ~
modehash)
3940 method caption
s offset
=
3941 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3943 method caption2
s f offset
=
3944 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3946 method getitemcount
= Array.length m_a
3949 let tostr = function
3950 | `
int f -> string_of_int
(f ())
3951 | `intws
f -> string_with_suffix_of_int
(f ())
3953 | `color
f -> color_to_string
(f ())
3954 | `
bool (btos, f) -> btos (f ())
3957 let name, t
, offset
, _ = m_a
.(n) in
3958 ((let s = tostr t
in
3960 then Printf.sprintf
"%s\t%s" name s
3964 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3969 match m_a
.(active) with
3970 | _, _, _, Action
f -> f uioh
3982 method hasaction
n =
3984 | _, _, _, Action
_ -> true
3988 let rec fillsrc prevmode prevuioh
=
3989 let sep () = src#caption
E.s 0 in
3990 let colorp name get
set =
3992 (fun () -> color_to_string
(get
()))
3995 let c = color_of_string
v in
3998 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
4001 let oldmode = state
.mode
in
4002 let birdseye = isbirdseye state
.mode
in
4004 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
4006 src#
bool "presentation mode"
4007 (fun () -> conf
.presentation
)
4008 (fun v -> setpresentationmode v);
4010 src#
bool "ignore case in searches"
4011 (fun () -> conf
.icase
)
4012 (fun v -> conf
.icase
<- v);
4015 (fun () -> conf
.preload)
4016 (fun v -> conf
.preload <- v);
4018 src#
bool "highlight links"
4019 (fun () -> conf
.hlinks
)
4020 (fun v -> conf
.hlinks
<- v);
4022 src#
bool "under info"
4023 (fun () -> conf
.underinfo
)
4024 (fun v -> conf
.underinfo
<- v);
4026 src#
bool "persistent bookmarks"
4027 (fun () -> conf
.savebmarks
)
4028 (fun v -> conf
.savebmarks
<- v);
4030 src#fitmodel
"fit model"
4031 (fun () -> FMTE.to_string conf
.fitmodel
)
4032 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
4034 src#
bool "trim margins"
4035 (fun () -> conf
.trimmargins
)
4036 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
4038 src#
bool "persistent location"
4039 (fun () -> conf
.jumpback
)
4040 (fun v -> conf
.jumpback
<- v);
4043 src#
int "inter-page space"
4044 (fun () -> conf
.interpagespace
)
4046 conf
.interpagespace
<- n;
4047 docolumns conf
.columns
;
4049 match state
.layout with
4054 state
.maxy <- calcheight
();
4055 let y = getpagey
pageno in
4060 (fun () -> conf
.pagebias
)
4061 (fun v -> conf
.pagebias
<- v);
4063 src#
int "scroll step"
4064 (fun () -> conf
.scrollstep
)
4065 (fun n -> conf
.scrollstep
<- n);
4067 src#
int "horizontal scroll step"
4068 (fun () -> conf
.hscrollstep
)
4069 (fun v -> conf
.hscrollstep
<- v);
4071 src#
int "auto scroll step"
4073 match state
.autoscroll
with
4075 | _ -> conf
.autoscrollstep
)
4077 let n = boundastep state
.winh
n in
4078 if state
.autoscroll
<> None
4079 then state
.autoscroll
<- Some
n;
4080 conf
.autoscrollstep
<- n);
4083 (fun () -> truncate
(conf
.zoom *. 100.))
4084 (fun v -> setzoom ((float v) /. 100.));
4087 (fun () -> conf
.angle
)
4088 (fun v -> reqlayout v conf
.fitmodel
);
4090 src#
int "scroll bar width"
4091 (fun () -> conf
.scrollbw
)
4094 reshape state
.winw state
.winh
;
4097 src#
int "scroll handle height"
4098 (fun () -> conf
.scrollh
)
4099 (fun v -> conf
.scrollh
<- v;);
4101 src#
int "thumbnail width"
4102 (fun () -> conf
.thumbw
)
4104 conf
.thumbw
<- min
4096 v;
4107 leavebirdseye beye
false;
4112 let mode = state
.mode in
4113 src#
string "columns"
4115 match conf
.columns
with
4117 | Cmulti
(multi
, _) -> multicolumns_to_string multi
4118 | Csplit
(count
, _) -> "-" ^ string_of_int count
4121 let n, a, b = multicolumns_of_string
v in
4122 setcolumns mode n a b);
4125 src#caption
"Pixmap cache" 0;
4126 src#int_with_suffix
"size (advisory)"
4127 (fun () -> conf
.memlimit
)
4128 (fun v -> conf
.memlimit
<- v);
4131 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
4132 (string_with_suffix_of_int state
.memused
)
4133 (Hashtbl.length state
.tilemap
)) 1;
4136 src#caption
"Layout" 0;
4137 src#caption2
"Dimension"
4139 Printf.sprintf
"%dx%d (virtual %dx%d)"
4140 state
.winw state
.winh
4145 src#caption2
"Position" (fun () ->
4146 Printf.sprintf
"%dx%d" state
.x state
.y
4149 src#caption2
"Position" (fun () -> describe_location ()) 1
4153 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
4154 "Save these parameters as global defaults at exit"
4155 (fun () -> conf
.bedefault
)
4156 (fun v -> conf
.bedefault
<- v)
4160 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
4161 src#
bool ~offset
:0 ~
btos "Extended parameters"
4162 (fun () -> !showextended)
4163 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
4167 (fun () -> conf
.checkers
)
4168 (fun v -> conf
.checkers
<- v; setcheckers v);
4169 src#
bool "update cursor"
4170 (fun () -> conf
.updatecurs
)
4171 (fun v -> conf
.updatecurs
<- v);
4172 src#
bool "scroll-bar on the left"
4173 (fun () -> conf
.leftscroll
)
4174 (fun v -> conf
.leftscroll
<- v);
4176 (fun () -> conf
.verbose
)
4177 (fun v -> conf
.verbose
<- v);
4178 src#
bool "invert colors"
4179 (fun () -> conf
.invert
)
4180 (fun v -> conf
.invert
<- v);
4182 (fun () -> conf
.maxhfit
)
4183 (fun v -> conf
.maxhfit
<- v);
4184 src#
bool "redirect stderr"
4185 (fun () -> conf
.redirectstderr)
4186 (fun v -> conf
.redirectstderr <- v; redirectstderr ());
4188 (fun () -> conf
.pax
!= None
)
4191 then conf
.pax
<- Some
(ref (now
(), 0, 0))
4192 else conf
.pax
<- None
);
4193 src#
string "uri launcher"
4194 (fun () -> conf
.urilauncher
)
4195 (fun v -> conf
.urilauncher
<- v);
4196 src#
string "path launcher"
4197 (fun () -> conf
.pathlauncher
)
4198 (fun v -> conf
.pathlauncher
<- v);
4199 src#
string "tile size"
4200 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
4203 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
4204 conf
.tilew
<- max
64 w;
4205 conf
.tileh
<- max
64 h;
4208 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
4211 src#
int "texture count"
4212 (fun () -> conf
.texcount
)
4215 then conf
.texcount
<- v
4216 else showtext '
!'
" Failed to set texture count please retry later"
4218 src#
int "slice height"
4219 (fun () -> conf
.sliceheight
)
4221 conf
.sliceheight
<- v;
4222 wcmd "sliceh %d" conf
.sliceheight
;
4224 src#
int "anti-aliasing level"
4225 (fun () -> conf
.aalevel
)
4227 conf
.aalevel
<- bound
v 0 8;
4228 state
.anchor <- getanchor
();
4229 opendoc state
.path state
.password
;
4231 src#
string "page scroll scaling factor"
4232 (fun () -> string_of_float conf
.pgscale)
4235 let s = float_of_string
v in
4238 state
.text <- Printf.sprintf
4239 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
4242 src#
int "ui font size"
4243 (fun () -> fstate
.fontsize
)
4244 (fun v -> setfontsize (bound
v 5 100));
4245 src#
int "hint font size"
4246 (fun () -> conf
.hfsize
)
4247 (fun v -> conf
.hfsize
<- bound
v 5 100);
4248 colorp "background color"
4249 (fun () -> conf
.bgcolor
)
4250 (fun v -> conf
.bgcolor
<- v);
4251 src#
bool "crop hack"
4252 (fun () -> conf
.crophack
)
4253 (fun v -> conf
.crophack
<- v);
4254 src#
string "trim fuzz"
4255 (fun () -> irect_to_string conf
.trimfuzz
)
4258 conf
.trimfuzz
<- irect_of_string
v;
4260 then settrim true conf
.trimfuzz
;
4262 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
4264 src#
string "throttle"
4266 match conf
.maxwait
with
4267 | None
-> "show place holder if page is not ready"
4270 then "wait for page to fully render"
4272 "wait " ^ string_of_float
time
4273 ^
" seconds before showing placeholder"
4277 let f = float_of_string
v in
4279 then conf
.maxwait
<- None
4280 else conf
.maxwait
<- Some
f
4282 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
4284 src#
string "ghyll scroll"
4286 match conf
.ghyllscroll
with
4288 | Some nab
-> ghyllscroll_to_string nab
4291 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
4293 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
4295 src#
string "selection command"
4296 (fun () -> conf
.selcmd
)
4297 (fun v -> conf
.selcmd
<- v);
4298 src#
string "synctex command"
4299 (fun () -> conf
.stcmd
)
4300 (fun v -> conf
.stcmd
<- v);
4301 src#
string "pax command"
4302 (fun () -> conf
.paxcmd
)
4303 (fun v -> conf
.paxcmd
<- v);
4304 src#colorspace
"color space"
4305 (fun () -> CSTE.to_string conf
.colorspace
)
4307 conf
.colorspace
<- CSTE.of_int
v;
4311 src#paxmark
"pax mark method"
4312 (fun () -> MTE.to_string conf
.paxmark
)
4313 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4317 (fun () -> conf
.usepbo
)
4318 (fun v -> conf
.usepbo
<- v);
4319 src#
bool "mouse wheel scrolls pages"
4320 (fun () -> conf
.wheelbypage
)
4321 (fun v -> conf
.wheelbypage
<- v);
4322 src#
bool "open remote links in a new instance"
4323 (fun () -> conf
.riani
)
4324 (fun v -> conf
.riani
<- v);
4328 src#caption
"Document" 0;
4329 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4330 src#caption2
"Pages"
4331 (fun () -> string_of_int state
.pagecount
) 1;
4332 src#caption2
"Dimensions"
4333 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4337 src#caption
"Trimmed margins" 0;
4338 src#caption2
"Dimensions"
4339 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4343 src#caption
"OpenGL" 0;
4344 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4345 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4348 src#caption
"Location" 0;
4349 if nonemptystr state
.origin
4350 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4351 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4353 src#reset prevmode prevuioh
;
4358 let prevmode = state
.mode
4359 and prevuioh
= state
.uioh in
4360 fillsrc prevmode prevuioh
;
4361 let source = (src :> lvsource
) in
4362 let modehash = findkeyhash conf
"info" in
4363 state
.uioh <- coe (object (self)
4364 inherit listview ~zebra
:false ~helpmode
:false
4365 ~
source ~trusted
:true ~
modehash as super
4366 val mutable m_prevmemused
= 0
4367 method! infochanged
= function
4369 if m_prevmemused
!= state
.memused
4371 m_prevmemused
<- state
.memused
;
4372 G.postRedisplay "memusedchanged";
4374 | Pdim
-> G.postRedisplay "pdimchanged"
4375 | Docinfo
-> fillsrc prevmode prevuioh
4377 method! key key mask
=
4378 if not
(Wsi.withctrl mask
)
4381 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4382 | @right
| @kpright
-> coe (self#updownlevel
1)
4383 | _ -> super#
key key mask
4384 else super#
key key mask
4386 G.postRedisplay "info";
4392 inherit lvsourcebase
4393 method getitemcount
= Array.length state
.help
4395 let s, l, _ = state
.help
.(n) in
4398 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4402 match state
.help
.(active) with
4403 | _, _, Action
f -> Some
(f uioh)
4413 method hasaction
n =
4414 match state
.help
.(n) with
4415 | _, _, Action
_ -> true
4422 let modehash = findkeyhash conf
"help" in
4424 state
.uioh <- coe (new listview
4425 ~zebra
:false ~helpmode
:true
4426 ~
source ~trusted
:true ~
modehash);
4427 G.postRedisplay "help";
4432 let re = Str.regexp
"[\r\n]" in
4434 inherit lvsourcebase
4435 val mutable m_items
= E.a
4437 method getitemcount
= 1 + Array.length m_items
4442 else m_items
.(n-1), 0
4444 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4449 then Buffer.clear state
.errmsgs
;
4456 method hasaction
n =
4460 state
.newerrmsgs
<- false;
4461 let l = Str.split
re (Buffer.contents state
.errmsgs
) in
4462 m_items
<- Array.of_list
l
4471 let source = (msgsource :> lvsource
) in
4472 let modehash = findkeyhash conf
"listview" in
4473 state
.uioh <- coe (object
4474 inherit listview ~zebra
:false ~helpmode
:false
4475 ~
source ~trusted
:false ~
modehash as super
4478 then msgsource#reset
;
4481 G.postRedisplay "msgs";
4484 let quickbookmark ?title
() =
4485 match state
.layout with
4491 let tm = Unix.localtime
(now
()) in
4492 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
4496 (tm.Unix.tm_year
+ 1900)
4499 | Some
title -> title
4501 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4504 let setautoscrollspeed step goingdown
=
4505 let incr = max
1 ((abs step
) / 2) in
4506 let incr = if goingdown
then incr else -incr in
4507 let astep = boundastep state
.winh
(step
+ incr) in
4508 state
.autoscroll
<- Some
astep;
4512 match conf
.columns
with
4514 | _ -> state
.x != 0 || conf
.zoom > 1.0
4517 let panbound x = bound
x (-state
.w) (wadjsb state
.winw
);;
4519 let existsinrow pageno (columns
, coverA
, coverB
) p =
4520 let last = ((pageno - coverA
) mod columns
) + columns
in
4521 let rec any = function
4524 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4528 then (if l.pageno = last then false else any rest
)
4536 match state
.layout with
4538 let pageno = page_of_y state
.y in
4539 gotoghyll (getpagey
(pageno+1))
4541 match conf
.columns
with
4543 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4545 let y = clamp (pgscale state
.winh
) in
4548 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4549 gotoghyll (getpagey
pageno)
4550 | Cmulti
((c, _, _) as cl, _) ->
4551 if conf
.presentation
4552 && (existsinrow l.pageno cl
4553 (fun l -> l.pageh
> l.pagey + l.pagevh))
4555 let y = clamp (pgscale state
.winh
) in
4558 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4559 gotoghyll (getpagey
pageno)
4561 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4563 let pagey, pageh
= getpageyh
l.pageno in
4564 let pagey = pagey + pageh
* l.pagecol
in
4565 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4566 gotoghyll (pagey + pageh
+ ips)
4570 match state
.layout with
4572 let pageno = page_of_y state
.y in
4573 gotoghyll (getpagey
(pageno-1))
4575 match conf
.columns
with
4577 if conf
.presentation
&& l.pagey != 0
4579 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4581 let pageno = max
0 (l.pageno-1) in
4582 gotoghyll (getpagey
pageno)
4583 | Cmulti
((c, _, coverB
) as cl, _) ->
4584 if conf
.presentation
&&
4585 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4587 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4590 if l.pageno = state
.pagecount
- coverB
4594 let pageno = max
0 (l.pageno-decr) in
4595 gotoghyll (getpagey
pageno)
4603 let pageno = max
0 (l.pageno-1) in
4604 let pagey, pageh
= getpageyh
pageno in
4607 let pagey, pageh
= getpageyh
l.pageno in
4608 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4613 let viewkeyboard key mask
=
4615 let mode = state
.mode in
4616 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4619 G.postRedisplay "view:enttext"
4621 let ctrl = Wsi.withctrl mask
in
4623 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4628 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4630 state
.mode <- LinkNav
(Ltgendir
0);
4633 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4636 begin match state
.mstate
with
4639 G.postRedisplay "kill zoom rect";
4641 begin match state
.mode with
4644 G.postRedisplay "esc leave linknav"
4646 match state
.ranchors
with
4648 | (path, password
, anchor, origin
) :: rest
->
4649 state
.ranchors
<- rest
;
4650 state
.anchor <- anchor;
4651 state
.origin
<- origin
;
4652 state
.nameddest
<- E.s;
4653 opendoc path password
4658 gotoghyll (getnav ~
-1)
4669 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4670 G.postRedisplay "dehighlight";
4672 | @slash
| @question
->
4673 let ondone isforw
s =
4674 cbput state
.hists
.pat
s;
4675 state
.searchpattern
<- s;
4678 let s = String.create
1 in
4679 s.[0] <- Char.chr
key;
4680 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4681 textentry, ondone (key = @slash
), true)
4683 | @plus
| @kpplus
| @equals
when ctrl ->
4684 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4685 setzoom (conf
.zoom +. incr)
4687 | @plus
| @kpplus
->
4690 try int_of_string
s with exc
->
4691 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4697 state
.text <- "page bias is now " ^ string_of_int
n;
4700 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4702 | @minus
| @kpminus
when ctrl ->
4703 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4704 setzoom (max
0.01 (conf
.zoom -. decr))
4706 | @minus
| @kpminus
->
4707 let ondone msg
= state
.text <- msg
in
4709 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4710 optentry state
.mode, ondone, true
4721 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4723 match conf
.columns
with
4724 | Csingle
_ | Cmulti
_ -> 1
4725 | Csplit
(n, _) -> n
4727 let h = state
.winh
-
4728 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4730 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4731 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4736 match conf
.fitmodel
with
4737 | FitWidth
-> FitProportional
4738 | FitProportional
-> FitPage
4739 | FitPage
-> FitWidth
4741 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4742 reqlayout conf
.angle
fm
4750 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4751 when not
ctrl -> (* 0..9 *)
4754 try int_of_string
s with exc
->
4755 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4761 cbput state
.hists
.pag
(string_of_int
n);
4762 gotopage1 (n + conf
.pagebias
- 1) 0;
4765 let pageentry text key =
4766 match Char.unsafe_chr
key with
4767 | '
g'
-> TEdone
text
4768 | _ -> intentry text key
4770 let text = "x" in text.[0] <- Char.chr
key;
4771 enttext (":", text, Some
(onhist state
.hists
.pag
),
4772 pageentry, ondone, true)
4775 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4776 reshape state
.winw state
.winh
;
4779 state
.bzoom
<- not state
.bzoom
;
4781 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4784 conf
.hlinks
<- not conf
.hlinks
;
4785 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4786 G.postRedisplay "toggle highlightlinks";
4789 state
.glinks
<- true;
4790 let mode = state
.mode in
4791 state
.mode <- Textentry
(
4792 (":", E.s, None
, linknentry, linkndone gotounder, false),
4794 state
.glinks
<- false;
4798 G.postRedisplay "view:linkent(F)"
4801 state
.glinks
<- true;
4802 let mode = state
.mode in
4803 state
.mode <- Textentry
(
4805 ":", E.s, None
, linknentry, linkndone (fun under ->
4806 selstring (undertext under);
4810 state
.glinks
<- false;
4814 G.postRedisplay "view:linkent"
4817 begin match state
.autoscroll
with
4819 conf
.autoscrollstep
<- step
;
4820 state
.autoscroll
<- None
4822 if conf
.autoscrollstep
= 0
4823 then state
.autoscroll
<- Some
1
4824 else state
.autoscroll
<- Some conf
.autoscrollstep
4831 setpresentationmode (not conf
.presentation
);
4832 showtext ' '
("presentation mode " ^
4833 if conf
.presentation
then "on" else "off");
4836 if List.mem
Wsi.Fullscreen state
.winstate
4837 then Wsi.reshape conf
.cwinw conf
.cwinh
4838 else Wsi.fullscreen
()
4841 search state
.searchpattern
false
4844 search state
.searchpattern
true
4847 begin match state
.layout with
4850 gotoghyll (getpagey
l.pageno)
4856 | @delete
| @kpdelete
-> (* delete *)
4860 showtext ' '
(describe_location ());
4863 begin match state
.layout with
4866 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
4871 enterbookmarkmode ()
4879 | @e when Buffer.length state
.errmsgs
> 0 ->
4884 match state
.layout with
4889 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4892 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
4896 showtext ' '
"Quick bookmark added";
4899 begin match state
.layout with
4901 let rect = getpdimrect
l.pagedimno
in
4905 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
4906 truncate
(1.2 *. (rect.(3) -. rect.(0))))
4908 (truncate
(rect.(1) -. rect.(0)),
4909 truncate
(rect.(3) -. rect.(0)))
4911 let w = truncate
((float w)*.conf
.zoom)
4912 and h = truncate
((float h)*.conf
.zoom) in
4915 state
.anchor <- getanchor
();
4916 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
4918 G.postRedisplay "z";
4923 | @x -> state
.roam
()
4926 reqlayout (conf
.angle
+
4927 (if key = @question
then 30 else -30)) conf
.fitmodel
4931 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
4933 G.postRedisplay "brightness";
4935 | @c when state
.mode = View
->
4940 let m = (wadjsb state
.winw
- state
.w) / 2 in
4942 gotoy_and_clear_text state
.y
4946 match state
.prevcolumns
with
4947 | None
-> (1, 0, 0), 1.0
4948 | Some
(columns
, z
) ->
4951 | Csplit
(c, _) -> -c, 0, 0
4952 | Cmulti
((c, a, b), _) -> c, a, b
4953 | Csingle
_ -> 1, 0, 0
4957 setcolumns View
c a b;
4960 | @down
| @up
when ctrl && Wsi.withshift mask
->
4961 let zoom, x = state
.prevzoom
in
4965 | @k
| @up
| @kpup
->
4966 begin match state
.autoscroll
with
4968 begin match state
.mode with
4969 | Birdseye beye
-> upbirdseye 1 beye
4972 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
4974 if not
(Wsi.withshift mask
) && conf
.presentation
4976 else gotoghyll1 true (clamp (-conf
.scrollstep
))
4980 setautoscrollspeed n false
4983 | @j
| @down
| @kpdown
->
4984 begin match state
.autoscroll
with
4986 begin match state
.mode with
4987 | Birdseye beye
-> downbirdseye 1 beye
4990 then gotoy_and_clear_text (clamp (state
.winh
/2))
4992 if not
(Wsi.withshift mask
) && conf
.presentation
4994 else gotoghyll1 true (clamp (conf
.scrollstep
))
4998 setautoscrollspeed n true
5001 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5007 else conf
.hscrollstep
5009 let dx = if key = @left || key = @kpleft
then dx else -dx in
5010 state
.x <- panbound (state
.x + dx);
5011 gotoy_and_clear_text state
.y
5014 G.postRedisplay "left/right"
5017 | @prior
| @kpprior
->
5021 match state
.layout with
5023 | l :: _ -> state
.y - l.pagey
5025 clamp (pgscale (-state
.winh
))
5029 | @next | @kpnext
->
5033 match List.rev state
.layout with
5035 | l :: _ -> getpagey
l.pageno
5037 clamp (pgscale state
.winh
)
5041 | @g | @home
| @kphome
->
5044 | @G
| @jend
| @kpend
->
5046 gotoghyll (clamp state
.maxy)
5048 | @right
| @kpright
when Wsi.withalt mask
->
5049 gotoghyll (getnav 1)
5050 | @left | @kpleft
when Wsi.withalt mask
->
5051 gotoghyll (getnav ~
-1)
5056 | @v when conf
.debug
->
5059 match getopaque l.pageno with
5062 let x0, y0, x1, y1 = pagebbox
opaque in
5063 let a,b = float x0, float y0 in
5064 let c,d = float x1, float y0 in
5065 let e,f = float x1, float y1 in
5066 let h,j
= float x0, float y1 in
5067 let rect = (a,b,c,d,e,f,h,j
) in
5069 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5071 G.postRedisplay "v";
5074 let mode = state
.mode in
5075 let cmd = ref E.s in
5076 let onleave = function
5077 | Cancel
-> state
.mode <- mode
5080 match getopaque l.pageno with
5081 | Some
opaque -> pipesel opaque !cmd
5082 | None
-> ()) state
.layout;
5086 cbput state
.hists
.sel
s;
5090 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5092 G.postRedisplay "|";
5093 state
.mode <- Textentry
(te, onleave);
5096 vlog "huh? %s" (Wsi.keyname
key)
5099 let linknavkeyboard key mask
linknav =
5100 let getpage pageno =
5101 let rec loop = function
5103 | l :: _ when l.pageno = pageno -> Some
l
5104 | _ :: rest
-> loop rest
5105 in loop state
.layout
5107 let doexact (pageno, n) =
5108 match getopaque pageno, getpage pageno with
5109 | Some
opaque, Some
l ->
5110 if key = @enter
|| key = @kpenter
5112 let under = getlink
opaque n in
5113 G.postRedisplay "link gotounder";
5120 Some
(findlink
opaque LDfirst
), -1
5123 Some
(findlink
opaque LDlast
), 1
5126 Some
(findlink
opaque (LDleft
n)), -1
5129 Some
(findlink
opaque (LDright
n)), 1
5132 Some
(findlink
opaque (LDup
n)), -1
5135 Some
(findlink
opaque (LDdown
n)), 1
5140 begin match findpwl
l.pageno dir with
5144 state
.mode <- LinkNav
(Ltgendir
dir);
5145 let y, h = getpageyh
pageno in
5148 then y + h - state
.winh
5153 begin match getopaque pageno, getpage pageno with
5154 | Some
opaque, Some
_ ->
5156 let ld = if dir > 0 then LDfirst
else LDlast
in
5159 begin match link with
5161 showlinktype (getlink
opaque m);
5162 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5163 G.postRedisplay "linknav jpage";
5170 begin match opt with
5171 | Some Lnotfound
-> pwl l dir;
5172 | Some
(Lfound
m) ->
5176 let _, y0, _, y1 = getlinkrect
opaque m in
5178 then gotopage1 l.pageno y0
5180 let d = fstate
.fontsize
+ 1 in
5181 if y1 - l.pagey > l.pagevh - d
5182 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5183 else G.postRedisplay "linknav";
5185 showlinktype (getlink
opaque m);
5186 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5189 | None
-> viewkeyboard key mask
5191 | _ -> viewkeyboard key mask
5196 G.postRedisplay "leave linknav"
5200 | Ltgendir
_ -> viewkeyboard key mask
5201 | Ltexact exact
-> doexact exact
5204 let keyboard key mask
=
5205 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5206 then wcmd "interrupt"
5207 else state
.uioh <- state
.uioh#
key key mask
5210 let birdseyekeyboard key mask
5211 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5213 match conf
.columns
with
5215 | Cmulti
((c, _, _), _) -> c
5216 | Csplit
_ -> failwith
"bird's eye split mode"
5218 let pgh layout = List.fold_left
5219 (fun m l -> max
l.pageh
m) state
.winh
layout in
5221 | @l when Wsi.withctrl mask
->
5222 let y, h = getpageyh
pageno in
5223 let top = (state
.winh
- h) / 2 in
5224 gotoy (max
0 (y - top))
5225 | @enter
| @kpenter
-> leavebirdseye beye
false
5226 | @escape
-> leavebirdseye beye
true
5227 | @up
-> upbirdseye incr beye
5228 | @down
-> downbirdseye incr beye
5229 | @left -> upbirdseye 1 beye
5230 | @right
-> downbirdseye 1 beye
5233 begin match state
.layout with
5237 state
.mode <- Birdseye
(
5238 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5240 gotopage1 l.pageno 0;
5243 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5245 | [] -> gotoy (clamp (-state
.winh
))
5247 state
.mode <- Birdseye
(
5248 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5250 gotopage1 l.pageno 0
5253 | [] -> gotoy (clamp (-state
.winh
))
5257 begin match List.rev state
.layout with
5259 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5260 begin match layout with
5262 let incr = l.pageh
- l.pagevh in
5267 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5269 G.postRedisplay "birdseye pagedown";
5271 else gotoy (clamp (incr + conf
.interpagespace
*2));
5275 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5276 gotopage1 l.pageno 0;
5279 | [] -> gotoy (clamp state
.winh
)
5283 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5287 let pageno = state
.pagecount
- 1 in
5288 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5289 if not
(pagevisible state
.layout pageno)
5292 match List.rev state
.pdims
with
5294 | (_, _, h, _) :: _ -> h
5296 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5297 else G.postRedisplay "birdseye end";
5299 | _ -> viewkeyboard key mask
5304 match state
.mode with
5305 | Textentry
_ -> scalecolor 0.4
5307 | View
-> scalecolor 1.0
5308 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5309 if l.pageno = hooverpageno
5312 if l.pageno = pageno
5314 let c = scalecolor 1.0 in
5316 GlDraw.line_width
3.0;
5317 let dispx = xadjsb l.pagedispx in
5319 (float (dispx-1)) (float (l.pagedispy-1))
5320 (float (dispx+l.pagevw+1))
5321 (float (l.pagedispy+l.pagevh+1))
5323 GlDraw.line_width
1.0;
5332 let postdrawpage l linkindexbase
=
5333 match getopaque l.pageno with
5335 if tileready l l.pagex
l.pagey
5337 let x = l.pagedispx - l.pagex
+ xadjsb 0
5338 and y = l.pagedispy - l.pagey in
5340 match conf
.columns
with
5341 | Csingle
_ | Cmulti
_ ->
5342 (if conf
.hlinks
then 1 else 0)
5344 && not
(isbirdseye state
.mode) then 2 else 0)
5348 match state
.mode with
5349 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5352 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5357 let scrollindicator () =
5358 let sbw, ph
, sh = state
.uioh#
scrollph in
5359 let sbh, pw, sw = state
.uioh#scrollpw
in
5364 else (state
.winw
- sbw), state
.winw
5367 GlDraw.color (0.64, 0.64, 0.64);
5368 filledrect (float x0) 0. (float x1) (float state
.winh
);
5370 0. (float (state
.winh
- sbh))
5371 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5373 GlDraw.color (0.0, 0.0, 0.0);
5375 filledrect (float x0) ph
(float x1) (ph
+. sh);
5376 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5380 match state
.mstate
with
5381 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5384 | Msel
((x0, y0), (x1, y1)) ->
5385 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5386 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5387 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5388 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5391 let showrects = function [] -> () | rects
->
5393 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5394 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5396 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5398 if l.pageno = pageno
5400 let dx = float (l.pagedispx - l.pagex
) in
5401 let dy = float (l.pagedispy - l.pagey) in
5402 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5403 Raw.sets_float state
.vraw ~
pos:0
5408 GlArray.vertex `two state
.vraw
;
5409 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5418 GlClear.color (scalecolor2 conf
.bgcolor
);
5419 GlClear.clear
[`
color];
5420 List.iter
drawpage state
.layout;
5422 match state
.mode with
5423 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5424 begin match getopaque pageno with
5426 let dx = xadjsb 0 in
5427 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5428 let x0 = x0 + dx and x1 = x1 + dx in
5435 | None
-> state
.rects
5440 let rec postloop linkindexbase
= function
5442 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5443 postloop linkindexbase rest
5447 postloop 0 state
.layout;
5449 begin match state
.mstate
with
5450 | Mzoomrect
((x0, y0), (x1, y1)) ->
5452 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5453 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5454 filledrect (float x0) (float y0) (float x1) (float y1);
5463 let zoomrect x y x1 y1 =
5466 and y0 = min
y y1 in
5467 gotoy (state
.y + y0);
5468 state
.anchor <- getanchor
();
5469 let zoom = (float state
.w) /. float (x1 - x0) in
5471 match conf
.fitmodel
, conf
.columns
with
5472 | FitPage
, Csplit
_ ->
5473 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5476 let adjw = wadjsb state
.winw
in
5478 then (adjw - state
.w) / 2
5481 state
.x <- (state
.x + margin) - x0;
5487 let g opaque l px py =
5488 match rectofblock
opaque px py with
5490 let x0 = a.(0) -. 20. in
5491 let x1 = a.(1) +. 20. in
5492 let y0 = a.(2) -. 20. in
5493 let zoom = (float state
.w) /. (x1 -. x0) in
5494 let pagey = getpagey
l.pageno in
5495 gotoy_and_clear_text (pagey + truncate
y0);
5496 state
.anchor <- getanchor
();
5497 let margin = (state
.w - l.pagew
)/2 in
5498 state
.x <- -truncate
x0 - margin;
5503 match conf
.columns
with
5505 showtext '
!'
"block zooming does not work properly in split columns mode"
5506 | _ -> onppundermouse g x y ()
5510 let winw = wadjsb state
.winw - 1 in
5511 let s = float x /. float winw in
5512 let destx = truncate
(float (state
.w + winw) *. s) in
5513 state
.x <- winw - destx;
5514 gotoy_and_clear_text state
.y;
5515 state
.mstate
<- Mscrollx
;
5519 let s = float y /. float state
.winh
in
5520 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5521 gotoy_and_clear_text desty;
5522 state
.mstate
<- Mscrolly
;
5525 let viewmulticlick clicks
x y mask
=
5526 let g opaque l px py =
5534 if markunder
opaque px py mark
5538 match getopaque l.pageno with
5540 | Some
opaque -> pipesel opaque cmd
5542 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5543 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5548 G.postRedisplay "viewmulticlick";
5549 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5553 match conf
.columns
with
5555 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5558 let viewmouse button down
x y mask
=
5560 | n when (n == 4 || n == 5) && not down
->
5561 if Wsi.withctrl mask
5563 match state
.mstate
with
5564 | Mzoom
(oldn
, i
) ->
5572 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5574 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5576 let zoom = conf
.zoom -. incr in
5578 state
.mstate
<- Mzoom
(n, 0);
5580 state
.mstate
<- Mzoom
(n, i
+1);
5582 else state
.mstate
<- Mzoom
(n, 0)
5584 | _ -> state
.mstate
<- Mzoom
(n, 0)
5587 match state
.autoscroll
with
5588 | Some step
-> setautoscrollspeed step
(n=4)
5590 if conf
.wheelbypage
|| conf
.presentation
5599 then -conf
.scrollstep
5600 else conf
.scrollstep
5602 let incr = incr * 2 in
5603 let y = clamp incr in
5604 gotoy_and_clear_text y
5607 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5609 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5610 gotoy_and_clear_text state
.y
5612 | 1 when Wsi.withshift mask
->
5613 state
.mstate
<- Mnone
;
5616 match unproject x y with
5617 | Some
(pageno, ux
, uy
) ->
5618 let cmd = Printf.sprintf
5620 conf
.stcmd state
.path pageno ux uy
5626 | 1 when Wsi.withctrl mask
->
5629 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5630 state
.mstate
<- Mpan
(x, y)
5633 state
.mstate
<- Mnone
5638 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5640 state
.mstate
<- Mzoomrect
(p, p)
5643 match state
.mstate
with
5644 | Mzoomrect
((x0, y0), _) ->
5645 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5646 then zoomrect x0 y0 x y
5649 G.postRedisplay "kill accidental zoom rect";
5655 | 1 when x > state
.winw - vscrollw () ->
5658 let _, position, sh = state
.uioh#
scrollph in
5659 if y > truncate
position && y < truncate
(position +. sh)
5660 then state
.mstate
<- Mscrolly
5663 state
.mstate
<- Mnone
5665 | 1 when y > state
.winh
- hscrollh () ->
5668 let _, position, sw = state
.uioh#scrollpw
in
5669 if x > truncate
position && x < truncate
(position +. sw)
5670 then state
.mstate
<- Mscrollx
5673 state
.mstate
<- Mnone
5675 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5678 let dest = if down
then getunder x y else Unone
in
5679 begin match dest with
5682 | Uremote
_ | Uremotedest
_
5683 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5686 | Unone
when down
->
5687 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5688 state
.mstate
<- Mpan
(x, y);
5690 | Unone
| Utext
_ ->
5695 state
.mstate
<- Msel
((x, y), (x, y));
5696 G.postRedisplay "mouse select";
5700 match state
.mstate
with
5703 | Mzoom
_ | Mscrollx
| Mscrolly
->
5704 state
.mstate
<- Mnone
5706 | Mzoomrect
((x0, y0), _) ->
5710 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5711 state
.mstate
<- Mnone
5713 | Msel
((x0, y0), (x1, y1)) ->
5714 let rec loop = function
5718 let a0 = l.pagedispy in
5719 let a1 = a0 + l.pagevh in
5720 let b0 = l.pagedispx in
5721 let b1 = b0 + l.pagevw in
5722 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5723 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5727 match getopaque l.pageno with
5730 match Ne.res Unix.pipe
with
5734 "can not create sel pipe: %s"
5738 Ne.clo fd
(fun msg
->
5739 dolog
"%s close failed: %s" what msg
)
5742 try popen
cmd [r, 0; w, -1]; true
5744 dolog
"can not execute %S: %s"
5751 G.postRedisplay "copysel";
5753 else clo "Msel pipe/w" w;
5754 clo "Msel pipe/r" r;
5756 dosel conf
.selcmd
();
5757 state
.roam
<- dosel conf
.paxcmd
;
5769 let birdseyemouse button down
x y mask
5770 (conf
, leftx
, _, hooverpageno
, anchor) =
5773 let rec loop = function
5776 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5777 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5779 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5785 | _ -> viewmouse button down
x y mask
5791 method key key mask
=
5792 begin match state
.mode with
5793 | Textentry
textentry -> textentrykeyboard key mask
textentry
5794 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5795 | View
-> viewkeyboard key mask
5796 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5800 method button button bstate
x y mask
=
5801 begin match state
.mode with
5803 | View
-> viewmouse button bstate
x y mask
5804 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5809 method multiclick clicks
x y mask
=
5810 begin match state
.mode with
5812 | View
-> viewmulticlick clicks
x y mask
5819 begin match state
.mode with
5821 | View
| Birdseye
_ | LinkNav
_ ->
5822 match state
.mstate
with
5823 | Mzoom
_ | Mnone
-> ()
5828 state
.mstate
<- Mpan
(x, y);
5830 then state
.x <- panbound (state
.x + dx);
5832 gotoy_and_clear_text y
5835 state
.mstate
<- Msel
(a, (x, y));
5836 G.postRedisplay "motion select";
5839 let y = min state
.winh
(max
0 y) in
5843 let x = min state
.winw (max
0 x) in
5846 | Mzoomrect
(p0
, _) ->
5847 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5848 G.postRedisplay "motion zoomrect";
5852 method pmotion
x y =
5853 begin match state
.mode with
5854 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5855 let rec loop = function
5857 if hooverpageno
!= -1
5859 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5860 G.postRedisplay "pmotion birdseye no hoover";
5863 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5864 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5866 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
5867 G.postRedisplay "pmotion birdseye hoover";
5877 match state
.mstate
with
5878 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
5887 let past, _, _ = !r in
5889 let delta = now -. past in
5892 else r := (now, x, y)
5896 method infochanged
_ = ()
5899 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
5902 then 0.0, float state
.winh
5903 else scrollph state
.y maxy
5908 let winw = wadjsb state
.winw in
5909 let fwinw = float winw in
5911 let sw = fwinw /. float state
.w in
5912 let sw = fwinw *. sw in
5913 max
sw (float conf
.scrollh
)
5916 let maxx = state
.w + winw in
5917 let x = winw - state
.x in
5918 let percent = float x /. float maxx in
5919 (fwinw -. sw) *. percent
5921 hscrollh (), position, sw
5925 match state
.mode with
5926 | LinkNav
_ -> "links"
5927 | Textentry
_ -> "textentry"
5928 | Birdseye
_ -> "birdseye"
5931 findkeyhash conf
modename
5933 method eformsgs
= true
5936 let adderrmsg src msg
=
5937 Buffer.add_string state
.errmsgs msg
;
5938 state
.newerrmsgs
<- true;
5942 let adderrfmt src fmt
=
5943 Format.kprintf
(fun s -> adderrmsg src s) fmt
;
5947 let cl = splitatspace cmds
in
5949 try Scanf.sscanf
s fmt
f
5951 adderrfmt "remote exec"
5952 "error processing '%S': %s\n" cmds
(exntos exn
)
5955 | "reload" :: [] -> reload ()
5956 | "goto" :: args
:: [] ->
5957 scan args
"%u %f %f"
5959 let cmd, _ = state
.geomcmds
in
5961 then gotopagexy pageno x y
5964 gotopagexy pageno x y;
5967 state
.reprf
<- f state
.reprf
5969 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
5970 | "gotor" :: args
:: [] ->
5972 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
5973 | "gotord" :: args
:: [] ->
5975 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
5976 | "rect" :: args
:: [] ->
5977 scan args
"%u %u %f %f %f %f"
5978 (fun pageno color x0 y0 x1 y1 ->
5979 onpagerect pageno (fun w h ->
5980 let _,w1,h1
,_ = getpagedim
pageno in
5981 let sw = float w1 /. float w
5982 and sh = float h1
/. float h in
5986 and y1s
= y1 *. sh in
5987 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
5989 state
.rects <- (pageno, color, rect) :: state
.rects;
5990 G.postRedisplay "rect";
5993 | "activatewin" :: [] -> Wsi.activatewin
()
5994 | "quit" :: [] -> raise Quit
5996 adderrfmt "remote command"
5997 "error processing remote command: %S\n" cmds
;
6001 let scratch = String.create
80 in
6002 let buf = Buffer.create
80 in
6005 try Some
(Unix.read fd
scratch 0 80)
6007 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6008 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6011 match tempfr () with
6017 if Buffer.length
buf > 0
6019 let s = Buffer.contents
buf in
6029 let pos = String.index_from
scratch ppos '
\n'
in
6030 if pos >= n then -1 else pos
6031 with Not_found
-> -1
6035 Buffer.add_substring
buf scratch ppos
(nlpos-ppos
);
6036 let s = Buffer.contents
buf in
6042 Buffer.add_substring
buf scratch ppos
(n-ppos
);
6048 let remoteopen path =
6049 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6051 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6056 let trimcachepath = ref E.s in
6057 let rcmdpath = ref E.s in
6058 let pageno = ref None
in
6059 selfexec := Sys.executable_name
;
6062 [("-p", Arg.String
(fun s -> state
.password
<- s),
6063 "<password> Set password");
6067 Config.fontpath
:= s;
6068 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6070 "<path> Set path to the user interface font");
6074 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6075 Config.confpath
:= s),
6076 "<path> Set path to the configuration file");
6078 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6079 "<page-number> Jump to page");
6081 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6082 "<path> Set path to the trim cache file");
6084 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6085 "<named-destination> Set named destination");
6087 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6088 ("-cxack", Arg.Set
cxack, " Cut corners");
6090 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6091 "<path> Set path to the remote commands source");
6093 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6094 "<original-path> Set original path");
6096 ("-v", Arg.Unit
(fun () ->
6098 "%s\nconfiguration path: %s\n"
6102 exit
0), " Print version and exit");
6105 (fun s -> state
.path <- s)
6106 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6109 then selfexec := !selfexec ^
" -wtmode";
6111 let histmode = emptystr state
.path in
6113 if not
(Config.load ())
6114 then prerr_endline
"failed to load configuration";
6115 begin match !pageno with
6116 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6120 let wsfd, winw, winh
= Wsi.init
(object (self)
6121 val mutable m_hack
= false
6122 val mutable m_clicks
= 0
6123 val mutable m_click_x
= 0
6124 val mutable m_click_y
= 0
6125 val mutable m_lastclicktime
= infinity
6127 method private cleanup
=
6128 state
.roam
<- noroam
;
6129 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
6130 method expose
= if not m_hack
then G.postRedisplay "expose"
6131 method visible
= G.postRedisplay "visible"
6132 method display = m_hack
<- false; display ()
6133 method reshape w h =
6135 m_hack
<- w < state
.winw && h < state
.winh
;
6137 method mouse
b d x y m =
6138 if d && canselect ()
6140 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6146 if abs
x - m_click_x
> 10
6147 || abs
y - m_click_y
> 10
6148 || abs_float
(t -. m_lastclicktime
) > 0.3
6150 m_clicks
<- m_clicks
+ 1;
6151 m_lastclicktime
<- t;
6155 G.postRedisplay "cleanup";
6156 state
.uioh <- state
.uioh#button
b d x y m;
6158 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6163 m_lastclicktime
<- infinity
;
6164 state
.uioh <- state
.uioh#button
b d x y m
6168 state
.uioh <- state
.uioh#button
b d x y m
6171 state
.mpos
<- (x, y);
6172 state
.uioh <- state
.uioh#motion
x y
6173 method pmotion
x y =
6174 state
.mpos
<- (x, y);
6175 state
.uioh <- state
.uioh#pmotion
x y
6177 let mascm = m land (
6178 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6181 let x = state
.x and y = state
.y in
6183 if x != state
.x || y != state
.y then self#cleanup
6185 match state
.keystate
with
6187 let km = k
, mascm in
6190 let modehash = state
.uioh#
modehash in
6191 try Hashtbl.find modehash km
6193 try Hashtbl.find (findkeyhash conf
"global") km
6194 with Not_found
-> KMinsrt
(k
, m)
6196 | KMinsrt
(k
, m) -> keyboard k
m
6197 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6198 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6200 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6201 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6202 state
.keystate
<- KSnone
6203 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6204 state
.keystate
<- KSinto
(keys
, insrt
)
6206 state
.keystate
<- KSnone
6209 state
.mpos
<- (x, y);
6210 state
.uioh <- state
.uioh#pmotion
x y
6211 method leave = state
.mpos
<- (-1, -1)
6212 method winstate wsl
= state
.winstate
<- wsl
; m_hack
<- false
6213 method quit
= raise Quit
6214 end) conf
.cwinw conf
.cwinh
(platform
= Posx
) in
6219 List.exists
GlMisc.check_extension
6220 [ "GL_ARB_texture_rectangle"
6221 ; "GL_EXT_texture_recangle"
6222 ; "GL_NV_texture_rectangle" ]
6224 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6227 let r = GlMisc.get_string `renderer
in
6228 let p = "Mesa DRI Intel(" in
6229 let l = String.length
p in
6230 String.length
r > l && String.sub
r 0 l = p
6233 defconf
.sliceheight
<- 1024;
6234 defconf
.texcount
<- 32;
6235 defconf
.usepbo
<- true;
6239 match Ne.res Unix.pipe
with
6241 Printf.eprintf
"pipe/crsw failed: %s" (exntos exn
);
6245 match Ne.res Unix.pipe
with
6247 Printf.eprintf
"pipe/srcw failed: %s" (exntos exn
);
6257 setcheckers conf
.checkers
;
6259 if conf
.redirectstderr
6262 let s = Buffer.contents state
.errmsgs ^
6263 (match state
.errfd
with
6265 let s = String.create
(80*24) in
6268 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6270 then Unix.read fd
s 0 (String.length
s)
6276 else String.sub
s 0 n
6280 try ignore
(Unix.write state
.stderr
s 0 (String.length
s))
6281 with exn
-> print_endline
(exntos exn
)
6286 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6287 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6288 !Config.fontpath
, !trimcachepath,
6289 GlMisc.check_extension
"GL_ARB_pixel_buffer_object"
6291 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6301 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6302 opendoc state
.path state
.password
;
6307 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6310 if nonemptystr
!rcmdpath
6311 then remoteopen !rcmdpath
6316 let rec loop deadline
=
6318 match state
.errfd
with
6319 | None
-> [state
.sr
; state
.wsfd]
6320 | Some fd
-> [state
.sr
; state
.wsfd; fd
]
6325 | Some fd
-> fd
:: r
6329 state
.redisplay
<- false;
6336 if deadline
= infinity
6338 else max
0.0 (deadline
-. now)
6343 try Unix.select
r [] [] timeout
6344 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6350 if state
.ghyll
== noghyll
6352 match state
.autoscroll
with
6353 | Some step
when step
!= 0 ->
6354 let y = state
.y + step
in
6358 else if y >= state
.maxy then 0 else y
6361 if state
.mode = View
6362 then state
.text <- E.s;
6365 else deadline
+. 0.01
6370 let rec checkfds = function
6372 | fd
:: rest
when fd
= state
.sr
->
6373 let cmd = readcmd state
.sr
in
6377 | fd
:: rest
when fd
= state
.wsfd ->
6381 | fd
:: rest
when Some fd
= !optrfd ->
6382 begin match remote fd
with
6383 | None
-> optrfd := remoteopen !rcmdpath;
6384 | opt -> optrfd := opt
6389 let s = String.create
80 in
6390 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6391 if conf
.redirectstderr
6393 Buffer.add_substring state
.errmsgs
s 0 n;
6394 state
.newerrmsgs
<- true;
6395 state
.redisplay
<- true;
6398 prerr_string
(String.sub
s 0 n);
6404 if !reeenterhist then (
6406 reeenterhist := false;
6410 if deadline
= infinity
6414 match state
.autoscroll
with
6415 | Some step
when step
!= 0 -> deadline1
6416 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6424 Config.save
leavebirdseye;