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 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))
5331 let postdrawpage l linkindexbase
=
5332 match getopaque l.pageno with
5334 if tileready l l.pagex
l.pagey
5336 let x = l.pagedispx - l.pagex
+ xadjsb 0
5337 and y = l.pagedispy - l.pagey in
5339 match conf
.columns
with
5340 | Csingle
_ | Cmulti
_ ->
5341 (if conf
.hlinks
then 1 else 0)
5343 && not
(isbirdseye state
.mode) then 2 else 0)
5347 match state
.mode with
5348 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5351 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5356 let scrollindicator () =
5357 let sbw, ph
, sh = state
.uioh#
scrollph in
5358 let sbh, pw, sw = state
.uioh#scrollpw
in
5363 else (state
.winw
- sbw), state
.winw
5366 GlDraw.color (0.64, 0.64, 0.64);
5367 filledrect (float x0) 0. (float x1) (float state
.winh
);
5369 0. (float (state
.winh
- sbh))
5370 (float (wadjsb state
.winw
- 1)) (float state
.winh
)
5372 GlDraw.color (0.0, 0.0, 0.0);
5374 filledrect (float x0) ph
(float x1) (ph
+. sh);
5375 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5379 match state
.mstate
with
5380 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5383 | Msel
((x0, y0), (x1, y1)) ->
5384 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5385 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5386 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5387 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5390 let showrects = function [] -> () | rects
->
5392 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5393 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5395 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5397 if l.pageno = pageno
5399 let dx = float (l.pagedispx - l.pagex
) in
5400 let dy = float (l.pagedispy - l.pagey) in
5401 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5402 Raw.sets_float state
.vraw ~
pos:0
5407 GlArray.vertex `two state
.vraw
;
5408 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5417 GlClear.color (scalecolor2 conf
.bgcolor
);
5418 GlClear.clear
[`
color];
5419 List.iter
drawpage state
.layout;
5421 match state
.mode with
5422 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5423 begin match getopaque pageno with
5425 let dx = xadjsb 0 in
5426 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5427 let x0 = x0 + dx and x1 = x1 + dx in
5434 | None
-> state
.rects
5439 let rec postloop linkindexbase
= function
5441 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5442 postloop linkindexbase rest
5446 postloop 0 state
.layout;
5448 begin match state
.mstate
with
5449 | Mzoomrect
((x0, y0), (x1, y1)) ->
5451 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5452 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5453 filledrect (float x0) (float y0) (float x1) (float y1);
5462 let zoomrect x y x1 y1 =
5465 and y0 = min
y y1 in
5466 gotoy (state
.y + y0);
5467 state
.anchor <- getanchor
();
5468 let zoom = (float state
.w) /. float (x1 - x0) in
5470 match conf
.fitmodel
, conf
.columns
with
5471 | FitPage
, Csplit
_ ->
5472 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5475 let adjw = wadjsb state
.winw
in
5477 then (adjw - state
.w) / 2
5480 state
.x <- (state
.x + margin) - x0;
5486 let g opaque l px py =
5487 match rectofblock
opaque px py with
5489 let x0 = a.(0) -. 20. in
5490 let x1 = a.(1) +. 20. in
5491 let y0 = a.(2) -. 20. in
5492 let zoom = (float state
.w) /. (x1 -. x0) in
5493 let pagey = getpagey
l.pageno in
5494 gotoy_and_clear_text (pagey + truncate
y0);
5495 state
.anchor <- getanchor
();
5496 let margin = (state
.w - l.pagew
)/2 in
5497 state
.x <- -truncate
x0 - margin;
5502 match conf
.columns
with
5504 showtext '
!'
"block zooming does not work properly in split columns mode"
5505 | _ -> onppundermouse g x y ()
5509 let winw = wadjsb state
.winw - 1 in
5510 let s = float x /. float winw in
5511 let destx = truncate
(float (state
.w + winw) *. s) in
5512 state
.x <- winw - destx;
5513 gotoy_and_clear_text state
.y;
5514 state
.mstate
<- Mscrollx
;
5518 let s = float y /. float state
.winh
in
5519 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5520 gotoy_and_clear_text desty;
5521 state
.mstate
<- Mscrolly
;
5524 let viewmulticlick clicks
x y mask
=
5525 let g opaque l px py =
5533 if markunder
opaque px py mark
5537 match getopaque l.pageno with
5539 | Some
opaque -> pipesel opaque cmd
5541 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5542 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5547 G.postRedisplay "viewmulticlick";
5548 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5552 match conf
.columns
with
5554 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5557 let viewmouse button down
x y mask
=
5559 | n when (n == 4 || n == 5) && not down
->
5560 if Wsi.withctrl mask
5562 match state
.mstate
with
5563 | Mzoom
(oldn
, i
) ->
5571 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5573 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5575 let zoom = conf
.zoom -. incr in
5577 state
.mstate
<- Mzoom
(n, 0);
5579 state
.mstate
<- Mzoom
(n, i
+1);
5581 else state
.mstate
<- Mzoom
(n, 0)
5583 | _ -> state
.mstate
<- Mzoom
(n, 0)
5586 match state
.autoscroll
with
5587 | Some step
-> setautoscrollspeed step
(n=4)
5589 if conf
.wheelbypage
|| conf
.presentation
5598 then -conf
.scrollstep
5599 else conf
.scrollstep
5601 let incr = incr * 2 in
5602 let y = clamp incr in
5603 gotoy_and_clear_text y
5606 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5608 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5609 gotoy_and_clear_text state
.y
5611 | 1 when Wsi.withshift mask
->
5612 state
.mstate
<- Mnone
;
5615 match unproject x y with
5616 | Some
(pageno, ux
, uy
) ->
5617 let cmd = Printf.sprintf
5619 conf
.stcmd state
.path pageno ux uy
5625 | 1 when Wsi.withctrl mask
->
5628 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5629 state
.mstate
<- Mpan
(x, y)
5632 state
.mstate
<- Mnone
5637 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5639 state
.mstate
<- Mzoomrect
(p, p)
5642 match state
.mstate
with
5643 | Mzoomrect
((x0, y0), _) ->
5644 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5645 then zoomrect x0 y0 x y
5648 G.postRedisplay "kill accidental zoom rect";
5654 | 1 when x > state
.winw - vscrollw () ->
5657 let _, position, sh = state
.uioh#
scrollph in
5658 if y > truncate
position && y < truncate
(position +. sh)
5659 then state
.mstate
<- Mscrolly
5662 state
.mstate
<- Mnone
5664 | 1 when y > state
.winh
- hscrollh () ->
5667 let _, position, sw = state
.uioh#scrollpw
in
5668 if x > truncate
position && x < truncate
(position +. sw)
5669 then state
.mstate
<- Mscrollx
5672 state
.mstate
<- Mnone
5674 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5677 let dest = if down
then getunder x y else Unone
in
5678 begin match dest with
5681 | Uremote
_ | Uremotedest
_
5682 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5685 | Unone
when down
->
5686 Wsi.setcursor
Wsi.CURSOR_CROSSHAIR
;
5687 state
.mstate
<- Mpan
(x, y);
5689 | Unone
| Utext
_ ->
5694 state
.mstate
<- Msel
((x, y), (x, y));
5695 G.postRedisplay "mouse select";
5699 match state
.mstate
with
5702 | Mzoom
_ | Mscrollx
| Mscrolly
->
5703 state
.mstate
<- Mnone
5705 | Mzoomrect
((x0, y0), _) ->
5709 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5710 state
.mstate
<- Mnone
5712 | Msel
((x0, y0), (x1, y1)) ->
5713 let rec loop = function
5717 let a0 = l.pagedispy in
5718 let a1 = a0 + l.pagevh in
5719 let b0 = l.pagedispx in
5720 let b1 = b0 + l.pagevw in
5721 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5722 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5726 match getopaque l.pageno with
5729 match Ne.res Unix.pipe
with
5733 "can not create sel pipe: %s"
5737 Ne.clo fd
(fun msg
->
5738 dolog
"%s close failed: %s" what msg
)
5741 try popen
cmd [r, 0; w, -1]; true
5743 dolog
"can not execute %S: %s"
5750 G.postRedisplay "copysel";
5752 else clo "Msel pipe/w" w;
5753 clo "Msel pipe/r" r;
5755 dosel conf
.selcmd
();
5756 state
.roam
<- dosel conf
.paxcmd
;
5768 let birdseyemouse button down
x y mask
5769 (conf
, leftx
, _, hooverpageno
, anchor) =
5772 let rec loop = function
5775 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5776 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5778 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
5784 | _ -> viewmouse button down
x y mask
5790 method key key mask
=
5791 begin match state
.mode with
5792 | Textentry
textentry -> textentrykeyboard key mask
textentry
5793 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
5794 | View
-> viewkeyboard key mask
5795 | LinkNav
linknav -> linknavkeyboard key mask
linknav
5799 method button button bstate
x y mask
=
5800 begin match state
.mode with
5802 | View
-> viewmouse button bstate
x y mask
5803 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
5808 method multiclick clicks
x y mask
=
5809 begin match state
.mode with
5811 | View
-> viewmulticlick clicks
x y mask
5818 begin match state
.mode with
5820 | View
| Birdseye
_ | LinkNav
_ ->
5821 match state
.mstate
with
5822 | Mzoom
_ | Mnone
-> ()
5827 state
.mstate
<- Mpan
(x, y);
5829 then state
.x <- panbound (state
.x + dx);
5831 gotoy_and_clear_text y
5834 state
.mstate
<- Msel
(a, (x, y));
5835 G.postRedisplay "motion select";
5838 let y = min state
.winh
(max
0 y) in
5842 let x = min state
.winw (max
0 x) in
5845 | Mzoomrect
(p0
, _) ->
5846 state
.mstate
<- Mzoomrect
(p0
, (x, y));
5847 G.postRedisplay "motion zoomrect";
5851 method pmotion
x y =
5852 begin match state
.mode with
5853 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
5854 let rec loop = function
5856 if hooverpageno
!= -1
5858 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
5859 G.postRedisplay "pmotion birdseye no hoover";
5862 if y > l.pagedispy && y < l.pagedispy + l.pagevh
5863 && x > l.pagedispx && x < l.pagedispx + l.pagevw
5865 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
5866 G.postRedisplay "pmotion birdseye hoover";
5876 match state
.mstate
with
5877 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
5886 let past, _, _ = !r in
5888 let delta = now -. past in
5891 else r := (now, x, y)
5895 method infochanged
_ = ()
5898 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
5901 then 0.0, float state
.winh
5902 else scrollph state
.y maxy
5907 let winw = wadjsb state
.winw in
5908 let fwinw = float winw in
5910 let sw = fwinw /. float state
.w in
5911 let sw = fwinw *. sw in
5912 max
sw (float conf
.scrollh
)
5915 let maxx = state
.w + winw in
5916 let x = winw - state
.x in
5917 let percent = float x /. float maxx in
5918 (fwinw -. sw) *. percent
5920 hscrollh (), position, sw
5924 match state
.mode with
5925 | LinkNav
_ -> "links"
5926 | Textentry
_ -> "textentry"
5927 | Birdseye
_ -> "birdseye"
5930 findkeyhash conf
modename
5932 method eformsgs
= true
5935 let adderrmsg src msg
=
5936 Buffer.add_string state
.errmsgs msg
;
5937 state
.newerrmsgs
<- true;
5941 let adderrfmt src fmt
=
5942 Format.kprintf
(fun s -> adderrmsg src s) fmt
;
5946 let cl = splitatspace cmds
in
5948 try Scanf.sscanf
s fmt
f
5950 adderrfmt "remote exec"
5951 "error processing '%S': %s\n" cmds
(exntos exn
)
5954 | "reload" :: [] -> reload ()
5955 | "goto" :: args
:: [] ->
5956 scan args
"%u %f %f"
5958 let cmd, _ = state
.geomcmds
in
5960 then gotopagexy pageno x y
5963 gotopagexy pageno x y;
5966 state
.reprf
<- f state
.reprf
5968 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
5969 | "gotor" :: args
:: [] ->
5971 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
5972 | "gotord" :: args
:: [] ->
5974 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
5975 | "rect" :: args
:: [] ->
5976 scan args
"%u %u %f %f %f %f"
5977 (fun pageno color x0 y0 x1 y1 ->
5978 onpagerect pageno (fun w h ->
5979 let _,w1,h1
,_ = getpagedim
pageno in
5980 let sw = float w1 /. float w
5981 and sh = float h1
/. float h in
5985 and y1s
= y1 *. sh in
5986 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
5988 state
.rects <- (pageno, color, rect) :: state
.rects;
5989 G.postRedisplay "rect";
5992 | "activatewin" :: [] -> Wsi.activatewin
()
5993 | "quit" :: [] -> raise Quit
5995 adderrfmt "remote command"
5996 "error processing remote command: %S\n" cmds
;
6000 let scratch = String.create
80 in
6001 let buf = Buffer.create
80 in
6004 try Some
(Unix.read fd
scratch 0 80)
6006 | Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6007 | Unix.Unix_error
(Unix.EINTR
, _, _) -> tempfr ()
6010 match tempfr () with
6016 if Buffer.length
buf > 0
6018 let s = Buffer.contents
buf in
6028 let pos = String.index_from
scratch ppos '
\n'
in
6029 if pos >= n then -1 else pos
6030 with Not_found
-> -1
6034 Buffer.add_substring
buf scratch ppos
(nlpos-ppos
);
6035 let s = Buffer.contents
buf in
6041 Buffer.add_substring
buf scratch ppos
(n-ppos
);
6047 let remoteopen path =
6048 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6050 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6055 let trimcachepath = ref E.s in
6056 let rcmdpath = ref E.s in
6057 let pageno = ref None
in
6058 selfexec := Sys.executable_name
;
6061 [("-p", Arg.String
(fun s -> state
.password
<- s),
6062 "<password> Set password");
6066 Config.fontpath
:= s;
6067 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6069 "<path> Set path to the user interface font");
6073 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6074 Config.confpath
:= s),
6075 "<path> Set path to the configuration file");
6077 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6078 "<page-number> Jump to page");
6080 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6081 "<path> Set path to the trim cache file");
6083 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6084 "<named-destination> Set named destination");
6086 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6087 ("-cxack", Arg.Set
cxack, " Cut corners");
6089 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6090 "<path> Set path to the remote commands source");
6092 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6093 "<original-path> Set original path");
6095 ("-v", Arg.Unit
(fun () ->
6097 "%s\nconfiguration path: %s\n"
6101 exit
0), " Print version and exit");
6104 (fun s -> state
.path <- s)
6105 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6108 then selfexec := !selfexec ^
" -wtmode";
6110 let histmode = emptystr state
.path in
6112 if not
(Config.load ())
6113 then prerr_endline
"failed to load configuration";
6114 begin match !pageno with
6115 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6119 let wsfd, winw, winh
= Wsi.init
(object (self)
6120 val mutable m_hack
= false
6121 val mutable m_clicks
= 0
6122 val mutable m_click_x
= 0
6123 val mutable m_click_y
= 0
6124 val mutable m_lastclicktime
= infinity
6126 method private cleanup
=
6127 state
.roam
<- noroam
;
6128 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
6129 method expose
= if not m_hack
then G.postRedisplay "expose"
6130 method visible
= G.postRedisplay "visible"
6131 method display = m_hack
<- false; display ()
6132 method reshape w h =
6134 m_hack
<- w < state
.winw && h < state
.winh
;
6136 method mouse
b d x y m =
6137 if d && canselect ()
6139 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6145 if abs
x - m_click_x
> 10
6146 || abs
y - m_click_y
> 10
6147 || abs_float
(t -. m_lastclicktime
) > 0.3
6149 m_clicks
<- m_clicks
+ 1;
6150 m_lastclicktime
<- t;
6154 G.postRedisplay "cleanup";
6155 state
.uioh <- state
.uioh#button
b d x y m;
6157 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6162 m_lastclicktime
<- infinity
;
6163 state
.uioh <- state
.uioh#button
b d x y m
6167 state
.uioh <- state
.uioh#button
b d x y m
6170 state
.mpos
<- (x, y);
6171 state
.uioh <- state
.uioh#motion
x y
6172 method pmotion
x y =
6173 state
.mpos
<- (x, y);
6174 state
.uioh <- state
.uioh#pmotion
x y
6176 let mascm = m land (
6177 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6180 let x = state
.x and y = state
.y in
6182 if x != state
.x || y != state
.y then self#cleanup
6184 match state
.keystate
with
6186 let km = k
, mascm in
6189 let modehash = state
.uioh#
modehash in
6190 try Hashtbl.find modehash km
6192 try Hashtbl.find (findkeyhash conf
"global") km
6193 with Not_found
-> KMinsrt
(k
, m)
6195 | KMinsrt
(k
, m) -> keyboard k
m
6196 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6197 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6199 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6200 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6201 state
.keystate
<- KSnone
6202 | KSinto
((k'
, m'
) :: keys
, insrt
) when k'
=k
&& m'
land mascm = m'
->
6203 state
.keystate
<- KSinto
(keys
, insrt
)
6205 state
.keystate
<- KSnone
6208 state
.mpos
<- (x, y);
6209 state
.uioh <- state
.uioh#pmotion
x y
6210 method leave = state
.mpos
<- (-1, -1)
6211 method winstate wsl
= state
.winstate
<- wsl
; m_hack
<- false
6212 method quit
= raise Quit
6213 end) conf
.cwinw conf
.cwinh
(platform
= Posx
) in
6218 List.exists
GlMisc.check_extension
6219 [ "GL_ARB_texture_rectangle"
6220 ; "GL_EXT_texture_recangle"
6221 ; "GL_NV_texture_rectangle" ]
6223 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
6226 let r = GlMisc.get_string `renderer
in
6227 let p = "Mesa DRI Intel(" in
6228 let l = String.length
p in
6229 String.length
r > l && String.sub
r 0 l = p
6232 defconf
.sliceheight
<- 1024;
6233 defconf
.texcount
<- 32;
6234 defconf
.usepbo
<- true;
6238 match Ne.res Unix.pipe
with
6240 Printf.eprintf
"pipe/crsw failed: %s" (exntos exn
);
6244 match Ne.res Unix.pipe
with
6246 Printf.eprintf
"pipe/srcw failed: %s" (exntos exn
);
6256 setcheckers conf
.checkers
;
6258 if conf
.redirectstderr
6261 let s = Buffer.contents state
.errmsgs ^
6262 (match state
.errfd
with
6264 let s = String.create
(80*24) in
6267 let r, _, _ = Unix.select
[fd
] [] [] 0.0 in
6269 then Unix.read fd
s 0 (String.length
s)
6275 else String.sub
s 0 n
6279 try ignore
(Unix.write state
.stderr
s 0 (String.length
s))
6280 with exn
-> print_endline
(exntos exn
)
6285 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6286 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6287 !Config.fontpath
, !trimcachepath,
6288 GlMisc.check_extension
"GL_ARB_pixel_buffer_object"
6290 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6300 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6301 opendoc state
.path state
.password
;
6306 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6309 if nonemptystr
!rcmdpath
6310 then remoteopen !rcmdpath
6315 let rec loop deadline
=
6317 match state
.errfd
with
6318 | None
-> [state
.sr
; state
.wsfd]
6319 | Some fd
-> [state
.sr
; state
.wsfd; fd
]
6324 | Some fd
-> fd
:: r
6328 state
.redisplay
<- false;
6335 if deadline
= infinity
6337 else max
0.0 (deadline
-. now)
6342 try Unix.select
r [] [] timeout
6343 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6349 if state
.ghyll
== noghyll
6351 match state
.autoscroll
with
6352 | Some step
when step
!= 0 ->
6353 let y = state
.y + step
in
6357 else if y >= state
.maxy then 0 else y
6360 if state
.mode = View
6361 then state
.text <- E.s;
6364 else deadline
+. 0.01
6369 let rec checkfds = function
6371 | fd
:: rest
when fd
= state
.sr
->
6372 let cmd = readcmd state
.sr
in
6376 | fd
:: rest
when fd
= state
.wsfd ->
6380 | fd
:: rest
when Some fd
= !optrfd ->
6381 begin match remote fd
with
6382 | None
-> optrfd := remoteopen !rcmdpath;
6383 | opt -> optrfd := opt
6388 let s = String.create
80 in
6389 let n = tempfailureretry
(Unix.read fd
s 0) 80 in
6390 if conf
.redirectstderr
6392 Buffer.add_substring state
.errmsgs
s 0 n;
6393 state
.newerrmsgs
<- true;
6394 state
.redisplay
<- true;
6397 prerr_string
(String.sub
s 0 n);
6403 if !reeenterhist then (
6405 reeenterhist := false;
6409 if deadline
= infinity
6413 match state
.autoscroll
with
6414 | Some step
when step
!= 0 -> deadline1
6415 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6423 Config.save
leavebirdseye;