6 external init
: Unix.file_descr
-> initparams
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external getmaxw
: unit -> float = "ml_getmaxw";;
16 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
17 external measurestr
: int -> string -> float = "ml_measure_string";;
18 external postprocess
:
19 opaque
-> int -> int -> int -> (int * string * int) -> int
21 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
22 external setaalevel
: int -> unit = "ml_setaalevel";;
23 external realloctexts
: int -> bool = "ml_realloctexts";;
24 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
25 external getlink
: opaque
-> int -> under
= "ml_getlink";;
26 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
27 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
28 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
29 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
30 external freepbo
: opaque
-> unit = "ml_freepbo";;
31 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
32 external bousable
: unit -> bool = "ml_bo_usable";;
33 external unproject
: opaque
-> int -> int -> (int * int) option
35 external project
: opaque
-> int -> int -> float -> float -> (float * float)
37 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
38 external rectofblock
: opaque
-> int -> int -> float array
option
40 external begintiles
: unit -> unit = "ml_begintiles";;
41 external endtiles
: unit -> unit = "ml_endtiles";;
42 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
43 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
44 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
45 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
46 external savedoc
: string -> unit = "ml_savedoc";;
47 external getannotcontents
: opaque
-> slinkindex
-> string
48 = "ml_getannotcontents";;
49 external drawprect
: opaque
-> int -> int -> float array
-> unit
51 external wcmd
: Unix.file_descr
-> bytes
-> int -> unit = "ml_wcmd";;
52 external rcmd
: Unix.file_descr
-> string = "ml_rcmd";;
53 external uritolocation
: string -> (pageno
* float * float)
54 = "ml_uritolocation";;
55 external isexternallink
: string -> bool = "ml_isexternallink";;
57 let selfexec = ref E.s
;;
58 let opengl_has_pbo = ref false;;
60 let drawstring size x y s
=
62 Gl.enable `texture_2d
;
63 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
64 ignore
(drawstr size x y s
);
66 Gl.disable `texture_2d
;
69 let drawstring1 size x y s
=
73 let drawstring2 size x y fmt
=
74 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
89 l
.pagedispx l
.pagedispy
93 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
99 }|} x0 y0 x1 y1 x2 y2 x3 y3
;
102 let isbirdseye = function
104 | Textentry _
| View
| LinkNav _
-> false
107 let istextentry = function
108 | Textentry _
-> true
109 | Birdseye _
| View
| LinkNav _
-> false
112 let wtmode = ref false;;
113 let cxack = ref false;;
115 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
118 if state
.uioh#alwaysscrolly
|| ((conf
.scrollb
land scrollbhv
!= 0)
119 && (state
.w
> state
.winw
))
125 if state
.uioh#alwaysscrolly
|| ((conf
.scrollb
land scrollbvv
!= 0)
126 && (state
.maxy
> state
.winh
))
134 else x
> state
.winw
- vscrollw ()
138 fstate
.fontsize
<- n
;
139 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
140 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
146 else Printf.kprintf ignore fmt
150 if emptystr conf
.pathlauncher
151 then dolog
"%s" state
.path
153 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
154 match spawn
command [] with
157 dolog
"failed to execute `%s': %s" command @@ exntos exn
163 let postRedisplay who
=
164 vlog "redisplay for [%S]" who
;
165 state
.redisplay
<- true;
169 let getopaque pageno
=
170 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
171 with Not_found
-> None
174 let pagetranslatepoint l x y
=
175 let dy = y
- l
.pagedispy
in
176 let y = dy + l
.pagey
in
177 let dx = x
- l
.pagedispx
in
178 let x = dx + l
.pagex
in
182 let onppundermouse g
x y d
=
185 begin match getopaque l
.pageno
with
187 let x0 = l
.pagedispx
in
188 let x1 = x0 + l
.pagevw
in
189 let y0 = l
.pagedispy
in
190 let y1 = y0 + l
.pagevh
in
191 if y >= y0 && y <= y1 && x >= x0 && x <= x1
193 let px, py
= pagetranslatepoint l
x y in
194 match g opaque l
px py
with
207 let g opaque l
px py
=
210 match rectofblock opaque
px py
with
211 | Some
[|x0;x1;y0;y1|] ->
212 let rect = (x0, y0, x1, y0, x1, y1, x0, y1) in
213 let color = (0.0, 0.0, 1.0 /. (l
.pageno
mod 3 |> float), 0.5) in
214 state
.rects
<- [l
.pageno
, color, rect];
215 G.postRedisplay "getunder";
218 let under = whatsunder opaque
px py
in
219 if under = Unone
then None
else Some
under
221 onppundermouse g x y Unone
226 match unproject opaque
x y with
227 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
230 onppundermouse g x y None
;
234 state
.text
<- Printf.sprintf
"%c%s" c s
;
235 G.postRedisplay "showtext";
239 Format.ksprintf
(fun s
-> showtext '
!' s
) fmt
;
242 let pipesel opaque cmd
=
245 match Unix.pipe
() with
246 | (exception exn
) -> dolog
"pipesel cannot create pipe: %S" @@ exntos exn
;
248 let doclose what fd
=
249 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
252 try spawn cmd
[r
, 0; w
, -1]
254 dolog
"cannot execute %S: %s" cmd
@@ exntos exn
;
260 G.postRedisplay "pipesel";
262 else doclose "pipesel pipe/w" w
;
263 doclose "pipesel pipe/r" r
;
267 let g opaque l
px py
=
268 if markunder opaque
px py conf
.paxmark
271 match getopaque l
.pageno
with
273 | Some opaque
-> pipesel opaque conf
.paxcmd
278 G.postRedisplay "paxunder";
279 if conf
.paxmark
= Mark_page
282 match getopaque l
.pageno
with
284 | Some opaque
-> clearmark opaque
) state
.layout
;
285 state
.roam
<- onppundermouse g x y (fun () -> impmsg "whoopsie daisy");
289 match Unix.pipe
() with
290 | (exception exn
) -> impmsg "pipe failed: %s" @@ exntos exn
293 Ne.clo fd
(fun msg
-> impmsg "failed to close %s: %s" cap msg
)
296 try spawn conf
.selcmd
[r
, 0; w
, -1]
298 impmsg "failed to execute %s: %s" conf
.selcmd
@@ exntos exn
;
304 let l = String.length s
in
305 let bytes = Bytes.unsafe_of_string s
in
306 let n = tempfailureretry
(Unix.write w
bytes 0) l in
308 then impmsg "failed to write %d characters to sel pipe, wrote %d"
311 impmsg "failed to write to sel pipe: %s" @@ exntos exn
314 clo "selstring pipe/r" r
;
315 clo "selstring pipe/w" w
;
318 let undertext = function
321 | Utext s
-> "font: " ^ s
322 | Uannotation
(opaque
, slinkindex
) ->
323 "annotation: " ^ getannotcontents opaque slinkindex
326 let updateunder x y =
327 match getunder x y with
328 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
330 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
331 Wsi.setcursor
Wsi.CURSOR_INFO
333 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
334 Wsi.setcursor
Wsi.CURSOR_TEXT
336 if conf
.underinfo
then showtext 'a'
"nnotation";
337 Wsi.setcursor
Wsi.CURSOR_INFO
340 let showlinktype under =
341 if conf
.underinfo
&& under != Unone
342 then showtext ' '
@@ undertext under
345 let intentry_with_suffix text key
=
347 if key
>= 32 && key
< 127
349 let c = Char.chr key
in
354 | 'k'
| 'm'
| '
g'
| 'K'
| 'M'
| 'G'
->
355 addchar
text @@ asciilower
c
357 state
.text <- Printf.sprintf
"invalid key (%d, `%c')" key
c;
360 state
.text <- Printf.sprintf
"invalid key %d" key
;
368 let b = Buffer.create
16 in
371 let b = Buffer.to_bytes
b in
372 wcmd state
.ss
b @@ Bytes.length
b
376 let nogeomcmds cmds
=
378 | s
, [] -> emptystr s
382 let layoutN ((columns
, coverA
, coverB
), b) x y sw sh
=
383 let rec fold accu
n =
384 if n = Array.length
b
387 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
390 || n = state
.pagecount
- coverB
391 || (n - coverA
) mod columns
= columns
- 1)
397 let pagey = max
0 (y - vy
) in
398 let pagedispy = if pagey > 0 then 0 else vy
- y in
399 let pagedispx, pagex
=
401 if n = coverA
- 1 || n = state
.pagecount
- coverB
402 then x + (sw
- w
) / 2
410 let vw = sw
- pagedispx in
411 let pw = w
- pagex
in
414 let pagevh = min
(h
- pagey) (sh
- pagedispy) in
415 if pagevw > 0 && pagevh > 0
426 ; pagedispx = pagedispx
427 ; pagedispy = pagedispy
439 if Array.length
b = 0
441 else List.rev
(fold [] (page_of_y
y))
444 let layoutS (columns
, b) x y sw sh
=
445 let rec fold accu n =
446 if n = Array.length
b
449 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
457 let pagey = max
0 (y - vy
) in
458 let pagedispy = if pagey > 0 then 0 else vy
- y in
459 let pagedispx, pagex
=
473 let pagecolw = pagew
/columns
in
476 then pagedispx + ((sw
- pagecolw) / 2)
480 let vw = sw
- pagedispx in
481 let pw = pagew
- pagex
in
484 let pagevw = min
pagevw pagecolw in
485 let pagevh = min
(pageh
- pagey) (sh
- pagedispy) in
486 if pagevw > 0 && pagevh > 0
497 ; pagedispx = pagedispx
498 ; pagedispy = pagedispy
499 ; pagecol
= n mod columns
513 let layout x y sw sh
=
514 if nogeomcmds state
.geomcmds
516 match conf
.columns
with
517 | Csingle
b -> layoutN ((1, 0, 0), b) x y sw sh
518 | Cmulti
c -> layoutN c x y sw sh
519 | Csplit s
-> layoutS s
x y sw sh
524 let y = state
.y + incr
in
526 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
531 let tilex = l.pagex
mod conf
.tilew
in
532 let tiley = l.pagey mod conf
.tileh
in
534 let col = l.pagex
/ conf
.tilew
in
535 let row = l.pagey / conf
.tileh
in
537 let rec rowloop row y0 dispy h
=
541 let dh = conf
.tileh
- y0 in
543 let rec colloop col x0 dispx w
=
547 let dw = conf
.tilew
- x0 in
549 f col row dispx dispy
x0 y0 dw dh;
550 colloop (col+1) 0 (dispx
+dw) (w
-dw)
553 colloop col tilex l.pagedispx l.pagevw;
554 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
557 if l.pagevw > 0 && l.pagevh > 0
558 then rowloop row tiley l.pagedispy l.pagevh;
561 let gettileopaque l col row =
563 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
565 try Some
(Hashtbl.find state
.tilemap
key)
566 with Not_found
-> None
569 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
570 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
571 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
574 let filledrect2 x0 y0 x1 y1 x2 y2 x3 y3
=
575 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x1; y1; x2
; y2
; x3
; y3
|];
576 GlArray.vertex `two state
.vraw
;
577 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
580 let filledrect1 x0 y0 x1 y1 = filledrect2 x0 y0 x0 y1 x1 y0 x1 y1;;
582 let filledrect x0 y0 x1 y1 =
583 GlArray.disable `texture_coord
;
584 filledrect1 x0 y0 x1 y1;
585 GlArray.enable `texture_coord
;
588 let linerect x0 y0 x1 y1 =
589 GlArray.disable `texture_coord
;
590 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
591 GlArray.vertex `two state
.vraw
;
592 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
593 GlArray.enable `texture_coord
;
596 let drawtiles l color =
599 let f col row x y tilex tiley w h
=
600 match gettileopaque l col row with
601 | Some
(opaque
, _
, t
) ->
602 let params = x, y, w
, h
, tilex, tiley in
604 then GlTex.env
(`mode `blend
);
605 drawtile
params opaque
;
607 then GlTex.env
(`mode `modulate
);
611 let s = Printf.sprintf
615 let w = measurestr fstate
.fontsize
s in
616 GlDraw.color (0.0, 0.0, 0.0);
617 filledrect (float (x-2))
620 (float (y + fstate
.fontsize
+ 2));
622 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
629 let lw = state
.winw
- x in
632 let lh = state
.winh
- y in
636 then GlTex.env
(`mode `blend
);
637 begin match state
.checkerstexid
with
639 Gl.enable `texture_2d
;
640 GlTex.bind_texture ~target
:`texture_2d id
;
644 and y1 = float (y+h
) in
646 let tw = float w /. 16.0
647 and th
= float h
/. 16.0 in
648 let tx0 = float tilex /. 16.0
649 and ty0
= float tiley /. 16.0 in
651 and ty1
= ty0
+. th
in
652 Raw.sets_float state
.vraw ~pos
:0
653 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
654 Raw.sets_float state
.traw ~pos
:0
655 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
656 GlArray.vertex `two state
.vraw
;
657 GlArray.tex_coord `two state
.traw
;
658 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
659 Gl.disable `texture_2d
;
662 GlDraw.color (1.0, 1.0, 1.0);
663 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
666 then GlTex.env
(`mode `modulate
);
667 if w > 128 && h
> fstate
.fontsize
+ 10
669 let c = if conf
.invert
then 1.0 else 0.0 in
670 GlDraw.color (c, c, c);
673 then (col*conf
.tilew
, row*conf
.tileh
)
676 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
685 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
687 let tilevisible1 l x y =
689 and ax1
= l.pagex
+ l.pagevw
691 and ay1
= l.pagey + l.pagevh in
695 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
696 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
698 let rx0 = max
ax0 bx0
699 and ry0
= max ay0 by0
700 and rx1
= min ax1
bx1
701 and ry1
= min ay1 by1
in
703 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
707 let tilevisible layout n x y =
708 let rec findpageinlayout m
= function
709 | l :: rest
when l.pageno
= n ->
710 tilevisible1 l x y || (
711 match conf
.columns
with
712 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
717 | _
:: rest
-> findpageinlayout 0 rest
720 findpageinlayout 0 layout;
723 let tileready l x y =
724 tilevisible1 l x y &&
725 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
728 let tilepage n p
layout =
729 let rec loop = function
733 let f col row _ _ _ _ _ _
=
734 if state
.currently
= Idle
736 match gettileopaque l col row with
739 let x = col*conf
.tilew
740 and y = row*conf
.tileh
in
742 let w = l.pagew
- x in
746 let h = l.pageh
- y in
751 then getpbo
w h conf
.colorspace
754 wcmd "tile %s %d %d %d %d %s"
755 (~
> p
) x y w h (~
> pbo);
758 l, p
, conf
.colorspace
, conf
.angle
,
759 state
.gen
, col, row, conf
.tilew
, conf
.tileh
768 if nogeomcmds state
.geomcmds
772 let preloadlayout x y sw sh
=
773 let y = if y < sh
then 0 else y - sh
in
774 let x = min
0 (x + sw
) in
782 if state
.currently
!= Idle
787 begin match getopaque l.pageno
with
789 wcmd "page %d %d" l.pageno
l.pagedimno
;
790 state
.currently
<- Loading
(l, state
.gen
);
792 tilepage l.pageno opaque pages
;
797 if nogeomcmds state
.geomcmds
803 if conf
.preload && state
.currently
= Idle
804 then load (preloadlayout state
.x state
.y state
.winw state
.winh
);
807 let layoutready layout =
808 let rec fold all ls
=
811 let seen = ref false in
812 let allvisible = ref true in
813 let foo col row _ _ _ _ _ _
=
815 allvisible := !allvisible &&
816 begin match gettileopaque l col row with
822 fold (!seen && !allvisible) rest
825 let alltilesvisible = fold true layout in
830 let y = bound
y 0 state
.maxy
in
831 let y, layout, proceed
=
832 match conf
.maxwait
with
833 | Some time
when state
.ghyll
== noghyll
->
834 begin match state
.throttle
with
836 let layout = layout x y state
.winw state
.winh
in
837 let ready = layoutready layout in
841 state
.throttle
<- Some
(layout, y, now
());
843 else G.postRedisplay "gotoxy showall (None)";
845 | Some
(_
, _
, started
) ->
846 let dt = now
() -. started
in
849 state
.throttle
<- None
;
850 let layout = layout x y state
.winw state
.winh
in
852 G.postRedisplay "maxwait";
859 let layout = layout x y state
.winw state
.winh
in
860 if not
!wtmode || layoutready layout
861 then G.postRedisplay "gotoxy ready";
868 state
.layout <- layout;
869 begin match state
.mode
with
872 | Ltexact
(pageno
, linkno
) ->
873 let rec loop = function
875 state
.lnava
<- Some
(pageno
, linkno
);
876 state
.mode
<- LinkNav
(Ltgendir
0)
877 | l :: _
when l.pageno
= pageno
->
878 begin match getopaque pageno
with
879 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
881 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
882 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
883 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
884 then state
.mode
<- LinkNav
(Ltgendir
0)
886 | _
:: rest
-> loop rest
889 | Ltnotready _
| Ltgendir _
-> ()
895 begin match state
.mode
with
896 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
897 if not
(pagevisible layout pageno
)
899 match state
.layout with
902 state
.mode
<- Birdseye
(
903 conf
, leftx
, l.pageno
, hooverpageno
, anchor
908 | Ltnotready
(_
, dir
)
911 let rec loop = function
914 match getopaque l.pageno
with
915 | None
-> Ltnotready
(l.pageno
, dir
)
920 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
922 if dir
> 0 then LDfirst
else LDlast
928 | Lnotfound
-> loop rest
930 showlinktype (getlink opaque
n);
931 Ltexact
(l.pageno
, n)
935 state
.mode
<- LinkNav
linknav
943 state
.ghyll
<- noghyll
;
946 let mx, my
= state
.mpos
in
951 let conttiling pageno opaque
=
952 tilepage pageno opaque
954 then preloadlayout state
.x state
.y state
.winw state
.winh
958 let gotoxy_and_clear_text x y =
959 if not conf
.verbose
then state
.text <- E.s;
963 let getanchory (n, top
, dtop
) =
964 let y, h = getpageyh
n in
967 let ips = calcips
h in
968 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
970 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
973 let gotoanchor anchor
=
974 gotoxy state
.x (getanchory anchor
);
978 cbput state
.hists
.nav
(getanchor
());
982 let anchor = cbgetc state
.hists
.nav dir
in
986 let gotoghyll1 single
y =
988 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
990 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
992 then s (float f /. float a
)
995 then 1.0 -. s ((float (f-b) /. float (n-b)))
1001 let ins = float a
*. 0.5
1002 and outs
= float (n-b) *. 0.5 in
1004 ins +. outs
+. float ones
1006 let rec set nab
y sy
=
1007 let (_N
, _A
, _B
), y =
1010 let scl = if y > sy
then 2 else -2 in
1011 let _N, _
, _
= nab
in
1012 (_N,0,_N), y+conf
.scrollstep
*scl
1014 let sum = summa
_N _A _B
in
1015 let dy = float (y - sy
) in
1019 then state
.ghyll
<- noghyll
1022 let s = scroll n _N _A _B
in
1023 let y1 = y1 +. ((s *. dy) /. sum) in
1024 gotoxy_and_clear_text state
.x (truncate
y1);
1025 state
.ghyll
<- gf (n+1) y1;
1029 | Some
y'
when single
-> set nab
y' state
.y
1030 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1032 gf 0 (float state
.y)
1035 match conf
.ghyllscroll
with
1036 | Some nab
when not conf
.presentation
->
1037 if state
.ghyll
== noghyll
1038 then set nab
y state
.y
1039 else state
.ghyll
(Some
y)
1041 gotoxy_and_clear_text state
.x y
1044 let gotoghyll = gotoghyll1 false;;
1046 let gotopage n top
=
1047 let y, h = getpageyh
n in
1048 let y = y + (truncate
(top
*. float h)) in
1052 let gotopage1 n top
=
1053 let y = getpagey
n in
1058 let invalidate s f =
1059 state
.redisplay
<- false;
1064 match state
.geomcmds
with
1065 | ps
, [] when emptystr ps
->
1067 state
.geomcmds
<- s, [];
1070 state
.geomcmds
<- ps
, [s, f];
1072 | ps
, (s'
, _
) :: rest
when s'
= s ->
1073 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1076 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1080 Hashtbl.iter
(fun _ opaque
->
1081 wcmd "freepage %s" (~
> opaque
);
1083 Hashtbl.clear state
.pagemap
;
1087 if not
(Queue.is_empty state
.tilelru
)
1089 Queue.iter
(fun (k
, p
, s) ->
1090 wcmd "freetile %s" (~
> p
);
1091 state
.memused
<- state
.memused
- s;
1092 Hashtbl.remove state
.tilemap k
;
1094 state
.uioh#infochanged Memused
;
1095 Queue.clear state
.tilelru
;
1101 let h = truncate
(float h*.conf
.zoom
) in
1102 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1106 let opendoc path password
=
1108 state
.password
<- password
;
1109 state
.gen
<- state
.gen
+ 1;
1110 state
.docinfo
<- [];
1111 state
.outlines
<- [||];
1114 setaalevel conf
.aalevel
;
1116 if emptystr state
.origin
1120 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1121 wcmd "open %d %d %d %s\000%s\000%s\000"
1122 (btod
!wtmode) (btod
!cxack) (btod conf
.usedoccss
)
1123 path password conf
.css
;
1124 invalidate "reqlayout"
1126 wcmd "reqlayout %d %d %d %s\000"
1127 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1128 (stateh state
.winh
) state
.nameddest
1131 let sl = keystostrlist conf
in
1133 function | [] -> accu
1134 | s :: rest
-> loop ((s, 0, Noaction
) :: accu) rest
1135 in makehelp
() @ (("", 0, Noaction
) :: loop [] sl) |> Array.of_list
1139 state
.anchor <- getanchor
();
1140 opendoc state
.path state
.password
;
1144 let c = c *. conf
.colorscale
in
1148 let scalecolor2 (r
, g, b) =
1149 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1152 let docolumns columns
=
1155 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1156 let rec loop pageno
pdimno pdim
y ph pdims
=
1157 if pageno
= state
.pagecount
1160 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1162 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1163 pdimno+1, pdim
, rest
1167 let x = max
0 (((state
.winw
- w) / 2) - xoff
) in
1169 y + (if conf
.presentation
1170 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1171 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1174 a.(pageno
) <- (pdimno, x, y, pdim
);
1175 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1177 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1178 conf
.columns
<- Csingle
a;
1180 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1181 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1182 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1184 if m
= pageno
then () else
1185 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1188 let y = y + (rowh
- h) / 2 in
1189 a.(m
) <- (pdimno, x, y, pdim
);
1193 if pageno
= state
.pagecount
1194 then fixrow (((pageno
- 1) / columns
) * columns
)
1196 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1198 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1199 pdimno+1, pdim
, rest
1204 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1206 let x = (state
.winw
- w) / 2 in
1208 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1209 x, y + ips + rowh
, h
1212 if (pageno
- coverA
) mod columns
= 0
1214 let x = max
0 (state
.winw
- state
.w) / 2 in
1216 if conf
.presentation
1218 let ips = calcips
h in
1219 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1221 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1225 else x, y, max rowh
h
1229 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1232 if pageno
= columns
&& conf
.presentation
1234 let ips = calcips rowh
in
1235 for i
= 0 to pred columns
1237 let (pdimno, x, y, pdim
) = a.(i
) in
1238 a.(i
) <- (pdimno, x, y+ips, pdim
)
1244 fixrow (pageno
- columns
);
1249 a.(pageno
) <- (pdimno, x, y, pdim
);
1250 let x = x + w + xoff
*2 + conf
.interpagespace
in
1251 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1253 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1254 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1257 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1258 let rec loop pageno
pdimno pdim
y pdims
=
1259 if pageno
= state
.pagecount
1262 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1264 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1265 pdimno+1, pdim
, rest
1270 let rec loop1 n x y =
1271 if n = c then y else (
1272 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1273 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1276 let y = loop1 0 0 y in
1277 loop (pageno
+1) pdimno pdim
y pdims
1279 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1280 conf
.columns
<- Csplit
(c, a);
1284 docolumns conf
.columns
;
1285 state
.maxy
<- calcheight
();
1286 if state
.reprf
== noreprf
1288 match state
.mode
with
1289 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1290 let y, h = getpageyh pageno
in
1291 let top = (state
.winh
- h) / 2 in
1292 gotoxy state
.x (max
0 (y - top))
1296 let y = getanchory state
.anchor in
1297 let y = min
y (state
.maxy
- state
.winh
) in
1302 state
.reprf
<- noreprf
;
1306 let reshape ?
(firsttime
=false) w h =
1307 GlDraw.viewport ~
x:0 ~
y:0 ~
w ~
h;
1308 if not firsttime
&& nogeomcmds state
.geomcmds
1309 then state
.anchor <- getanchor
();
1312 let w = truncate
(float w *. conf
.zoom
) in
1315 setfontsize fstate
.fontsize
;
1316 GlMat.mode `modelview
;
1317 GlMat.load_identity
();
1319 GlMat.mode `projection
;
1320 GlMat.load_identity
();
1321 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1322 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1323 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1328 else float state
.x /. float state
.w
1330 invalidate "geometry"
1334 then state
.x <- truncate
(relx *. float w);
1336 match conf
.columns
with
1338 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1339 | Csplit
(c, _
) -> w * c
1341 wcmd "geometry %d %d %d"
1342 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1347 let len = String.length state
.text in
1348 let x0 = if conf
.leftscroll
then vscrollw () else 0 in
1351 match state
.mode
with
1352 | Textentry _
| View
| LinkNav _
->
1353 let h, _
, _
= state
.uioh#scrollpw
in
1358 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1359 (x+.w) (float (state
.winh
- hscrollh))
1362 let w = float (state
.winw
- 1 - vscrollw ()) in
1363 if state
.progress
>= 0.0 && state
.progress
< 1.0
1365 GlDraw.color (0.3, 0.3, 0.3);
1366 let w1 = w *. state
.progress
in
1368 GlDraw.color (0.0, 0.0, 0.0);
1369 rect (float x0+.w1) (float x0+.w-.w1)
1372 GlDraw.color (0.0, 0.0, 0.0);
1376 GlDraw.color (1.0, 1.0, 1.0);
1379 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1380 (state
.winh
- hscrollh - 5) s;
1383 match state
.mode
with
1384 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1388 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1390 Printf.sprintf
"%s%s_" prefix
text
1396 | LinkNav _
-> state
.text
1401 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1403 let s1 = "(press 'e' to review error messasges)" in
1404 if nonemptystr
s then s ^
" " ^
s1 else s1
1414 let len = Queue.length state
.tilelru
in
1416 match state
.throttle
with
1419 then preloadlayout state
.x state
.y state
.winw state
.winh
1421 | Some
(layout, _
, _
) ->
1425 if state
.memused
<= conf
.memlimit
1430 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1431 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1432 let (_
, pw, ph
, _
) = getpagedim
n in
1434 && colorspace
= conf
.colorspace
1435 && angle
= conf
.angle
1439 let x = col*conf
.tilew
1440 and y = row*conf
.tileh
in
1441 tilevisible (Lazy.force_val
layout) n x y
1443 then Queue.push lruitem state
.tilelru
1446 wcmd "freetile %s" (~
> p
);
1447 state
.memused
<- state
.memused
- s;
1448 state
.uioh#infochanged Memused
;
1449 Hashtbl.remove state
.tilemap k
;
1457 let onpagerect pageno
f =
1459 match conf
.columns
with
1460 | Cmulti
(_
, b) -> b
1462 | Csplit
(_
, b) -> b
1464 if pageno
>= 0 && pageno
< Array.length
b
1466 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1470 let gotopagexy1 wtmode pageno
x y =
1471 let _,w1,h1
,leftx
= getpagedim pageno
in
1472 let top = y /. (float h1
) in
1473 let left = x /. (float w1) in
1474 let py, w, h = getpageywh pageno
in
1475 let wh = state
.winh
in
1476 let x = left *. (float w) in
1477 let x = leftx
+ state
.x + truncate
x in
1479 if x < 0 || x >= state
.winw
1483 let pdy = truncate
(top *. float h) in
1484 let y'
= py + pdy in
1485 let dy = y'
- state
.y in
1487 if x != state
.x || not
(dy > 0 && dy < wh)
1489 if conf
.presentation
1491 if abs
(py - y'
) > wh
1498 if state
.x != sx || state
.y != sy
1503 let ww = state
.winw
in
1505 and qy
= pdy / wh in
1507 and y = py + qy
* wh in
1508 let x = if -x + ww > w1 then -(w1-ww) else x
1509 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1511 if conf
.presentation
1513 if abs
(py - y'
) > wh
1522 gotoxy_and_clear_text x y;
1524 else gotoxy_and_clear_text state
.x state
.y;
1527 let gotopagexy wtmode pageno
x y =
1528 match state
.mode
with
1529 | Birdseye
_ -> gotopage pageno
0.0
1532 | LinkNav
_ -> gotopagexy1 wtmode pageno
x y
1535 let getpassword () =
1536 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1541 impmsg "error getting password: %s" s;
1542 dolog
"%s" s) passcmd;
1545 let pgoto opaque pageno
x y =
1546 let pdimno = getpdimno pageno
in
1547 let x, y = project opaque pageno
pdimno x y in
1548 gotopagexy false pageno
x y;
1552 (* dolog "%S" cmds; *)
1553 let spl = splitatchar cmds ' '
in
1555 try Scanf.sscanf
s fmt
f
1557 dolog
"error processing '%S': %s" cmds
@@ exntos exn
;
1560 let addoutline outline
=
1561 match state
.currently
with
1562 | Outlining outlines
->
1563 state
.currently
<- Outlining
(outline
:: outlines
)
1564 | Idle
-> state
.currently
<- Outlining
[outline
]
1567 dolog
"invalid outlining state";
1568 logcurrently state
.currently
1573 state
.uioh#infochanged Pdim
;
1575 | "clearrects", "" ->
1576 state
.rects
<- state
.rects1
;
1577 G.postRedisplay "clearrects";
1579 | "continue", args
->
1580 let n = scan args
"%u" (fun n -> n) in
1581 state
.pagecount
<- n;
1582 begin match state
.currently
with
1584 state
.currently
<- Idle
;
1585 state
.outlines
<- Array.of_list
(List.rev
l)
1591 let cur, cmds
= state
.geomcmds
in
1593 then failwith
"umpossible";
1595 begin match List.rev cmds
with
1597 state
.geomcmds
<- E.s, [];
1598 state
.throttle
<- None
;
1602 state
.geomcmds
<- s, List.rev rest
;
1604 if conf
.maxwait
= None
&& not
!wtmode
1605 then G.postRedisplay "continue";
1612 then showtext ' ' args
1615 Buffer.add_string state
.errmsgs args
;
1616 state
.newerrmsgs
<- true;
1617 G.postRedisplay "error message"
1619 | "progress", args
->
1620 let progress, text =
1623 f, String.sub args pos
(String.length args
- pos
))
1626 state
.progress <- progress;
1627 G.postRedisplay "progress"
1629 | "firstmatch", args
->
1630 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1631 scan args
"%u %d %f %f %f %f %f %f %f %f"
1632 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1633 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1635 let y = (getpagey
pageno) + truncate
y0 in
1643 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1644 state
.rects1
<- [pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1647 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1648 scan args
"%u %d %f %f %f %f %f %f %f %f"
1649 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1650 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1652 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
1654 (pageno, color, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1657 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1658 let pageopaque = ~
< pageopaques in
1659 begin match state
.currently
with
1660 | Loading
(l, gen
) ->
1661 vlog "page %d took %f sec" l.pageno t
;
1662 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1663 begin match state
.throttle
with
1665 let preloadedpages =
1667 then preloadlayout state
.x state
.y state
.winw state
.winh
1672 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1673 IntSet.empty
preloadedpages
1676 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1677 if not
(IntSet.mem
pageno set)
1679 wcmd "freepage %s" (~
> opaque
);
1685 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1688 state
.currently
<- Idle
;
1691 tilepage l.pageno pageopaque state
.layout;
1693 load preloadedpages;
1694 let visible = pagevisible state
.layout l.pageno in
1697 match state
.mode
with
1698 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1699 if pageno = l.pageno
1704 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1706 if dir
> 0 then LDfirst
else LDlast
1709 findlink
pageopaque ld
1714 showlinktype (getlink
pageopaque n);
1715 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1717 | LinkNav
(Ltgendir
_)
1718 | LinkNav
(Ltexact
_)
1724 if visible && layoutready state
.layout
1726 G.postRedisplay "page";
1730 | Some
(layout, _, _) ->
1731 state
.currently
<- Idle
;
1732 tilepage l.pageno pageopaque layout;
1739 dolog
"Inconsistent loading state";
1740 logcurrently state
.currently
;
1745 let (x, y, opaques
, size
, t
) =
1746 scan args
"%u %u %s %u %f"
1747 (fun x y p size t
-> (x, y, p
, size
, t
))
1749 let opaque = ~
< opaques
in
1750 begin match state
.currently
with
1751 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1752 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1755 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1757 wcmd "freetile %s" (~
> opaque);
1758 state
.currently
<- Idle
;
1762 puttileopaque l col row gen cs angle
opaque size t
;
1763 state
.memused
<- state
.memused
+ size
;
1764 state
.uioh#infochanged Memused
;
1766 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1767 opaque, size
) state
.tilelru
;
1770 match state
.throttle
with
1771 | None
-> state
.layout
1772 | Some
(layout, _, _) -> layout
1775 state
.currently
<- Idle
;
1777 && conf
.colorspace
= cs
1778 && conf
.angle
= angle
1779 && tilevisible layout l.pageno x y
1780 then conttiling l.pageno pageopaque;
1782 begin match state
.throttle
with
1784 preload state
.layout;
1786 && conf
.colorspace
= cs
1787 && conf
.angle
= angle
1788 && tilevisible state
.layout l.pageno x y
1789 && (not
!wtmode || layoutready state
.layout)
1790 then G.postRedisplay "tile nothrottle";
1792 | Some
(layout, y, _) ->
1793 let ready = layoutready layout in
1797 state
.layout <- layout;
1798 state
.throttle
<- None
;
1799 G.postRedisplay "throttle";
1808 dolog
"Inconsistent tiling state";
1809 logcurrently state
.currently
;
1814 let (n, w, h, _) as pdim
=
1815 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1818 match conf
.fitmodel
with
1820 | FitPage
| FitProportional
->
1821 match conf
.columns
with
1822 | Csplit
_ -> (n, w, h, 0)
1823 | Csingle
_ | Cmulti
_ -> pdim
1825 state
.pdims
<- pdim :: state
.pdims
;
1826 state
.uioh#infochanged Pdim
1829 let (l, n, t
, h, pos
) =
1830 scan args
"%u %u %d %u %n"
1831 (fun l n t
h pos
-> l, n, t
, h, pos
)
1833 let s = String.sub args pos
(String.length args
- pos
) in
1834 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1837 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1838 let s = String.sub args pos
len in
1839 let pos2 = pos
+ len + 1 in
1840 let uri = String.sub args
pos2 (String.length args
- pos2) in
1841 addoutline (s, l, Ouri
uri)
1844 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1845 let s = String.sub args pos
(String.length args
- pos
) in
1846 addoutline (s, l, Onone
)
1850 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1852 state
.reprf
<- (fun () -> gotopagexy !wtmode n (float l) (float t
))
1855 let pos = nindex args '
\t'
in
1859 if substratis args
0 "Title"
1861 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1866 if substratis args
0 "CreationDate"
1868 if String.length args
>= pos + 7
1869 && args
.[pos+1] = 'D'
&& args
.[pos+2] = '
:'
1871 let b = Buffer.create
18 in
1872 Buffer.add_string
b "CreationDate\t";
1875 Buffer.add_substring
b args
(pos+p
+1) l;
1876 Buffer.add_char
b c;
1877 with exn
-> Buffer.add_string
b @@ exntos exn
1885 Buffer.add_char
b '
['
;
1886 Buffer.add_substring
b args
(pos+1)
1887 (String.length args
- pos - 1);
1888 Buffer.add_char
b '
]'
;
1895 state
.docinfo
<- (1, s) :: state
.docinfo
1898 state
.docinfo
<- List.rev state
.docinfo
;
1899 state
.uioh#infochanged Docinfo
1903 then Wsi.settitle
"Wrong password";
1904 let password = getpassword () in
1905 if emptystr
password
1906 then error
"document is password protected"
1907 else opendoc state
.path
password
1910 error
"unknown cmd `%S'" cmds
1915 let action = function
1916 | HCprev
-> cbget cb ~
-1
1917 | HCnext
-> cbget cb
1
1918 | HCfirst
-> cbget cb ~
-(cb
.rc)
1919 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1920 and cancel
() = cb
.rc <- rc
1924 let search pattern forward
=
1925 match conf
.columns
with
1926 | Csplit
_ -> impmsg "searching does not work properly in split columns mode"
1929 if nonemptystr pattern
1932 match state
.layout with
1935 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1937 wcmd "search %d %d %d %d,%s\000"
1938 (btod conf
.icase
) pn py (btod forward
) pattern
;
1941 let intentry text key =
1943 if key >= 32 && key < 127
1945 let c = Char.chr
key in
1947 | '
0'
.. '
9'
-> addchar
text c
1949 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1952 state
.text <- Printf.sprintf
"invalid key (%d)" key;
1963 let l = String.length
s in
1964 let rec loop pos n =
1968 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1969 loop (pos+1) (n*26 + m)
1972 let rec loop n = function
1975 match getopaque l.pageno with
1976 | None
-> loop n rest
1978 let m = getlinkcount
opaque in
1981 let under = getlink
opaque n in
1984 else loop (n-m) rest
1986 loop n state
.layout;
1990 let linknentry text key =
1991 if key >= 32 && key < 127
1993 let text = addchar
text (Char.chr
key) in
1994 linknact (fun under -> state
.text <- undertext under) text;
1997 state
.text <- Printf.sprintf
"invalid key %d" key;
2002 let textentry text key =
2003 if Wsi.isspecialkey
key
2005 else TEcont
(text ^ toutf8
key)
2008 let reqlayout angle fitmodel
=
2009 match state
.throttle
with
2011 if nogeomcmds state
.geomcmds
2012 then state
.anchor <- getanchor
();
2013 conf
.angle
<- angle
mod 360;
2016 match state
.mode
with
2017 | LinkNav
_ -> state
.mode
<- View
2022 conf
.fitmodel
<- fitmodel
;
2026 wcmd "reqlayout %d %d %d"
2027 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2032 let settrim trimmargins trimfuzz
=
2033 if nogeomcmds state
.geomcmds
2034 then state
.anchor <- getanchor
();
2035 conf
.trimmargins
<- trimmargins
;
2036 conf
.trimfuzz
<- trimfuzz
;
2037 let x0, y0, x1, y1 = trimfuzz
in
2039 "settrim" (fun () ->
2040 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2045 match state
.throttle
with
2047 let zoom = max
0.0001 zoom in
2048 if zoom <> conf
.zoom
2050 state
.prevzoom
<- (conf
.zoom, state
.x);
2052 reshape state
.winw state
.winh
;
2053 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2056 | Some
(layout, y, started
) ->
2058 match conf
.maxwait
with
2062 let dt = now
() -. started
in
2070 let pivotzoom ?
(vw=min state
.w state
.winw
)
2071 ?
(vh
=min
(state
.maxy
-state
.y) state
.winh
)
2072 ?
(x=vw/2) ?
(y=vh
/2) zoom =
2073 let w = float state
.w /. zoom in
2074 let hw = w /. 2.0 in
2075 let ratio = float vh
/. float vw in
2076 let hh = hw *. ratio in
2077 let x0 = if zoom < 1.0 then 0.0 else float x -. hw in
2078 let y0 = float y -. hh in
2079 gotoxy (state
.x - truncate
x0) (state
.y + truncate
y0);
2083 let pivotzoom ?
vw ?vh ?
x ?
y zoom =
2084 if nogeomcmds state
.geomcmds
then pivotzoom ?
vw ?vh ?
x ?
y zoom
2087 let setcolumns mode columns coverA coverB
=
2088 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2092 then impmsg "split mode doesn't work in bird's eye"
2094 conf
.columns
<- Csplit
(-columns
, E.a);
2102 conf
.columns
<- Csingle
E.a;
2107 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2111 reshape state
.winw state
.winh
;
2114 let resetmstate () =
2115 state
.mstate
<- Mnone
;
2116 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2119 let enterbirdseye () =
2120 let zoom = float conf
.thumbw
/. float state
.winw
in
2121 let birdseyepageno =
2122 let cy = state
.winh
/ 2 in
2126 let rec fold best
= function
2129 let d = cy - (l.pagedispy + l.pagevh/2)
2130 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2131 if abs
d < abs dbest
2140 { conf
with zoom = conf
.zoom },
2141 state
.x, birdseyepageno, -1, getanchor
()
2145 conf
.presentation
<- false;
2146 conf
.interpagespace
<- 10;
2147 conf
.hlinks
<- false;
2148 conf
.fitmodel
<- FitPage
;
2150 conf
.maxwait
<- None
;
2152 match conf
.beyecolumns
with
2155 Cmulti
((c, 0, 0), E.a)
2156 | None
-> Csingle
E.a
2160 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2165 reshape state
.winw state
.winh
;
2168 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2170 conf
.zoom <- c.zoom;
2171 conf
.presentation
<- c.presentation
;
2172 conf
.interpagespace
<- c.interpagespace
;
2173 conf
.maxwait
<- c.maxwait
;
2174 conf
.hlinks
<- c.hlinks
;
2175 conf
.fitmodel
<- c.fitmodel
;
2176 conf
.beyecolumns
<- (
2177 match conf
.columns
with
2178 | Cmulti
((c, _, _), _) -> Some
c
2180 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2183 match c.columns
with
2184 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2185 | Csingle
_ -> Csingle
E.a
2186 | Csplit
(c, _) -> Csplit
(c, E.a)
2190 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2193 reshape state
.winw state
.winh
;
2194 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2198 let togglebirdseye () =
2199 match state
.mode
with
2200 | Birdseye vals
-> leavebirdseye vals
true
2201 | View
-> enterbirdseye ()
2202 | Textentry
_ | LinkNav
_ -> ()
2205 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2206 let pageno = max
0 (pageno - incr
) in
2207 let rec loop = function
2208 | [] -> gotopage1 pageno 0
2209 | l :: _ when l.pageno = pageno ->
2210 if l.pagedispy >= 0 && l.pagey = 0
2211 then G.postRedisplay "upbirdseye"
2212 else gotopage1 pageno 0
2213 | _ :: rest
-> loop rest
2217 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2220 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2221 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2222 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2223 let rec loop = function
2225 let y, h = getpageyh
pageno in
2226 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2227 gotoxy state
.x (clamp dy)
2228 | l :: _ when l.pageno = pageno ->
2229 if l.pagevh != l.pageh
2230 then gotoxy state
.x (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2231 else G.postRedisplay "downbirdseye"
2232 | _ :: rest
-> loop rest
2238 let optentry mode
_ key =
2239 let btos b = if b then "on" else "off" in
2240 if key >= 32 && key < 127
2242 let c = Char.chr
key in
2246 try conf
.scrollstep
<- int_of_string
s with exn
->
2247 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2249 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2254 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2255 if state
.autoscroll
<> None
2256 then state
.autoscroll
<- Some conf
.autoscrollstep
2258 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2260 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2265 let n, a, b = multicolumns_of_string
s in
2266 setcolumns mode
n a b;
2268 state
.text <- Printf.sprintf
"bad columns `%s': %s" s @@ exntos exn
2270 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2275 let zoom = float (int_of_string
s) /. 100.0 in
2278 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2280 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2285 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2287 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2288 begin match mode
with
2290 leavebirdseye beye
false;
2297 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2299 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2303 match int_of_string
s with
2304 | angle
-> reqlayout angle conf
.fitmodel
2307 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2309 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2312 conf
.icase
<- not conf
.icase
;
2313 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2316 conf
.preload <- not conf
.preload;
2317 gotoxy state
.x state
.y;
2318 TEdone
("preload " ^
(btos conf
.preload))
2321 conf
.verbose
<- not conf
.verbose
;
2322 TEdone
("verbose " ^
(btos conf
.verbose
))
2325 conf
.debug
<- not conf
.debug
;
2326 TEdone
("debug " ^
(btos conf
.debug
))
2329 conf
.maxhfit
<- not conf
.maxhfit
;
2330 state
.maxy
<- calcheight
();
2331 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2334 conf
.crophack
<- not conf
.crophack
;
2335 TEdone
("crophack " ^
btos conf
.crophack
)
2339 match conf
.maxwait
with
2341 conf
.maxwait
<- Some infinity
;
2342 "always wait for page to complete"
2344 conf
.maxwait
<- None
;
2345 "show placeholder if page is not ready"
2350 conf
.underinfo
<- not conf
.underinfo
;
2351 TEdone
("underinfo " ^
btos conf
.underinfo
)
2354 conf
.savebmarks
<- not conf
.savebmarks
;
2355 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2361 match state
.layout with
2366 conf
.interpagespace
<- int_of_string
s;
2367 docolumns conf
.columns
;
2368 state
.maxy
<- calcheight
();
2369 let y = getpagey
pageno in
2370 gotoxy state
.x (y + py)
2373 Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
2375 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2379 match conf
.fitmodel
with
2380 | FitProportional
-> FitWidth
2381 | FitWidth
| FitPage
-> FitProportional
2383 reqlayout conf
.angle
fm;
2384 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2387 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2388 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2391 conf
.invert
<- not conf
.invert
;
2392 TEdone
("invert colors " ^
btos conf
.invert
)
2396 cbput state
.hists
.sel
s;
2399 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2400 textentry, ondone, true)
2404 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2405 else conf
.pax
<- None
;
2406 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2409 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2415 class type lvsource
=
2417 method getitemcount
: int
2418 method getitem
: int -> (string * int)
2419 method hasaction
: int -> bool
2427 method getactive
: int
2428 method getfirst
: int
2430 method getminfo
: (int * int) array
2433 class virtual lvsourcebase
= object
2434 val mutable m_active
= 0
2435 val mutable m_first
= 0
2436 val mutable m_pan
= 0
2437 method getactive
= m_active
2438 method getfirst
= m_first
2439 method getpan
= m_pan
2440 method getminfo
: (int * int) array
= E.a
2443 let textentrykeyboard
2444 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2446 let key = Wsi.keypadtodigitkey
key in
2448 state
.mode
<- Textentry
(te
, onleave
);
2450 G.postRedisplay "textentrykeyboard enttext";
2452 let histaction cmd
=
2455 | Some
(action, _) ->
2458 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2460 G.postRedisplay "textentry histaction"
2464 if emptystr
text && cancelonempty
2467 G.postRedisplay "textentrykeyboard after cancel";
2470 let s = withoutlastutf8
text in
2471 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2473 | @enter
| @kpenter
->
2476 G.postRedisplay "textentrykeyboard after confirm"
2478 | @up
| @kpup
-> histaction HCprev
2479 | @down
| @kpdown
-> histaction HCnext
2480 | @home
| @kphome
-> histaction HCfirst
2481 | @jend
| @kpend
-> histaction HClast
2486 begin match opthist
with
2488 | Some
(_, onhistcancel
) -> onhistcancel
()
2492 G.postRedisplay "textentrykeyboard after cancel2"
2495 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2498 | @delete
| @kpdelete
-> ()
2500 | _ when key != 0 && not
(Wsi.isspecialkey
key) ->
2501 begin match onkey
text key with
2505 G.postRedisplay "textentrykeyboard after confirm2";
2508 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2512 G.postRedisplay "textentrykeyboard after cancel3"
2515 state
.mode
<- Textentry
(te
, onleave
);
2516 G.postRedisplay "textentrykeyboard switch";
2520 vlog "unhandled key %s" (Wsi.keyname
key)
2523 let firstof first active
=
2524 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2525 then max
0 (active
- (fstate
.maxrows
/2))
2529 let calcfirst first active
=
2532 let rows = active
- first
in
2533 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2537 let scrollph y maxy
=
2538 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2539 let sh = float state
.winh
/. sh in
2540 let sh = max
sh (float conf
.scrollh
) in
2542 let percent = float y /. float maxy
in
2543 let position = (float state
.winh
-. sh) *. percent in
2546 if position +. sh > float state
.winh
2547 then float state
.winh
-. sh
2553 let adderrmsg src msg
=
2554 Buffer.add_string state
.errmsgs msg
;
2555 state
.newerrmsgs
<- true;
2559 let adderrfmt src fmt
=
2560 Format.ksprintf
(fun s -> adderrmsg src
s) fmt
;
2563 let coe s = (s :> uioh
);;
2565 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2567 val m_pan
= source#getpan
2568 val m_first
= source#getfirst
2569 val m_active
= source#getactive
2571 val m_prev_uioh
= state
.uioh
2573 method private elemunder
y =
2577 let n = y / (fstate
.fontsize
+1) in
2578 if m_first
+ n < source#getitemcount
2580 if source#hasaction
(m_first
+ n)
2581 then Some
(m_first
+ n)
2588 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2589 GlDraw.color (0., 0., 0.) ~alpha
:0.85;
2590 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2591 GlDraw.color (1., 1., 1.);
2592 Gl.enable `texture_2d
;
2593 let fs = fstate
.fontsize
in
2595 let hw = state
.winw
/3 in
2596 let ww = fstate
.wwidth
in
2597 let tabw = 17.0*.ww in
2598 let itemcount = source#getitemcount
in
2599 let minfo = source#getminfo
in
2603 GlMat.translate ~
x:(float conf
.scrollbw
) ();
2605 let x0 = 0.0 and x1 = float (state
.winw
- conf
.scrollbw
- 1) in
2607 if (row - m_first
) > fstate
.maxrows
2610 if row >= 0 && row < itemcount
2612 let (s, level
) = source#getitem
row in
2613 let y = (row - m_first
) * nfs in
2614 let x = 5.0 +. (float (level
+ m_pan
)) *. ww in
2617 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2621 Gl.disable `texture_2d
;
2622 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2623 GlDraw.color (1., 1., 1.) ~
alpha;
2624 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2625 Gl.enable `texture_2d
;
2628 if zebra
&& row land 1 = 1
2632 GlDraw.color (c,c,c);
2633 let drawtabularstring s =
2635 let x'
= truncate
(x0 +. x) in
2636 let s1, s2
= splitatchar
s '
\000'
in
2638 then drawstring1 fs x'
(y+nfs) s
2644 let s'
= withoutlastutf8
s in
2645 let s = s' ^
"@Uellipsis" in
2646 let w = measurestr
fs s in
2647 if float x'
+. w +. ww < float (hw + x'
)
2652 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2656 ignore
(drawstring1 fs x'
(y+nfs) s1);
2657 drawstring1 fs (hw + x'
) (y+nfs) s2
2661 let x = if helpmode
&& row > 0 then x +. ww else x in
2662 let s1, s2
= splitatchar
s '
\t'
in
2665 let nx = drawstr x s1 in
2667 let x = x +. (max
tabw sw) in
2670 let len = String.length
s - 2 in
2671 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2673 let s = String.sub s 2 len in
2674 let x = if not helpmode
then x +. ww else x in
2675 GlDraw.color (1.2, 1.2, 1.2);
2676 let vinc = drawstring1 (fs+fs/4)
2677 (truncate
(x -. ww)) (y+nfs) s in
2678 GlDraw.color (1., 1., 1.);
2679 vinc +. (float fs *. 0.8)
2685 ignore
(drawtabularstring s);
2691 GlDraw.color (1.0, 1.0, 1.0) ~
alpha:0.5;
2694 if (row - m_first
) > fstate
.maxrows
2697 if row >= 0 && row < itemcount
2699 let (s, level
) = source#getitem
row in
2700 let pos0 = nindex
s '
\000'
in
2701 let y = (row - m_first
) * nfs in
2702 let x = float (level
+ m_pan
) *. ww in
2703 let (first
, last
) = minfo.(row) in
2705 if pos0 > 0 && first
> pos0
2706 then String.sub s (pos0+1) (first
-pos0-1)
2707 else String.sub s 0 first
2709 let suffix = String.sub s first
(last
- first
) in
2710 let w1 = measurestr fstate
.fontsize
prefix in
2711 let w2 = measurestr fstate
.fontsize
suffix in
2712 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2713 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2715 and y0 = float (y+2) in
2717 and y1 = float (y+fs+3) in
2718 filledrect x0 y0 x1 y1;
2723 Gl.disable `texture_2d
;
2724 if Array.length
minfo > 0 then loop m_first
;
2729 method updownlevel incr
=
2730 let len = source#getitemcount
in
2732 if m_active
>= 0 && m_active
< len
2733 then snd
(source#getitem m_active
)
2737 if i
= len then i
-1 else if i
= -1 then 0 else
2738 let _, l = source#getitem i
in
2739 if l != curlevel then i
else flow (i
+incr
)
2741 let active = flow m_active
in
2742 let first = calcfirst m_first
active in
2743 G.postRedisplay "outline updownlevel";
2744 {< m_active
= active; m_first
= first >}
2746 method private key1
key mask
=
2747 let set1 active first qsearch
=
2748 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2750 let search active pattern incr
=
2751 let active = if active = -1 then m_first
else active in
2754 if n >= 0 && n < source#getitemcount
2756 let s, _ = source#getitem
n in
2757 match Str.search_forward re
s 0 with
2758 | (exception Not_found
) -> loop (n + incr
)
2765 let qpat = Str.quote pattern
in
2766 match Str.regexp_case_fold
qpat with
2769 adderrfmt "listview key1" "regexp_case_fold for `%S' failed: %S\n"
2770 qpat @@ Printexc.to_string exn
;
2773 let itemcount = source#getitemcount
in
2774 let find start incr
=
2776 if i
= -1 || i
= itemcount
2779 if source#hasaction i
2781 else find (i
+ incr
)
2786 let set active first =
2787 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2789 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2792 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2794 let incr1 = if incr
> 0 then 1 else -1 in
2795 if isvisible m_first m_active
2798 let next = m_active
+ incr
in
2800 if next < 0 || next >= itemcount
2802 else find next incr1
2804 if abs
(m_active
- next) > fstate
.maxrows
2810 let first = m_first
+ incr
in
2811 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2813 let next = m_active
+ incr
in
2814 let next = bound
next 0 (itemcount - 1) in
2821 if isvisible first next
2828 let first = min
next m_first
in
2830 if abs
(next - first) > fstate
.maxrows
2836 let first = m_first
+ incr
in
2837 let first = bound
first 0 (itemcount - 1) in
2839 let next = m_active
+ incr
in
2840 let next = bound
next 0 (itemcount - 1) in
2841 let next = find next incr1 in
2843 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2845 let active = if m_active
= -1 then next else m_active
in
2850 if isvisible first active
2856 G.postRedisplay "listview navigate";
2860 | (@r
|@s) when Wsi.withctrl mask
->
2861 let incr = if key = @r
then -1 else 1 in
2863 match search (m_active
+ incr) m_qsearch
incr with
2865 state
.text <- m_qsearch ^
" [not found]";
2868 state
.text <- m_qsearch
;
2869 active, firstof m_first
active
2871 G.postRedisplay "listview ctrl-r/s";
2872 set1 active first m_qsearch
;
2874 | @insert
when Wsi.withctrl mask
->
2875 if m_active
>= 0 && m_active
< source#getitemcount
2877 let s, _ = source#getitem m_active
in
2883 if emptystr m_qsearch
2886 let qsearch = withoutlastutf8 m_qsearch
in
2890 G.postRedisplay "listview empty qsearch";
2891 set1 m_active m_first
E.s;
2895 match search m_active
qsearch ~
-1 with
2897 state
.text <- qsearch ^
" [not found]";
2900 state
.text <- qsearch;
2901 active, firstof m_first
active
2903 G.postRedisplay "listview backspace qsearch";
2904 set1 active first qsearch
2907 | key when (key != 0 && not
(Wsi.isspecialkey
key)) ->
2908 let pattern = m_qsearch ^ toutf8
key in
2910 match search m_active
pattern 1 with
2912 state
.text <- pattern ^
" [not found]";
2915 state
.text <- pattern;
2916 active, firstof m_first
active
2918 G.postRedisplay "listview qsearch add";
2919 set1 active first pattern;
2923 if emptystr m_qsearch
2925 G.postRedisplay "list view escape";
2926 let mx, my
= state
.mpos
in
2930 source#exit ~uioh
:(coe self
)
2931 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2933 | None
-> m_prev_uioh
2938 G.postRedisplay "list view kill qsearch";
2939 coe {< m_qsearch
= E.s >}
2942 | @enter
| @kpenter
->
2944 let self = {< m_qsearch
= E.s >} in
2946 G.postRedisplay "listview enter";
2947 if m_active
>= 0 && m_active
< source#getitemcount
2949 source#exit ~uioh
:(coe self) ~cancel
:false
2950 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2953 source#exit ~uioh
:(coe self) ~cancel
:true
2954 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2957 begin match opt with
2958 | None
-> m_prev_uioh
2962 | @delete
| @kpdelete
->
2965 | @up
| @kpup
-> navigate ~
-1
2966 | @down
| @kpdown
-> navigate 1
2967 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2968 | @next | @kpnext
-> navigate fstate
.maxrows
2970 | @right
| @kpright
->
2972 G.postRedisplay "listview right";
2973 coe {< m_pan
= m_pan
- 1 >}
2975 | @left | @kpleft
->
2977 G.postRedisplay "listview left";
2978 coe {< m_pan
= m_pan
+ 1 >}
2980 | @home
| @kphome
->
2981 let active = find 0 1 in
2982 G.postRedisplay "listview home";
2986 let first = max
0 (itemcount - fstate
.maxrows
) in
2987 let active = find (itemcount - 1) ~
-1 in
2988 G.postRedisplay "listview end";
2991 | key when (key = 0 || Wsi.isspecialkey
key) ->
2995 dolog
"listview unknown key %#x" key; coe self
2997 method key key mask
=
2998 match state
.mode
with
2999 | Textentry te
-> textentrykeyboard key mask te
; coe self
3002 | LinkNav
_ -> self#key1
key mask
3004 method button button down
x y _ =
3007 | 1 when vscrollhit x ->
3008 G.postRedisplay "listview scroll";
3011 let _, position, sh = self#
scrollph in
3012 if y > truncate
position && y < truncate
(position +. sh)
3014 state
.mstate
<- Mscrolly
;
3018 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3019 let first = truncate
(s *. float source#getitemcount
) in
3020 let first = min source#getitemcount
first in
3021 Some
(coe {< m_first
= first; m_active
= first >})
3023 state
.mstate
<- Mnone
;
3027 begin match self#elemunder
y with
3029 G.postRedisplay "listview click";
3030 source#exit ~uioh
:(coe {< m_active
= n >})
3031 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3035 | n when (n == 4 || n == 5) && not down
->
3036 let len = source#getitemcount
in
3038 if n = 5 && m_first
+ fstate
.maxrows
>= len
3042 let first = m_first
+ (if n == 4 then -1 else 1) in
3043 bound
first 0 (len - 1)
3045 G.postRedisplay "listview wheel";
3046 Some
(coe {< m_first
= first >})
3047 | n when (n = 6 || n = 7) && not down
->
3048 let inc = if n = 7 then -1 else 1 in
3049 G.postRedisplay "listview hwheel";
3050 Some
(coe {< m_pan
= m_pan
+ inc >})
3055 | None
-> m_prev_uioh
3058 method multiclick
_ x y = self#button
1 true x y
3061 match state
.mstate
with
3063 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3064 let first = truncate
(s *. float source#getitemcount
) in
3065 let first = min source#getitemcount
first in
3066 G.postRedisplay "listview motion";
3067 coe {< m_first
= first; m_active
= first >}
3075 method pmotion
x y =
3076 if x < state
.winw
- conf
.scrollbw
3079 match self#elemunder
y with
3080 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3081 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3085 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3090 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3094 method infochanged
_ = ()
3096 method scrollpw
= (0, 0.0, 0.0)
3098 let nfs = fstate
.fontsize
+ 1 in
3099 let y = m_first
* nfs in
3100 let itemcount = source#getitemcount
in
3101 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3102 let maxy = maxi * nfs in
3103 let p, h = scrollph y maxy in
3106 method modehash
= modehash
3107 method eformsgs
= false
3108 method alwaysscrolly
= true
3111 class outlinelistview ~zebra ~source
=
3112 let settext autonarrow
s =
3115 let ss = source#statestr
in
3119 else "{" ^
ss ^
"} [" ^
s ^
"]"
3120 else state
.text <- s
3126 ~source
:(source
:> lvsource
)
3128 ~modehash
:(findkeyhash conf
"outline")
3131 val m_autonarrow
= false
3133 method! key key mask
=
3135 if emptystr state
.text
3137 else fstate
.maxrows - 2
3139 let calcfirst first active =
3142 let rows = active - first in
3143 if rows > maxrows then active - maxrows else first
3147 let active = m_active
+ incr in
3148 let active = bound
active 0 (source#getitemcount
- 1) in
3149 let first = calcfirst m_first
active in
3150 G.postRedisplay "outline navigate";
3151 coe {< m_active
= active; m_first
= first >}
3153 let navscroll first =
3155 let dist = m_active
- first in
3161 else first + maxrows
3164 G.postRedisplay "outline navscroll";
3165 coe {< m_first
= first; m_active
= active >}
3167 let ctrl = Wsi.withctrl mask
in
3172 then (source#denarrow
; E.s)
3174 let pattern = source#renarrow
in
3175 if nonemptystr m_qsearch
3176 then (source#narrow m_qsearch
; m_qsearch
)
3180 settext (not m_autonarrow
) text;
3181 G.postRedisplay "toggle auto narrowing";
3182 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3184 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3186 G.postRedisplay "toggle auto narrowing";
3187 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3190 source#narrow m_qsearch
;
3192 then source#add_narrow_pattern m_qsearch
;
3193 G.postRedisplay "outline ctrl-n";
3194 coe {< m_first
= 0; m_active
= 0 >}
3197 let active = source#calcactive
(getanchor
()) in
3198 let first = firstof m_first
active in
3199 G.postRedisplay "outline ctrl-s";
3200 coe {< m_first
= first; m_active
= active >}
3203 G.postRedisplay "outline ctrl-u";
3204 if m_autonarrow
&& nonemptystr m_qsearch
3206 ignore
(source#renarrow
);
3207 settext m_autonarrow
E.s;
3208 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3211 source#del_narrow_pattern
;
3212 let pattern = source#renarrow
in
3214 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3216 settext m_autonarrow
text;
3217 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3221 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3222 G.postRedisplay "outline ctrl-l";
3223 coe {< m_first
= first >}
3225 | @tab
when m_autonarrow
->
3226 if nonemptystr m_qsearch
3228 G.postRedisplay "outline list view tab";
3229 source#add_narrow_pattern m_qsearch
;
3231 coe {< m_qsearch
= E.s >}
3235 | @escape
when m_autonarrow
->
3236 if nonemptystr m_qsearch
3237 then source#add_narrow_pattern m_qsearch
;
3240 | @enter
| @kpenter
when m_autonarrow
->
3241 if nonemptystr m_qsearch
3242 then source#add_narrow_pattern m_qsearch
;
3245 | key when m_autonarrow
&& (not
(Wsi.isspecialkey
key)) ->
3246 let pattern = m_qsearch ^ toutf8
key in
3247 G.postRedisplay "outlinelistview autonarrow add";
3248 source#narrow
pattern;
3249 settext true pattern;
3250 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3252 | key when m_autonarrow
&& key = @backspace
->
3253 if emptystr m_qsearch
3256 let pattern = withoutlastutf8 m_qsearch
in
3257 G.postRedisplay "outlinelistview autonarrow backspace";
3258 ignore
(source#renarrow
);
3259 source#narrow
pattern;
3260 settext true pattern;
3261 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3263 | @up
| @kpup
when ctrl ->
3264 navscroll (max
0 (m_first
- 1))
3266 | @down
| @kpdown
when ctrl ->
3267 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3269 | @up
| @kpup
-> navigate ~
-1
3270 | @down
| @kpdown
-> navigate 1
3271 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3272 | @next | @kpnext
-> navigate fstate
.maxrows
3274 | @right
| @kpright
->
3278 G.postRedisplay "outline ctrl right";
3279 {< m_pan
= m_pan
+ 1 >}
3281 else self#updownlevel
1
3285 | @left | @kpleft
->
3289 G.postRedisplay "outline ctrl left";
3290 {< m_pan
= m_pan
- 1 >}
3292 else self#updownlevel ~
-1
3296 | @home
| @kphome
->
3297 G.postRedisplay "outline home";
3298 coe {< m_first
= 0; m_active
= 0 >}
3301 let active = source#getitemcount
- 1 in
3302 let first = max
0 (active - fstate
.maxrows) in
3303 G.postRedisplay "outline end";
3304 coe {< m_active
= active; m_first
= first >}
3306 | _ -> super#
key key mask
3309 let genhistoutlines () =
3311 |> List.sort
(fun (_, c1
, _, _, _, _) (_, c2
, _, _, _, _) ->
3312 compare c2
.lastvisit c1
.lastvisit
)
3314 (fun ((path
, c, _, _, _, origin
) as hist
) ->
3315 let path = if nonemptystr origin
then origin
else path in
3316 let base = mbtoutf8
@@ Filename.basename
path in
3317 (base ^
"\000" ^
c.title
, 1, Ohistory hist
)
3322 let gotohist (path, c, bookmarks
, x, anchor, origin
) =
3323 Config.save
leavebirdseye;
3324 state
.anchor <- anchor;
3325 state
.bookmarks
<- bookmarks
;
3326 state
.origin
<- origin
;
3329 let x0, y0, x1, y1 = conf
.trimfuzz
in
3330 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3331 reshape ~firsttime
:true state
.winw state
.winh
;
3332 opendoc path origin
;
3336 let makecheckers () =
3337 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3339 converted by Issac Trotts. July 25, 2002 *)
3340 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3341 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3342 let id = GlTex.gen_texture
() in
3343 GlTex.bind_texture ~target
:`texture_2d
id;
3344 GlPix.store
(`unpack_alignment
1);
3345 GlTex.image2d
image;
3346 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3347 [ `mag_filter `nearest
; `min_filter `nearest
];
3351 let setcheckers enabled
=
3352 match state
.checkerstexid
with
3354 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3356 | Some checkerstexid
->
3359 GlTex.delete_texture checkerstexid
;
3360 state
.checkerstexid
<- None
;
3364 let describe_location () =
3365 let fn = page_of_y state
.y in
3366 let ln = page_of_y
(state
.y + state
.winh
- 1) in
3367 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3371 else (100. *. (float state
.y /. float maxy))
3375 Printf.sprintf
"page %d of %d [%.2f%%]"
3376 (fn+1) state
.pagecount
percent
3379 "pages %d-%d of %d [%.2f%%]"
3380 (fn+1) (ln+1) state
.pagecount
percent
3383 let setpresentationmode v
=
3384 let n = page_of_y state
.y in
3385 state
.anchor <- (n, 0.0, 1.0);
3386 conf
.presentation
<- v
;
3387 if conf
.fitmodel
= FitPage
3388 then reqlayout conf
.angle conf
.fitmodel
;
3392 let setbgcol (r
, g, b) =
3394 let r = r *. 255.0 |> truncate
3395 and g = g *. 255.0 |> truncate
3396 and b = b *. 255.0 |> truncate
in
3397 r lsl 16 |> (lor) (g lsl 8) |> (lor) b
3399 Wsi.setwinbgcol
col;
3403 let btos b = if b then "@Uradical" else E.s in
3404 let showextended = ref false in
3405 let leave mode
_ = state
.mode
<- mode
in
3408 val mutable m_l
= []
3409 val mutable m_a
= E.a
3410 val mutable m_prev_uioh
= nouioh
3411 val mutable m_prev_mode
= View
3413 inherit lvsourcebase
3415 method reset prev_mode prev_uioh
=
3416 m_a
<- Array.of_list
(List.rev m_l
);
3418 m_prev_mode
<- prev_mode
;
3419 m_prev_uioh
<- prev_uioh
;
3421 method int name get
set =
3427 try set (int_of_string
s)
3429 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3433 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3434 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3438 method int_with_suffix name get
set =
3440 (name
, `intws get
, 1,
3444 try set (int_of_string_with_suffix
s)
3446 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3451 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3453 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3457 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3459 (name
, `
bool (btos, get
), offset
, Action
(
3466 method color name get
set =
3468 (name
, `
color get
, 1,
3471 let invalid = (nan
, nan
, nan
) in
3474 try color_of_string
s
3476 state
.text <- Printf.sprintf
"bad color `%s': %s"
3483 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3484 state
.text <- color_to_string
(get
());
3485 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3489 method string name get
set =
3491 (name
, `
string get
, 1,
3494 let ondone s = set s in
3495 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3496 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3500 method colorspace name get
set =
3502 (name
, `
string get
, 1,
3507 inherit lvsourcebase
3510 m_active
<- CSTE.to_int conf
.colorspace
;
3513 method getitemcount
=
3514 Array.length
CSTE.names
3517 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3518 ignore
(uioh
, first, pan
);
3519 if not cancel
then set active;
3521 method hasaction
_ = true
3525 let modehash = findkeyhash conf
"info" in
3526 coe (new listview ~zebra
:false ~helpmode
:false
3527 ~
source ~trusted
:true ~
modehash)
3530 method paxmark name get
set =
3532 (name
, `
string get
, 1,
3537 inherit lvsourcebase
3540 m_active
<- MTE.to_int conf
.paxmark
;
3543 method getitemcount
= Array.length
MTE.names
3544 method getitem
n = (MTE.names
.(n), 0)
3545 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3546 ignore
(uioh
, first, pan
);
3547 if not cancel
then set active;
3549 method hasaction
_ = true
3553 let modehash = findkeyhash conf
"info" in
3554 coe (new listview ~zebra
:false ~helpmode
:false
3555 ~
source ~trusted
:true ~
modehash)
3558 method fitmodel name get
set =
3560 (name
, `
string get
, 1,
3565 inherit lvsourcebase
3568 m_active
<- FMTE.to_int conf
.fitmodel
;
3571 method getitemcount
= Array.length
FMTE.names
3572 method getitem
n = (FMTE.names
.(n), 0)
3573 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3574 ignore
(uioh
, first, pan
);
3575 if not cancel
then set active;
3577 method hasaction
_ = true
3581 let modehash = findkeyhash conf
"info" in
3582 coe (new listview ~zebra
:false ~helpmode
:false
3583 ~
source ~trusted
:true ~
modehash)
3586 method caption
s offset
=
3587 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3589 method caption2
s f offset
=
3590 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3592 method getitemcount
= Array.length m_a
3595 let tostr = function
3596 | `
int f -> string_of_int
(f ())
3597 | `intws
f -> string_with_suffix_of_int
(f ())
3599 | `
color f -> color_to_string
(f ())
3600 | `
bool (btos, f) -> btos (f ())
3603 let name, t
, offset
, _ = m_a
.(n) in
3604 ((let s = tostr t
in
3606 then Printf.sprintf
"%s\t%s" name s
3610 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3615 match m_a
.(active) with
3616 | _, _, _, Action
f -> f uioh
3617 | _, _, _, Noaction
-> uioh
3628 method hasaction
n =
3630 | _, _, _, Action
_ -> true
3631 | _, _, _, Noaction
-> false
3633 initializer m_active
<- 1
3636 let rec fillsrc prevmode prevuioh
=
3637 let sep () = src#caption
E.s 0 in
3638 let colorp name get
set =
3640 (fun () -> color_to_string
(get
()))
3643 let c = color_of_string
v in
3647 Printf.sprintf
"bad color `%s': %s" v @@ exntos exn
3650 let oldmode = state
.mode
in
3651 let birdseye = isbirdseye state
.mode
in
3653 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3655 src#
bool "presentation mode"
3656 (fun () -> conf
.presentation
)
3657 (fun v -> setpresentationmode v);
3659 src#
bool "ignore case in searches"
3660 (fun () -> conf
.icase
)
3661 (fun v -> conf
.icase
<- v);
3664 (fun () -> conf
.preload)
3665 (fun v -> conf
.preload <- v);
3667 src#
bool "highlight links"
3668 (fun () -> conf
.hlinks
)
3669 (fun v -> conf
.hlinks
<- v);
3671 src#
bool "under info"
3672 (fun () -> conf
.underinfo
)
3673 (fun v -> conf
.underinfo
<- v);
3675 src#
bool "persistent bookmarks"
3676 (fun () -> conf
.savebmarks
)
3677 (fun v -> conf
.savebmarks
<- v);
3679 src#fitmodel
"fit model"
3680 (fun () -> FMTE.to_string conf
.fitmodel
)
3681 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3683 src#
bool "trim margins"
3684 (fun () -> conf
.trimmargins
)
3685 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3687 src#
bool "persistent location"
3688 (fun () -> conf
.jumpback
)
3689 (fun v -> conf
.jumpback
<- v);
3692 src#
int "inter-page space"
3693 (fun () -> conf
.interpagespace
)
3695 conf
.interpagespace
<- n;
3696 docolumns conf
.columns
;
3698 match state
.layout with
3703 state
.maxy <- calcheight
();
3704 let y = getpagey
pageno in
3705 gotoxy state
.x (y + py)
3709 (fun () -> conf
.pagebias
)
3710 (fun v -> conf
.pagebias
<- v);
3712 src#
int "scroll step"
3713 (fun () -> conf
.scrollstep
)
3714 (fun n -> conf
.scrollstep
<- n);
3716 src#
int "horizontal scroll step"
3717 (fun () -> conf
.hscrollstep
)
3718 (fun v -> conf
.hscrollstep
<- v);
3720 src#
int "auto scroll step"
3722 match state
.autoscroll
with
3724 | _ -> conf
.autoscrollstep
)
3726 let n = boundastep state
.winh
n in
3727 if state
.autoscroll
<> None
3728 then state
.autoscroll
<- Some
n;
3729 conf
.autoscrollstep
<- n);
3732 (fun () -> truncate
(conf
.zoom *. 100.))
3733 (fun v -> pivotzoom ((float v) /. 100.));
3736 (fun () -> conf
.angle
)
3737 (fun v -> reqlayout v conf
.fitmodel
);
3739 src#
int "scroll bar width"
3740 (fun () -> conf
.scrollbw
)
3743 reshape state
.winw state
.winh
;
3746 src#
int "scroll handle height"
3747 (fun () -> conf
.scrollh
)
3748 (fun v -> conf
.scrollh
<- v;);
3750 src#
int "thumbnail width"
3751 (fun () -> conf
.thumbw
)
3753 conf
.thumbw
<- min
4096 v;
3756 leavebirdseye beye
false;
3763 let mode = state
.mode in
3764 src#
string "columns"
3766 match conf
.columns
with
3768 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3769 | Csplit
(count
, _) -> "-" ^ string_of_int count
3772 let n, a, b = multicolumns_of_string
v in
3773 setcolumns mode n a b);
3776 src#caption
"Pixmap cache" 0;
3777 src#int_with_suffix
"size (advisory)"
3778 (fun () -> conf
.memlimit
)
3779 (fun v -> conf
.memlimit
<- v);
3783 Printf.sprintf
"%s bytes, %d tiles"
3784 (string_with_suffix_of_int state
.memused
)
3785 (Hashtbl.length state
.tilemap
)) 1;
3788 src#caption
"Layout" 0;
3789 src#caption2
"Dimension"
3791 Printf.sprintf
"%dx%d (virtual %dx%d)"
3792 state
.winw state
.winh
3797 src#caption2
"Position" (fun () ->
3798 Printf.sprintf
"%dx%d" state
.x state
.y
3801 src#caption2
"Position" (fun () -> describe_location ()) 1
3805 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3806 "Save these parameters as global defaults at exit"
3807 (fun () -> conf
.bedefault
)
3808 (fun v -> conf
.bedefault
<- v)
3812 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3813 src#
bool ~offset
:0 ~
btos "Extended parameters"
3814 (fun () -> !showextended)
3815 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3819 (fun () -> conf
.checkers
)
3820 (fun v -> conf
.checkers
<- v; setcheckers v);
3821 src#
bool "update cursor"
3822 (fun () -> conf
.updatecurs
)
3823 (fun v -> conf
.updatecurs
<- v);
3824 src#
bool "scroll-bar on the left"
3825 (fun () -> conf
.leftscroll
)
3826 (fun v -> conf
.leftscroll
<- v);
3828 (fun () -> conf
.verbose
)
3829 (fun v -> conf
.verbose
<- v);
3830 src#
bool "invert colors"
3831 (fun () -> conf
.invert
)
3832 (fun v -> conf
.invert
<- v);
3834 (fun () -> conf
.maxhfit
)
3835 (fun v -> conf
.maxhfit
<- v);
3837 (fun () -> conf
.pax
!= None
)
3840 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3841 else conf
.pax
<- None
);
3842 src#
string "uri launcher"
3843 (fun () -> conf
.urilauncher
)
3844 (fun v -> conf
.urilauncher
<- v);
3845 src#
string "path launcher"
3846 (fun () -> conf
.pathlauncher
)
3847 (fun v -> conf
.pathlauncher
<- v);
3848 src#
string "tile size"
3849 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3852 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3853 conf
.tilew
<- max
64 w;
3854 conf
.tileh
<- max
64 h;
3857 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3860 src#
int "texture count"
3861 (fun () -> conf
.texcount
)
3864 then conf
.texcount
<- v
3865 else impmsg "failed to set texture count please retry later"
3867 src#
int "slice height"
3868 (fun () -> conf
.sliceheight
)
3870 conf
.sliceheight
<- v;
3871 wcmd "sliceh %d" conf
.sliceheight
;
3873 src#
int "anti-aliasing level"
3874 (fun () -> conf
.aalevel
)
3876 conf
.aalevel
<- bound
v 0 8;
3877 state
.anchor <- getanchor
();
3878 opendoc state
.path state
.password;
3880 src#
string "page scroll scaling factor"
3881 (fun () -> string_of_float conf
.pgscale)
3884 let s = float_of_string
v in
3887 state
.text <- Printf.sprintf
3888 "bad page scroll scaling factor `%s': %s" v
3892 src#
int "ui font size"
3893 (fun () -> fstate
.fontsize
)
3894 (fun v -> setfontsize (bound
v 5 100));
3895 src#
int "hint font size"
3896 (fun () -> conf
.hfsize
)
3897 (fun v -> conf
.hfsize
<- bound
v 5 100);
3898 colorp "background color"
3899 (fun () -> conf
.bgcolor
)
3900 (fun v -> conf
.bgcolor
<- v; setbgcol v);
3901 src#
bool "crop hack"
3902 (fun () -> conf
.crophack
)
3903 (fun v -> conf
.crophack
<- v);
3904 src#
string "trim fuzz"
3905 (fun () -> irect_to_string conf
.trimfuzz
)
3908 conf
.trimfuzz
<- irect_of_string
v;
3910 then settrim true conf
.trimfuzz
;
3912 state
.text <- Printf.sprintf
"bad irect `%s': %s" v
3915 src#
string "throttle"
3917 match conf
.maxwait
with
3918 | None
-> "show place holder if page is not ready"
3921 then "wait for page to fully render"
3923 "wait " ^ string_of_float
time
3924 ^
" seconds before showing placeholder"
3928 let f = float_of_string
v in
3930 then conf
.maxwait
<- None
3931 else conf
.maxwait
<- Some
f
3933 state
.text <- Printf.sprintf
"bad time `%s': %s" v
3936 src#
string "ghyll scroll"
3938 match conf
.ghyllscroll
with
3940 | Some nab
-> ghyllscroll_to_string nab
3943 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3946 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v msg
3948 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v
3951 src#
string "selection command"
3952 (fun () -> conf
.selcmd
)
3953 (fun v -> conf
.selcmd
<- v);
3954 src#
string "synctex command"
3955 (fun () -> conf
.stcmd
)
3956 (fun v -> conf
.stcmd
<- v);
3957 src#
string "pax command"
3958 (fun () -> conf
.paxcmd
)
3959 (fun v -> conf
.paxcmd
<- v);
3960 src#
string "ask password command"
3961 (fun () -> conf
.passcmd)
3962 (fun v -> conf
.passcmd <- v);
3963 src#
string "save path command"
3964 (fun () -> conf
.savecmd
)
3965 (fun v -> conf
.savecmd
<- v);
3966 src#colorspace
"color space"
3967 (fun () -> CSTE.to_string conf
.colorspace
)
3969 conf
.colorspace
<- CSTE.of_int
v;
3973 src#paxmark
"pax mark method"
3974 (fun () -> MTE.to_string conf
.paxmark
)
3975 (fun v -> conf
.paxmark
<- MTE.of_int
v);
3976 if bousable
() && !opengl_has_pbo
3979 (fun () -> conf
.usepbo
)
3980 (fun v -> conf
.usepbo
<- v);
3981 src#
bool "mouse wheel scrolls pages"
3982 (fun () -> conf
.wheelbypage
)
3983 (fun v -> conf
.wheelbypage
<- v);
3984 src#
bool "open remote links in a new instance"
3985 (fun () -> conf
.riani
)
3986 (fun v -> conf
.riani
<- v);
3987 src#
bool "edit annotations inline"
3988 (fun () -> conf
.annotinline
)
3989 (fun v -> conf
.annotinline
<- v);
3990 src#
bool "coarse positioning in presentation mode"
3991 (fun () -> conf
.coarseprespos
)
3992 (fun v -> conf
.coarseprespos
<- v);
3993 src#
bool "use document CSS"
3994 (fun () -> conf
.usedoccss
)
3996 conf
.usedoccss
<- v;
3997 state
.anchor <- getanchor
();
3998 opendoc state
.path state
.password;
4003 src#caption
"Document" 0;
4004 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4005 src#caption2
"Pages"
4006 (fun () -> string_of_int state
.pagecount
) 1;
4007 src#caption2
"Dimensions"
4008 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4009 if nonemptystr conf
.css
4010 then src#caption2
"CSS" (fun () -> conf
.css
) 1;
4014 src#caption
"Trimmed margins" 0;
4015 src#caption2
"Dimensions"
4016 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4020 src#caption
"OpenGL" 0;
4021 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4022 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4025 src#caption
"Location" 0;
4026 if nonemptystr state
.origin
4027 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4028 src#caption
("Path\t" ^ mbtoutf8 state
.path) 1;
4030 src#reset prevmode prevuioh
;
4035 let prevmode = state
.mode
4036 and prevuioh
= state
.uioh in
4037 fillsrc prevmode prevuioh
;
4038 let source = (src :> lvsource
) in
4039 let modehash = findkeyhash conf
"info" in
4042 inherit listview ~zebra
:false ~helpmode
:false
4043 ~
source ~trusted
:true ~
modehash as super
4044 val mutable m_prevmemused
= 0
4045 method! infochanged
= function
4047 if m_prevmemused
!= state
.memused
4049 m_prevmemused
<- state
.memused
;
4050 G.postRedisplay "memusedchanged";
4052 | Pdim
-> G.postRedisplay "pdimchanged"
4053 | Docinfo
-> fillsrc prevmode prevuioh
4055 method! key key mask
=
4056 if not
(Wsi.withctrl mask
)
4059 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4060 | @right
| @kpright
-> coe (self#updownlevel
1)
4061 | _ -> super#
key key mask
4062 else super#
key key mask
4064 G.postRedisplay "info";
4070 inherit lvsourcebase
4071 method getitemcount
= Array.length state
.help
4073 let s, l, _ = state
.help
.(n) in
4076 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4080 match state
.help
.(active) with
4081 | _, _, Action
f -> Some
(f uioh)
4082 | _, _, Noaction
-> Some
uioh
4091 method hasaction
n =
4092 match state
.help
.(n) with
4093 | _, _, Action
_ -> true
4094 | _, _, Noaction
-> false
4100 let modehash = findkeyhash conf
"help" in
4102 state
.uioh <- coe (new listview
4103 ~zebra
:false ~helpmode
:true
4104 ~
source ~trusted
:true ~
modehash);
4105 G.postRedisplay "help";
4111 inherit lvsourcebase
4112 val mutable m_items
= E.a
4114 method getitemcount
= 1 + Array.length m_items
4119 else m_items
.(n-1), 0
4121 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4126 then Buffer.clear state
.errmsgs
;
4133 method hasaction
n =
4137 state
.newerrmsgs
<- false;
4138 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4139 m_items
<- Array.of_list
l
4148 let source = (msgsource :> lvsource
) in
4149 let modehash = findkeyhash conf
"listview" in
4152 inherit listview ~zebra
:false ~helpmode
:false
4153 ~
source ~trusted
:false ~
modehash as super
4156 then msgsource#reset
;
4159 G.postRedisplay "msgs";
4163 let editor = getenvwithdef
"EDITOR" E.s in
4167 let tmppath = Filename.temp_file
"llpp" "note" in
4170 let oc = open_out
tmppath in
4174 let execstr = editor ^
" " ^
tmppath in
4176 match spawn
execstr [] with
4177 | (exception exn
) ->
4178 impmsg "spawn(%S) failed: %s" execstr @@ exntos exn
;
4181 match Unix.waitpid
[] pid with
4182 | (exception exn
) ->
4183 impmsg "waitpid(%d) failed: %s" pid @@ exntos exn
;
4187 | Unix.WEXITED
0 -> filecontents
tmppath
4189 impmsg "editor process(%s) exited abnormally: %d" execstr n;
4191 | Unix.WSIGNALED
n ->
4192 impmsg "editor process(%s) was killed by signal %d" execstr n;
4194 | Unix.WSTOPPED
n ->
4195 impmsg "editor(%s) process was stopped by signal %d" execstr n;
4198 match Unix.unlink
tmppath with
4199 | (exception exn
) ->
4200 impmsg "failed to ulink %S: %s" tmppath @@ exntos exn
;
4205 let enterannotmode opaque slinkindex
=
4208 inherit lvsourcebase
4209 val mutable m_text
= E.s
4210 val mutable m_items
= E.a
4212 method getitemcount
= Array.length m_items
4215 let label, _func
= m_items
.(n) in
4218 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4219 ignore
(uioh, first, pan
);
4222 let _label, func
= m_items
.(active) in
4227 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4230 let rec split accu b i
=
4232 if p = String.length
s
4233 then (String.sub s b (p-b), unit) :: accu
4235 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4237 let ss = if i
= 0 then E.s else String.sub s b i
in
4238 split ((ss, unit)::accu) (p+1) 0
4243 wcmd "freepage %s" (~
> opaque);
4245 Hashtbl.fold (fun key opaque'
accu ->
4246 if opaque'
= opaque'
4247 then key :: accu else accu) state
.pagemap
[]
4249 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4251 gotoxy state
.x state
.y
4254 delannot
opaque slinkindex
;
4257 let edit inline
() =
4262 modannot
opaque slinkindex
s;
4268 let mode = state
.mode in
4271 ("annotation: ", m_text
, None
, textentry, update, true),
4272 fun _ -> state
.mode <- mode);
4276 let s = getusertext m_text
in
4281 ( "[Copy]", fun () -> selstring m_text
)
4282 :: ("[Delete]", dele)
4283 :: ("[Edit]", edit conf
.annotinline
)
4285 :: split [] 0 0 |> List.rev
|> Array.of_list
4292 let s = getannotcontents
opaque slinkindex
in
4295 let source = (msgsource :> lvsource
) in
4296 let modehash = findkeyhash conf
"listview" in
4297 state
.uioh <- coe (object
4298 inherit listview ~zebra
:false ~helpmode
:false
4299 ~
source ~trusted
:false ~
modehash
4301 G.postRedisplay "enterannotmode";
4304 let gotoremote spec
=
4305 let filename, dest
= splitatchar spec '#'
in
4306 let getpath filename =
4308 if nonemptystr
filename
4310 if Filename.is_relative
filename
4312 let dir = Filename.dirname state
.path in
4314 if Filename.is_implicit
dir
4315 then Filename.concat
(Sys.getcwd
()) dir
4318 Filename.concat
dir filename
4322 if Sys.file_exists
path
4326 let path = getpath filename in
4330 let cmd = Lazy.force_val lcmd
in
4331 match spawn
cmd with
4333 | (exception exn
) ->
4334 dolog
"failed to execute `%s': %s" cmd @@ exntos exn
4336 let anchor = getanchor
() in
4337 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4338 state
.origin
<- E.s;
4339 state
.ranchors
<- ranchor :: state
.ranchors
;
4342 if substratis spec
0 "page="
4344 match Scanf.sscanf spec
"page=%d" (fun n -> n) with
4346 state
.anchor <- (pageno, 0.0, 0.0);
4347 dospawn @@ lazy (Printf.sprintf
"%s -page %d %S" !selfexec pageno path);
4349 adderrfmt "error parsing remote destination" "page: %s" @@ exntos exn
4351 state
.nameddest
<- dest
;
4352 dospawn @@ lazy (!selfexec ^
" " ^
path ^
" -dest " ^ dest
)
4356 let gotounder = function
4357 | Ulinkuri
s when isexternallink
s ->
4358 if substratis
s 0 "file://"
4359 then gotoremote @@ String.sub s 7 (String.length
s - 7)
4362 let pageno, x, y = uritolocation
s in
4364 gotopagexy !wtmode pageno x y
4365 | Utext
_ | Unone
-> ()
4366 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4369 let gotooutline (_, _, kind
) =
4373 let (pageno, y, _) = anchor in
4375 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4379 | Ouri
uri -> gotounder (Ulinkuri
uri)
4380 | Olaunch _cmd
-> failwith
"gotounder (Ulaunch cmd)"
4381 | Oremote _remote
-> failwith
"gotounder (Uremote remote)"
4382 | Ohistory hist
-> gotohist hist
4383 | Oremotedest _remotedest
-> failwith
"gotounder (Uremotedest remotedest)"
4386 class outlinesoucebase fetchoutlines
= object (self)
4387 inherit lvsourcebase
4388 val mutable m_items
= E.a
4389 val mutable m_minfo
= E.a
4390 val mutable m_orig_items
= E.a
4391 val mutable m_orig_minfo
= E.a
4392 val mutable m_narrow_patterns
= []
4393 val mutable m_gen
= -1
4395 method getitemcount
= Array.length m_items
4398 let s, n, _ = m_items
.(n) in
4401 method exit ~
(uioh:uioh) ~cancel ~
active ~
(first:int) ~pan
:
4403 ignore
(uioh, first);
4405 if m_narrow_patterns
= []
4406 then m_orig_items
, m_orig_minfo
4407 else m_items
, m_minfo
4414 gotooutline m_items
.(active);
4422 method hasaction
(_:int) = true
4425 if Array.length m_items
!= Array.length m_orig_items
4428 match m_narrow_patterns
with
4430 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4432 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4436 match m_narrow_patterns
with
4439 | head
:: _ -> "@Uellipsis" ^ head
4441 method narrow
pattern =
4442 match Str.regexp_case_fold
pattern with
4443 | (exception _) -> ()
4445 let rec loop accu minfo n =
4448 m_items
<- Array.of_list
accu;
4449 m_minfo
<- Array.of_list
minfo;
4452 let (s, _, _) as o = m_items
.(n) in
4454 match Str.search_forward re
s 0 with
4455 | (exception Not_found
) -> accu, minfo
4456 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4458 loop accu minfo (n-1)
4460 loop [] [] (Array.length m_items
- 1)
4462 method! getminfo
= m_minfo
4465 m_orig_items
<- fetchoutlines
();
4466 m_minfo
<- m_orig_minfo
;
4467 m_items
<- m_orig_items
4469 method add_narrow_pattern
pattern =
4470 m_narrow_patterns
<- pattern :: m_narrow_patterns
4472 method del_narrow_pattern
=
4473 match m_narrow_patterns
with
4474 | _ :: rest
-> m_narrow_patterns
<- rest
4479 match m_narrow_patterns
with
4480 | pattern :: [] -> self#narrow
pattern; pattern
4482 List.fold_left
(fun accu pattern ->
4483 self#narrow
pattern;
4484 pattern ^
"@Uellipsis" ^
accu) E.s list
4486 method calcactive
(_:anchor) = 0
4488 method reset
anchor items =
4489 if state
.gen
!= m_gen
4491 m_orig_items
<- items;
4493 m_narrow_patterns
<- [];
4495 m_orig_minfo
<- E.a;
4499 if items != m_orig_items
4501 m_orig_items
<- items;
4502 if m_narrow_patterns
== []
4503 then m_items
<- items;
4506 let active = self#calcactive
anchor in
4508 m_first
<- firstof m_first
active
4512 let outlinesource fetchoutlines
=
4514 inherit outlinesoucebase fetchoutlines
4515 method! calcactive
anchor =
4516 let rely = getanchory anchor in
4517 let rec loop n best bestd
=
4518 if n = Array.length m_items
4521 let _, _, kind
= m_items
.(n) in
4524 let orely = getanchory anchor in
4525 let d = abs
(orely - rely) in
4528 else loop (n+1) best bestd
4529 | Onone
| Oremote
_ | Olaunch
_
4530 | Oremotedest
_ | Ouri
_ | Ohistory
_ ->
4531 loop (n+1) best bestd
4537 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4538 let mkselector sourcetype
=
4539 let fetchoutlines () =
4540 match sourcetype
with
4541 | `bookmarks
-> Array.of_list state
.bookmarks
4542 | `outlines
-> state
.outlines
4543 | `history
-> genhistoutlines ()
4546 if sourcetype
= `history
4547 then new outlinesoucebase
fetchoutlines
4548 else outlinesource fetchoutlines
4551 let outlines = fetchoutlines () in
4552 if Array.length
outlines = 0
4554 showtext ' ' errmsg
;
4558 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4559 let anchor = getanchor
() in
4560 source#reset
anchor outlines;
4561 state
.text <- source#greetmsg
;
4563 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4564 G.postRedisplay "enter selector";
4567 let mkenter sourcetype errmsg
=
4568 let enter = mkselector sourcetype
in
4569 fun () -> enter errmsg
4571 mkenter `
outlines "document has no outline"
4572 , mkenter `bookmarks
"document has no bookmarks (yet)"
4573 , mkenter `history
"history is empty"
4576 let quickbookmark ?title
() =
4577 match state
.layout with
4583 let tm = Unix.localtime
(now
()) in
4585 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4589 (tm.Unix.tm_year
+ 1900)
4592 | Some
title -> title
4594 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4597 let setautoscrollspeed step goingdown
=
4598 let incr = max
1 ((abs step
) / 2) in
4599 let incr = if goingdown
then incr else -incr in
4600 let astep = boundastep state
.winh
(step
+ incr) in
4601 state
.autoscroll
<- Some
astep;
4605 match conf
.columns
with
4607 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4610 let panbound x = bound
x (-state
.w) state
.winw
;;
4612 let existsinrow pageno (columns
, coverA
, coverB
) p =
4613 let last = ((pageno - coverA
) mod columns
) + columns
in
4614 let rec any = function
4617 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4621 then (if l.pageno = last then false else any rest
)
4629 match state
.layout with
4631 let pageno = page_of_y state
.y in
4632 gotoghyll (getpagey
(pageno+1))
4634 match conf
.columns
with
4636 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4638 let y = clamp (pgscale state
.winh
) in
4641 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4642 gotoghyll (getpagey
pageno)
4643 | Cmulti
((c, _, _) as cl
, _) ->
4644 if conf
.presentation
4645 && (existsinrow l.pageno cl
4646 (fun l -> l.pageh
> l.pagey + l.pagevh))
4648 let y = clamp (pgscale state
.winh
) in
4651 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4652 gotoghyll (getpagey
pageno)
4654 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4656 let pagey, pageh
= getpageyh
l.pageno in
4657 let pagey = pagey + pageh
* l.pagecol
in
4658 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4659 gotoghyll (pagey + pageh
+ ips)
4663 match state
.layout with
4665 let pageno = page_of_y state
.y in
4666 gotoghyll (getpagey
(pageno-1))
4668 match conf
.columns
with
4670 if conf
.presentation
&& l.pagey != 0
4672 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4674 let pageno = max
0 (l.pageno-1) in
4675 gotoghyll (getpagey
pageno)
4676 | Cmulti
((c, _, coverB
) as cl
, _) ->
4677 if conf
.presentation
&&
4678 (existsinrow l.pageno cl
(fun l -> l.pagey != 0))
4680 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4683 if l.pageno = state
.pagecount
- coverB
4687 let pageno = max
0 (l.pageno-decr) in
4688 gotoghyll (getpagey
pageno)
4696 let pageno = max
0 (l.pageno-1) in
4697 let pagey, pageh
= getpageyh
pageno in
4700 let pagey, pageh
= getpageyh
l.pageno in
4701 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4707 if emptystr conf
.savecmd
4708 then error
"don't know where to save modified document"
4710 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4713 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4718 let tmp = path ^
".tmp" in
4720 Unix.rename
tmp path;
4723 let viewkeyboard key mask
=
4725 let mode = state
.mode in
4726 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4729 G.postRedisplay "view:enttext"
4731 let ctrl = Wsi.withctrl mask
in
4732 let key = Wsi.keypadtodigitkey
key in
4737 if hasunsavedchanges
()
4741 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4744 match state
.lnava
with
4745 | None
-> LinkNav
(Ltgendir
0)
4746 | Some
pn -> LinkNav
(Ltexact
pn)
4748 gotoxy state
.x state
.y;
4750 else impmsg "keyboard link navigation does not work under rotation"
4753 begin match state
.mstate
with
4756 G.postRedisplay "kill rect";
4759 | Mscrolly
| Mscrollx
4762 begin match state
.mode with
4765 | Ltexact pl
-> state
.lnava
<- Some pl
4766 | Ltgendir
_ | Ltnotready
_ -> state
.lnava
<- None
4769 G.postRedisplay "esc leave linknav"
4773 match state
.ranchors
with
4775 | (path, password, anchor, origin
) :: rest
->
4776 state
.ranchors
<- rest
;
4777 state
.anchor <- anchor;
4778 state
.origin
<- origin
;
4779 state
.nameddest
<- E.s;
4780 opendoc path password
4785 gotoghyll (getnav ~
-1)
4796 Hashtbl.iter
(fun _ opaque ->
4798 Hashtbl.clear state
.prects
) state
.pagemap
;
4799 G.postRedisplay "dehighlight";
4801 | @slash
| @question
->
4802 let ondone isforw
s =
4803 cbput state
.hists
.pat
s;
4804 state
.searchpattern
<- s;
4807 let s = String.make
1 (Char.chr
key) in
4808 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4809 textentry, ondone (key = @slash
), true)
4811 | @plus
| @kpplus
| @equals
when ctrl ->
4812 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4813 pivotzoom (conf
.zoom +. incr)
4815 | @plus
| @kpplus
->
4818 try int_of_string
s with exn
->
4819 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4825 state
.text <- "page bias is now " ^ string_of_int
n;
4828 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4830 | @minus
| @kpminus
when ctrl ->
4831 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4832 pivotzoom (max
0.01 (conf
.zoom -. decr))
4834 | @minus
| @kpminus
->
4835 let ondone msg
= state
.text <- msg
in
4837 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4838 optentry state
.mode, ondone, true
4843 then gotoxy 0 state
.y
4846 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4848 match conf
.columns
with
4849 | Csingle
_ | Cmulti
_ -> 1
4850 | Csplit
(n, _) -> n
4852 let h = state
.winh
-
4853 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4855 let zoom = zoomforh state
.winw
h 0 cols in
4856 if zoom > 0.0 && (key = @2 || zoom < 1.0)
4861 match conf
.fitmodel
with
4862 | FitWidth
-> FitProportional
4863 | FitProportional
-> FitPage
4864 | FitPage
-> FitWidth
4866 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4867 reqlayout conf
.angle
fm
4869 | @4 when ctrl -> (* ctrl-4 *)
4870 let zoom = getmaxw
() /. float state
.winw
in
4871 if zoom > 0.0 then setzoom zoom
4879 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4880 when not
ctrl -> (* 0..9 *)
4883 try int_of_string
s with exn
->
4884 state
.text <- Printf.sprintf
"bad integer `%s': %s" s @@ exntos exn
;
4890 cbput state
.hists
.pag
(string_of_int
n);
4891 gotopage1 (n + conf
.pagebias
- 1) 0;
4894 let pageentry text key =
4895 match Char.unsafe_chr
key with
4896 | '
g'
-> TEdone
text
4897 | _ -> intentry text key
4899 let text = String.make
1 (Char.chr
key) in
4900 enttext (":", text, Some
(onhist state
.hists
.pag
),
4901 pageentry, ondone, true)
4904 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4905 G.postRedisplay "toggle scrollbar";
4908 state
.bzoom
<- not state
.bzoom
;
4910 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4913 conf
.hlinks
<- not conf
.hlinks
;
4914 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4915 G.postRedisplay "toggle highlightlinks";
4918 if conf
.angle
mod 360 = 0
4920 state
.glinks
<- true;
4921 let mode = state
.mode in
4924 (":", E.s, None
, linknentry, linknact gotounder, false),
4926 state
.glinks
<- false;
4930 G.postRedisplay "view:linkent(F)"
4932 else impmsg "hint mode does not work under rotation"
4935 state
.glinks
<- true;
4936 let mode = state
.mode in
4940 ":", E.s, None
, linknentry, linknact (fun under ->
4941 selstring (undertext under);
4945 state
.glinks
<- false;
4949 G.postRedisplay "view:linkent"
4952 begin match state
.autoscroll
with
4954 conf
.autoscrollstep
<- step
;
4955 state
.autoscroll
<- None
4957 if conf
.autoscrollstep
= 0
4958 then state
.autoscroll
<- Some
1
4959 else state
.autoscroll
<- Some conf
.autoscrollstep
4963 launchpath () (* XXX where do error messages go? *)
4966 setpresentationmode (not conf
.presentation
);
4967 showtext ' '
("presentation mode " ^
4968 if conf
.presentation
then "on" else "off");
4971 if List.mem
Wsi.Fullscreen state
.winstate
4972 then Wsi.reshape conf
.cwinw conf
.cwinh
4973 else Wsi.fullscreen
()
4976 search state
.searchpattern
false
4979 search state
.searchpattern
true
4982 begin match state
.layout with
4985 gotoghyll (getpagey
l.pageno)
4991 | @delete
| @kpdelete
-> (* delete *)
4995 showtext ' '
(describe_location ());
4998 begin match state
.layout with
5001 Wsi.reshape l.pagew
l.pageh
;
5006 enterbookmarkmode
()
5014 | @e when Buffer.length state
.errmsgs
> 0 ->
5019 match state
.layout with
5024 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5027 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5031 showtext ' '
"Quick bookmark added";
5034 begin match state
.layout with
5036 let rect = getpdimrect
l.pagedimno
in
5040 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5041 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5043 (truncate
(rect.(1) -. rect.(0)),
5044 truncate
(rect.(3) -. rect.(0)))
5046 let w = truncate
((float w)*.conf
.zoom)
5047 and h = truncate
((float h)*.conf
.zoom) in
5050 state
.anchor <- getanchor
();
5051 Wsi.reshape w (h + conf
.interpagespace
)
5053 G.postRedisplay "z";
5058 | @x -> state
.roam
()
5061 reqlayout (conf
.angle
+
5062 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5066 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5068 G.postRedisplay "brightness";
5070 | @c when state
.mode = View
->
5075 let m = (state
.winw
- state
.w) / 2 in
5076 gotoxy_and_clear_text m state
.y
5080 match state
.prevcolumns
with
5081 | None
-> (1, 0, 0), 1.0
5082 | Some
(columns
, z
) ->
5085 | Csplit
(c, _) -> -c, 0, 0
5086 | Cmulti
((c, a, b), _) -> c, a, b
5087 | Csingle
_ -> 1, 0, 0
5091 setcolumns View
c a b;
5094 | @down
| @up
when ctrl && Wsi.withshift mask
->
5095 let zoom, x = state
.prevzoom
in
5099 | @k
| @up
| @kpup
->
5100 begin match state
.autoscroll
with
5102 begin match state
.mode with
5103 | Birdseye beye
-> upbirdseye 1 beye
5108 then gotoxy_and_clear_text state
.x (clamp ~
-(state
.winh
/2))
5110 if not
(Wsi.withshift mask
) && conf
.presentation
5112 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5116 setautoscrollspeed n false
5119 | @j
| @down
| @kpdown
->
5120 begin match state
.autoscroll
with
5122 begin match state
.mode with
5123 | Birdseye beye
-> downbirdseye 1 beye
5128 then gotoxy_and_clear_text state
.x (clamp (state
.winh
/2))
5130 if not
(Wsi.withshift mask
) && conf
.presentation
5132 else gotoghyll1 true (clamp (conf
.scrollstep
))
5136 setautoscrollspeed n true
5139 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5145 else conf
.hscrollstep
5147 let dx = if key = @left || key = @kpleft
then dx else -dx in
5148 gotoxy_and_clear_text (panbound (state
.x + dx)) state
.y
5151 G.postRedisplay "left/right"
5154 | @prior
| @kpprior
->
5158 match state
.layout with
5160 | l :: _ -> state
.y - l.pagey
5162 clamp (pgscale (-state
.winh
))
5166 | @next | @kpnext
->
5170 match List.rev state
.layout with
5172 | l :: _ -> getpagey
l.pageno
5174 clamp (pgscale state
.winh
)
5178 | @g | @home
| @kphome
->
5181 | @G
| @jend
| @kpend
->
5183 gotoghyll (clamp state
.maxy)
5185 | @right
| @kpright
when Wsi.withalt mask
->
5186 gotoghyll (getnav 1)
5187 | @left | @kpleft
when Wsi.withalt mask
->
5188 gotoghyll (getnav ~
-1)
5193 | @v when conf
.debug
->
5196 match getopaque l.pageno with
5199 let x0, y0, x1, y1 = pagebbox
opaque in
5200 let rect = (float x0, float y0,
5203 float x0, float y1) in
5205 let color = (0.0, 0.0, 1.0 /. (l.pageno mod 3 |> float), 0.5) in
5206 state
.rects
<- (l.pageno, color, rect) :: state
.rects
;
5208 G.postRedisplay "v";
5211 let mode = state
.mode in
5212 let cmd = ref E.s in
5213 let onleave = function
5214 | Cancel
-> state
.mode <- mode
5217 match getopaque l.pageno with
5218 | Some
opaque -> pipesel opaque !cmd
5219 | None
-> ()) state
.layout;
5223 cbput state
.hists
.sel
s;
5227 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5229 G.postRedisplay "|";
5230 state
.mode <- Textentry
(te, onleave);
5233 vlog "huh? %s" (Wsi.keyname
key)
5236 let linknavkeyboard key mask
linknav =
5237 let getpage pageno =
5238 let rec loop = function
5240 | l :: _ when l.pageno = pageno -> Some
l
5241 | _ :: rest
-> loop rest
5242 in loop state
.layout
5244 let doexact (pageno, n) =
5245 match getopaque pageno, getpage pageno with
5246 | Some
opaque, Some
l ->
5247 if key = @enter || key = @kpenter
5249 let under = getlink
opaque n in
5250 G.postRedisplay "link gotounder";
5257 Some
(findlink
opaque LDfirst
), -1
5260 Some
(findlink
opaque LDlast
), 1
5263 Some
(findlink
opaque (LDleft
n)), -1
5266 Some
(findlink
opaque (LDright
n)), 1
5269 Some
(findlink
opaque (LDup
n)), -1
5272 Some
(findlink
opaque (LDdown
n)), 1
5277 begin match findpwl
l.pageno dir with
5281 state
.mode <- LinkNav
(Ltgendir
dir);
5282 let y, h = getpageyh
pageno in
5285 then y + h - state
.winh
5290 begin match getopaque pageno, getpage pageno with
5291 | Some
opaque, Some
_ ->
5293 let ld = if dir > 0 then LDfirst
else LDlast
in
5296 begin match link with
5298 showlinktype (getlink
opaque m);
5299 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5300 G.postRedisplay "linknav jpage";
5301 | Lnotfound
-> notfound dir
5307 begin match opt with
5308 | Some Lnotfound
-> pwl l dir;
5309 | Some
(Lfound
m) ->
5313 let _, y0, _, y1 = getlinkrect
opaque m in
5315 then gotopage1 l.pageno y0
5317 let d = fstate
.fontsize
+ 1 in
5318 if y1 - l.pagey > l.pagevh - d
5319 then gotopage1 l.pageno (y1 - state
.winh
+ d)
5320 else G.postRedisplay "linknav";
5322 showlinktype (getlink
opaque m);
5323 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5326 | None
-> viewkeyboard key mask
5328 | _ -> viewkeyboard key mask
5332 begin match linknav with
5333 | Ltexact pa
-> state
.lnava
<- Some pa
5334 | Ltgendir
_ | Ltnotready
_ -> ()
5337 G.postRedisplay "leave linknav"
5341 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5342 | Ltexact exact
-> doexact exact
5345 let keyboard key mask
=
5346 if (key = @g && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5347 then wcmd "interrupt"
5348 else state
.uioh <- state
.uioh#
key key mask
5351 let birdseyekeyboard key mask
5352 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5354 match conf
.columns
with
5356 | Cmulti
((c, _, _), _) -> c
5357 | Csplit
_ -> failwith
"bird's eye split mode"
5359 let pgh layout = List.fold_left
5360 (fun m l -> max
l.pageh
m) state
.winh
layout in
5362 | @l when Wsi.withctrl mask
->
5363 let y, h = getpageyh
pageno in
5364 let top = (state
.winh
- h) / 2 in
5365 gotoxy state
.x (max
0 (y - top))
5366 | @enter | @kpenter
-> leavebirdseye beye
false
5367 | @escape
-> leavebirdseye beye
true
5368 | @up
-> upbirdseye incr beye
5369 | @down
-> downbirdseye incr beye
5370 | @left -> upbirdseye 1 beye
5371 | @right
-> downbirdseye 1 beye
5374 begin match state
.layout with
5378 state
.mode <- Birdseye
(
5379 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5381 gotopage1 l.pageno 0;
5384 let layout = layout state
.x (state
.y-state
.winh
)
5386 (pgh state
.layout) in
5388 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5390 state
.mode <- Birdseye
(
5391 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5393 gotopage1 l.pageno 0
5396 | [] -> gotoxy state
.x (clamp (-state
.winh
))
5400 begin match List.rev state
.layout with
5402 let layout = layout state
.x
5403 (state
.y + (pgh state
.layout))
5404 state
.winw state
.winh
in
5405 begin match layout with
5407 let incr = l.pageh
- l.pagevh in
5412 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5414 G.postRedisplay "birdseye pagedown";
5416 else gotoxy state
.x (clamp (incr + conf
.interpagespace
*2));
5420 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5421 gotopage1 l.pageno 0;
5424 | [] -> gotoxy state
.x (clamp state
.winh
)
5428 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5432 let pageno = state
.pagecount
- 1 in
5433 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5434 if not
(pagevisible state
.layout pageno)
5437 match List.rev state
.pdims
with
5439 | (_, _, h, _) :: _ -> h
5443 (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5444 else G.postRedisplay "birdseye end";
5446 | _ -> viewkeyboard key mask
5451 match state
.mode with
5452 | Textentry
_ -> scalecolor 0.4
5454 | View
-> scalecolor 1.0
5455 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5456 if l.pageno = hooverpageno
5459 if l.pageno = pageno
5461 let c = scalecolor 1.0 in
5463 GlDraw.line_width
3.0;
5464 let dispx = l.pagedispx in
5466 (float (dispx-1)) (float (l.pagedispy-1))
5467 (float (dispx+l.pagevw+1))
5468 (float (l.pagedispy+l.pagevh+1))
5470 GlDraw.line_width
1.0;
5479 let postdrawpage l linkindexbase
=
5480 match getopaque l.pageno with
5482 if tileready l l.pagex
l.pagey
5484 let x = l.pagedispx - l.pagex
5485 and y = l.pagedispy - l.pagey in
5487 match conf
.columns
with
5488 | Csingle
_ | Cmulti
_ ->
5489 (if conf
.hlinks
then 1 else 0)
5491 && not
(isbirdseye state
.mode) then 2 else 0)
5495 match state
.mode with
5496 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5502 Hashtbl.find_all state
.prects
l.pageno |>
5503 List.iter
(fun vals
-> drawprect
opaque x y vals
);
5504 let n = postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
) in
5506 then (state
.redisplay
<- true; 0)
5512 let scrollindicator () =
5513 let sbw, ph
, sh = state
.uioh#
scrollph in
5514 let sbh, pw, sw = state
.uioh#scrollpw
in
5519 else ((state
.winw
- sbw), state
.winw
, 0)
5523 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5524 GlDraw.color (0.64, 0.64, 0.64) ~
alpha:0.7;
5525 filledrect (float x0) 0. (float x1) (float state
.winh
);
5527 (float hx0
) (float (state
.winh
- sbh))
5528 (float (hx0
+ state
.winw
)) (float state
.winh
)
5530 GlDraw.color (0.0, 0.0, 0.0) ~
alpha:0.7;
5532 filledrect (float x0) ph
(float x1) (ph
+. sh);
5533 let pw = pw +. float hx0
in
5534 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5539 match state
.mstate
with
5540 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5543 | Msel
((x0, y0), (x1, y1)) ->
5544 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5545 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5546 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5547 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5554 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5555 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5557 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5559 if l.pageno = pageno
5561 let dx = float (l.pagedispx - l.pagex
) in
5562 let dy = float (l.pagedispy - l.pagey) in
5563 let r, g, b, alpha = c in
5564 GlDraw.color (r, g, b) ~
alpha;
5565 filledrect2 (x0+.dx) (y0+.dy)
5577 begin match conf
.columns
, state
.layout with
5578 | Csingle
_, _ :: _ ->
5579 GlDraw.color (scalecolor2 conf
.bgcolor
);
5581 List.fold_left
(fun y l ->
5584 let x1 = l.pagedispx in
5585 let y1 = (l.pagedispy + l.pagevh) in
5586 filledrect (float x0) (float y0) (float x1) (float y1);
5587 let x0 = x1 + l.pagevw in
5588 let x1 = state
.winw
in
5589 filledrect1 (float x0) (float y0) (float x1) (float y1);
5593 and x1 = state
.winw
in
5595 and y1 = l.pagedispy in
5596 filledrect1 (float x0) (float y0) (float x1) (float y1);
5598 l.pagedispy + l.pagevh) 0 state
.layout
5601 and x1 = state
.winw
in
5603 and y1 = state
.winh
in
5604 filledrect1 (float x0) (float y0) (float x1) (float y1)
5605 | (Cmulti
_ | Csplit
_), _ | Csingle
_, [] ->
5606 GlClear.color (scalecolor2 conf
.bgcolor
);
5607 GlClear.clear
[`
color];
5609 List.iter
drawpage state
.layout;
5611 match state
.mode with
5612 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5613 begin match getopaque pageno with
5615 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5616 let color = (0.0, 0.0, 0.5, 0.5) in
5623 | None
-> state
.rects
5625 | LinkNav
(Ltgendir
_) | LinkNav
(Ltnotready
_)
5628 | View
-> state
.rects
5631 let rec postloop linkindexbase
= function
5633 let linkindexbase = linkindexbase + postdrawpage l linkindexbase in
5634 postloop linkindexbase rest
5638 postloop 0 state
.layout;
5640 begin match state
.mstate
with
5641 | Mzoomrect
((x0, y0), (x1, y1)) ->
5643 GlDraw.color (0.3, 0.3, 0.3) ~
alpha:0.5;
5644 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5645 filledrect (float x0) (float y0) (float x1) (float y1);
5649 | Mscrolly
| Mscrollx
5658 let zoomrect x y x1 y1 =
5661 and y0 = min
y y1 in
5662 let zoom = (float state
.w) /. float (x1 - x0) in
5665 if state
.w < state
.winw
5666 then (state
.winw
- state
.w) / 2
5669 match conf
.fitmodel
with
5670 | FitWidth
| FitProportional
-> simple ()
5672 match conf
.columns
with
5674 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5675 | Cmulti
_ | Csingle
_ -> simple ()
5677 gotoxy ((state
.x + margin) - x0) (state
.y + y0);
5678 state
.anchor <- getanchor
();
5683 let annot inline
x y =
5684 match unproject x y with
5685 | Some
(opaque, n, ux
, uy
) ->
5687 addannot
opaque ux uy
text;
5688 wcmd "freepage %s" (~
> opaque);
5689 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5691 gotoxy state
.x state
.y
5695 let ondone s = add s in
5696 let mode = state
.mode in
5697 state
.mode <- Textentry
(
5698 ("annotation: ", E.s, None
, textentry, ondone, true),
5699 fun _ -> state
.mode <- mode);
5702 G.postRedisplay "annot"
5704 add @@ getusertext E.s
5709 let g opaque l px py =
5710 match rectofblock
opaque px py with
5712 let x0 = a.(0) -. 20. in
5713 let x1 = a.(1) +. 20. in
5714 let y0 = a.(2) -. 20. in
5715 let zoom = (float state
.w) /. (x1 -. x0) in
5716 let pagey = getpagey
l.pageno in
5717 let margin = (state
.w - l.pagew
)/2 in
5718 let nx = -truncate
x0 - margin in
5719 gotoxy_and_clear_text nx (pagey + truncate
y0);
5720 state
.anchor <- getanchor
();
5725 match conf
.columns
with
5727 impmsg "block zooming does not work properly in split columns mode"
5728 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5732 let winw = state
.winw - 1 in
5733 let s = float x /. float winw in
5734 let destx = truncate
(float (state
.w + winw) *. s) in
5735 gotoxy_and_clear_text (winw - destx) state
.y;
5736 state
.mstate
<- Mscrollx
;
5740 let s = float y /. float state
.winh
in
5741 let desty = truncate
(float (state
.maxy -
5742 (if conf
.maxhfit
then state
.winh
else 0))
5744 gotoxy_and_clear_text state
.x desty;
5745 state
.mstate
<- Mscrolly
;
5748 let viewmulticlick clicks
x y mask
=
5749 let g opaque l px py =
5757 if markunder
opaque px py mark
5761 match getopaque l.pageno with
5763 | Some
opaque -> pipesel opaque cmd
5765 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5766 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5771 G.postRedisplay "viewmulticlick";
5772 onppundermouse g x y (fun () -> impmsg "nothing to select") ();
5776 match conf
.columns
with
5778 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5781 let viewmouse button down
x y mask
=
5783 | n when (n == 4 || n == 5) && not down
->
5784 if Wsi.withctrl mask
5786 match state
.mstate
with
5787 | Mzoom
(oldn
, i
, (ftx
, fty
)) ->
5790 then abs
(ftx
- x) > 5 || abs
(fty
- y) > 5
5800 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5802 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5804 let zoom = conf
.zoom -. incr in
5806 then pivotzoom ~
x ~
y zoom
5807 else pivotzoom zoom;
5808 state
.mstate
<- Mzoom
(n, 0, (x, y));
5810 state
.mstate
<- Mzoom
(n, i
+1, (ftx
, fty
));
5812 else state
.mstate
<- Mzoom
(n, 0, (ftx
, fty
))
5816 | Mscrolly
| Mscrollx
5818 | Mnone
-> state
.mstate
<- Mzoom
(n, 0, (0, 0))
5821 match state
.autoscroll
with
5822 | Some step
-> setautoscrollspeed step
(n=4)
5824 if conf
.wheelbypage
|| conf
.presentation
5833 then -conf
.scrollstep
5834 else conf
.scrollstep
5836 let incr = incr * 2 in
5837 let y = clamp incr in
5838 gotoxy_and_clear_text state
.x y
5841 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5843 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
) in
5844 gotoxy_and_clear_text x state
.y
5846 | 1 when Wsi.withshift mask
->
5847 state
.mstate
<- Mnone
;
5850 match unproject x y with
5852 | Some
(_, pageno, ux
, uy
) ->
5853 let cmd = Printf.sprintf
5855 conf
.stcmd state
.path pageno ux uy
5857 match spawn
cmd [] with
5858 | (exception exn
) ->
5859 impmsg "execution of synctex command(%S) failed: %S"
5860 conf
.stcmd
@@ exntos exn
5864 | 1 when Wsi.withctrl mask
->
5867 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5868 state
.mstate
<- Mpan
(x, y)
5871 state
.mstate
<- Mnone
5876 if Wsi.withshift mask
5878 annot conf
.annotinline
x y;
5879 G.postRedisplay "addannot"
5883 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5884 state
.mstate
<- Mzoomrect
(p, p)
5887 match state
.mstate
with
5888 | Mzoomrect
((x0, y0), _) ->
5889 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5890 then zoomrect x0 y0 x y
5893 G.postRedisplay "kill accidental zoom rect";
5897 | Mscrolly
| Mscrollx
5903 | 1 when vscrollhit x ->
5906 let _, position, sh = state
.uioh#
scrollph in
5907 if y > truncate
position && y < truncate
(position +. sh)
5908 then state
.mstate
<- Mscrolly
5911 state
.mstate
<- Mnone
5913 | 1 when y > state
.winh
- hscrollh () ->
5916 let _, position, sw = state
.uioh#scrollpw
in
5917 if x > truncate
position && x < truncate
(position +. sw)
5918 then state
.mstate
<- Mscrollx
5921 state
.mstate
<- Mnone
5923 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5926 let dest = if down
then getunder x y else Unone
in
5927 begin match dest with
5931 | Unone
when down
->
5932 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5933 state
.mstate
<- Mpan
(x, y);
5935 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5937 | Unone
| Utext
_ ->
5942 state
.mstate
<- Msel
((x, y), (x, y));
5943 G.postRedisplay "mouse select";
5947 match state
.mstate
with
5950 | Mzoom
_ | Mscrollx
| Mscrolly
->
5951 state
.mstate
<- Mnone
5953 | Mzoomrect
((x0, y0), _) ->
5957 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5958 state
.mstate
<- Mnone
5960 | Msel
((x0, y0), (x1, y1)) ->
5961 let rec loop = function
5965 let a0 = l.pagedispy in
5966 let a1 = a0 + l.pagevh in
5967 let b0 = l.pagedispx in
5968 let b1 = b0 + l.pagevw in
5969 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5970 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5974 match getopaque l.pageno with
5977 match Unix.pipe
() with
5978 | (exception exn
) ->
5979 impmsg "cannot create sel pipe: %s" @@
5983 Ne.clo fd
(fun msg
->
5984 dolog
"%s close failed: %s" what msg
)
5987 try spawn
cmd [r, 0; w, -1]
5989 dolog
"cannot execute %S: %s"
5996 G.postRedisplay "copysel";
5998 else clo "Msel pipe/w" w;
5999 clo "Msel pipe/r" r;
6001 dosel conf
.selcmd
();
6002 state
.roam
<- dosel conf
.paxcmd
;
6014 let birdseyemouse button down
x y mask
6015 (conf
, leftx
, _, hooverpageno
, anchor) =
6018 let rec loop = function
6021 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6022 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6024 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6030 | _ -> viewmouse button down
x y mask
6036 method key key mask
=
6037 begin match state
.mode with
6038 | Textentry
textentry -> textentrykeyboard key mask
textentry
6039 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6040 | View
-> viewkeyboard key mask
6041 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6045 method button button bstate
x y mask
=
6046 begin match state
.mode with
6048 | View
-> viewmouse button bstate
x y mask
6049 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6054 method multiclick clicks
x y mask
=
6055 begin match state
.mode with
6057 | View
-> viewmulticlick clicks
x y mask
6064 begin match state
.mode with
6066 | View
| Birdseye
_ | LinkNav
_ ->
6067 match state
.mstate
with
6068 | Mzoom
_ | Mnone
-> ()
6073 state
.mstate
<- Mpan
(x, y);
6074 let x = if canpan () then panbound (state
.x + dx) else state
.x in
6076 gotoxy_and_clear_text x y
6079 state
.mstate
<- Msel
(a, (x, y));
6080 G.postRedisplay "motion select";
6083 let y = min state
.winh
(max
0 y) in
6087 let x = min state
.winw (max
0 x) in
6090 | Mzoomrect
(p0
, _) ->
6091 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6092 G.postRedisplay "motion zoomrect";
6096 method pmotion
x y =
6097 begin match state
.mode with
6098 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6099 let rec loop = function
6101 if hooverpageno
!= -1
6103 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6104 G.postRedisplay "pmotion birdseye no hoover";
6107 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6108 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6110 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6111 G.postRedisplay "pmotion birdseye hoover";
6121 match state
.mstate
with
6122 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6130 let past, _, _ = !r in
6132 let delta = now -. past in
6135 else r := (now, x, y)
6139 method infochanged
_ = ()
6142 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6145 then 0.0, float state
.winh
6146 else scrollph state
.y maxy
6151 let fwinw = float (state
.winw - vscrollw ()) in
6153 let sw = fwinw /. float state
.w in
6154 let sw = fwinw *. sw in
6155 max
sw (float conf
.scrollh
)
6158 let maxx = state
.w + state
.winw in
6159 let x = state
.winw - state
.x in
6160 let percent = float x /. float maxx in
6161 (fwinw -. sw) *. percent
6163 hscrollh (), position, sw
6167 match state
.mode with
6168 | LinkNav
_ -> "links"
6169 | Textentry
_ -> "textentry"
6170 | Birdseye
_ -> "birdseye"
6173 findkeyhash conf
modename
6175 method eformsgs
= true
6176 method alwaysscrolly
= false
6179 let addrect pageno r g b a x0 y0 x1 y1 =
6180 Hashtbl.add state
.prects
pageno [|r; g; b; a; x0; y0; x1; y1|];
6184 let cl = splitatchar cmds ' '
in
6186 try Scanf.sscanf
s fmt
f
6188 adderrfmt "remote exec"
6189 "error processing '%S': %s\n" cmds
@@ exntos exn
6191 let rectx s pageno (r, g, b, a) x0 y0 x1 y1 =
6192 vlog "%s page %d color (%f %f %f %f) x0,y0,x1,y1 = %f %f %f %f"
6193 s pageno r g b a x0 y0 x1 y1;
6197 let _,w1,h1
,_ = getpagedim
pageno in
6198 let sw = float w1 /. float w
6199 and sh = float h1
/. float h in
6203 and y1s
= y1 *. sh in
6204 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6205 let color = (r, g, b, a) in
6206 if conf
.verbose
then debugrect rect;
6207 state
.rects <- (pageno, color, rect) :: state
.rects;
6212 | "reload", "" -> reload ()
6214 scan args
"%u %f %f"
6216 let cmd, _ = state
.geomcmds
in
6218 then gotopagexy !wtmode pageno x y
6221 gotopagexy !wtmode pageno x y;
6224 state
.reprf
<- f state
.reprf
6226 | "goto1", args
-> scan args
"%u %f" gotopage
6229 (fun _filename _pageno
->
6230 failwith
"gotounder (Uremote (filename, pageno))")
6233 (fun _filename _dest
->
6234 failwith
"gotounder (Uremotedest (filename, dest))")
6236 scan args
"%u %u %f %f %f %f"
6237 (fun pageno c x0 y0 x1 y1 ->
6238 let color = (0.0, 0.0, 1.0 /. float c, 0.5) in
6239 rectx "rect" pageno color x0 y0 x1 y1;
6242 scan args
"%u %f %f %f %f %f %f %f %f"
6243 (fun pageno r g b alpha x0 y0 x1 y1 ->
6244 addrect pageno r g b alpha x0 y0 x1 y1;
6245 G.postRedisplay "prect"
6248 scan args
"%u %f %f"
6251 match getopaque pageno with
6252 | Some
opaque -> opaque
6255 pgoto optopaque pageno x y;
6256 let rec fixx = function
6259 if l.pageno = pageno
6260 then gotoxy (state
.x - l.pagedispx) state
.y
6265 match conf
.columns
with
6266 | Csingle
_ | Csplit
_ -> 1
6267 | Cmulti
((n, _, _), _) -> n
6269 layout 0 state
.y (state
.winw * mult) state
.winh
6273 | "activatewin", "" -> Wsi.activatewin
()
6274 | "quit", "" -> raise Quit
6277 let l = Config.keys_of_string
keys in
6278 List.iter
(fun (k
, m) -> keyboard k
m) l
6280 adderrfmt "error processing keys" "`%S': %s\n" cmds
@@ exntos exn
6282 | "clearrects", "" ->
6283 Hashtbl.clear state
.prects
;
6284 G.postRedisplay "clearrects"
6286 adderrfmt "remote command"
6287 "error processing remote command: %S\n" cmds
;
6291 let scratch = Bytes.create
80 in
6292 let buf = Buffer.create
80 in
6294 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6295 | (exception Unix.Unix_error
(Unix.EAGAIN
, _, _)) -> None
6298 if Buffer.length
buf > 0
6300 let s = Buffer.contents
buf in
6308 match Bytes.index_from
scratch ppos '
\n'
with
6309 | pos -> if pos >= n then -1 else pos
6310 | (exception Not_found
) -> -1
6314 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6315 let s = Buffer.contents
buf in
6321 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6327 let remoteopen path =
6328 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6330 adderrfmt "remoteopen" "error opening %S: %s" path @@ exntos exn
;
6335 let gcconfig = ref E.s in
6336 let trimcachepath = ref E.s in
6337 let rcmdpath = ref E.s in
6338 let pageno = ref None
in
6339 let rootwid = ref 0 in
6340 let openlast = ref false in
6341 let nofc = ref false in
6342 let doreap = ref false in
6343 let csspath = ref None
in
6344 selfexec := Sys.executable_name
;
6347 [("-p", Arg.String
(fun s -> state
.password <- s),
6348 "<password> Set password");
6352 Config.fontpath
:= s;
6353 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6355 "<path> Set path to the user interface font");
6359 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6360 Config.confpath
:= s),
6361 "<path> Set path to the configuration file");
6363 ("-last", Arg.Set
openlast, " Open last document");
6365 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6366 "<page-number> Jump to page");
6368 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6369 "<path> Set path to the trim cache file");
6371 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6372 "<named-destination> Set named destination");
6374 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6375 ("-cxack", Arg.Set
cxack, " Cut corners");
6377 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6378 "<path> Set path to the source of remote commands");
6380 ("-gc", Arg.Set_string
gcconfig,
6381 "<path> Collect garbage with the help of a script");
6383 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6385 ("-v", Arg.Unit
(fun () ->
6387 "%s\nconfiguration path: %s\n"
6390 exit
0), " Print version and exit");
6392 ("-css", Arg.String
(fun s -> csspath := Some
s),
6393 "<path> Set path to the style sheet to use with EPUB/HTML");
6395 ("-embed", Arg.Set_int
rootwid, "<window-id> Embed into window");
6397 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6398 "<origin> <undocumented>");
6401 (fun s -> state
.path <- s)
6402 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:");
6405 then selfexec := !selfexec ^
" -wtmode";
6407 let histmode = emptystr state
.path && not
!openlast in
6409 if not
(Config.load !openlast)
6410 then dolog
"failed to load configuration";
6412 begin match !pageno with
6413 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6417 if nonemptystr
!gcconfig
6420 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6421 | (exception exn
) -> error
"socketpair for gc failed: %s" @@ exntos exn
6424 match spawn
!gcconfig [(c, 0); (c, 1); (s, -1)] with
6425 | (exception exn
) -> error
"failed to execute gc script: %s" @@ exntos exn
6427 Ne.clo c @@ (fun s -> error
"failed to close gc fd %s" s);
6434 val mutable m_clicks
= 0
6435 val mutable m_click_x
= 0
6436 val mutable m_click_y
= 0
6437 val mutable m_lastclicktime
= infinity
6439 method private cleanup =
6440 state
.roam
<- noroam
;
6441 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6442 method expose
= G.postRedisplay "expose"
6446 | Wsi.Unobscured
-> "unobscured"
6447 | Wsi.PartiallyObscured
-> "partiallyobscured"
6448 | Wsi.FullyObscured
-> "fullyobscured"
6450 vlog "visibility change %s" name
6451 method display = display ()
6452 method map mapped
= vlog "mapped %b" mapped
6453 method reshape w h =
6456 method mouse
b d x y m =
6457 if d && canselect ()
6460 * http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx
6467 if abs
x - m_click_x
> 10
6468 || abs
y - m_click_y
> 10
6469 || abs_float
(t -. m_lastclicktime
) > 0.3
6471 m_clicks
<- m_clicks
+ 1;
6472 m_lastclicktime
<- t;
6476 G.postRedisplay "cleanup";
6477 state
.uioh <- state
.uioh#button
b d x y m;
6479 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6484 m_lastclicktime
<- infinity
;
6485 state
.uioh <- state
.uioh#button
b d x y m
6489 state
.uioh <- state
.uioh#button
b d x y m
6492 state
.mpos
<- (x, y);
6493 state
.uioh <- state
.uioh#motion
x y
6494 method pmotion
x y =
6495 state
.mpos
<- (x, y);
6496 state
.uioh <- state
.uioh#pmotion
x y
6498 let mascm = m land (
6499 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6502 let x = state
.x and y = state
.y in
6504 if x != state
.x || y != state
.y then self#
cleanup
6506 match state
.keystate
with
6508 let km = k
, mascm in
6511 let modehash = state
.uioh#
modehash in
6512 try Hashtbl.find modehash km
6514 try Hashtbl.find (findkeyhash conf
"global") km
6515 with Not_found
-> KMinsrt
(k
, m)
6517 | KMinsrt
(k
, m) -> keyboard k
m
6518 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6519 | KMmulti
(l, r) -> state
.keystate
<- KSinto
(l, r)
6521 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6522 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6523 state
.keystate
<- KSnone
6524 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6525 state
.keystate
<- KSinto
(keys, insrt
)
6526 | KSinto
_ -> state
.keystate
<- KSnone
6529 state
.mpos
<- (x, y);
6530 state
.uioh <- state
.uioh#pmotion
x y
6531 method leave = state
.mpos
<- (-1, -1)
6532 method winstate wsl
= state
.winstate
<- wsl
6533 method quit
= raise Quit
6536 let wsfd, winw, winh
= Wsi.init
mu !rootwid conf
.cwinw conf
.cwinh platform
in
6538 setbgcol conf
.bgcolor
;
6541 if not
@@ List.exists
GlMisc.check_extension
6542 [ "GL_ARB_texture_rectangle"
6543 ; "GL_EXT_texture_recangle"
6544 ; "GL_NV_texture_rectangle" ]
6545 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6547 if substratis
(GlMisc.get_string `renderer
) 0 "Mesa DRI Intel("
6549 defconf
.sliceheight
<- 1024;
6550 defconf
.texcount
<- 32;
6551 defconf
.usepbo
<- true;
6555 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6556 | (exception exn
) ->
6557 dolog
"socketpair failed: %s" @@ exntos exn
;
6565 setcheckers conf
.checkers
;
6567 opengl_has_pbo := GlMisc.check_extension
"GL_ARB_pixel_buffer_object";
6569 begin match !csspath with
6571 | Some
"" -> conf
.css
<- E.s
6573 let css = filecontents
path in
6574 let l = String.length
css in
6576 if substratis
css (l-2) "\r\n"
6577 then String.sub css 0 (l-2)
6578 else (if css.[l-1] = '
\n'
6579 then String.sub css 0 (l-1)
6583 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6584 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6585 !Config.fontpath
, !trimcachepath, !opengl_has_pbo, not
!nofc
6587 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6589 reshape ~firsttime
:true winw winh
;
6593 Wsi.settitle
"llpp (history)";
6597 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6598 opendoc state
.path state
.password;
6602 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6603 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6606 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6607 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6608 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6610 | _pid
, _status
-> reap ()
6612 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6616 if nonemptystr
!rcmdpath
6617 then remoteopen !rcmdpath
6622 let rec loop deadline
=
6628 let r = [state
.ss; state
.wsfd] in
6632 | Some fd
-> fd
:: r
6636 state
.redisplay
<- false;
6643 if deadline
= infinity
6645 else max
0.0 (deadline
-. now)
6650 try Unix.select
r [] [] timeout
6651 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6657 if state
.ghyll
== noghyll
6659 match state
.autoscroll
with
6660 | Some step
when step
!= 0 ->
6661 let y = state
.y + step
in
6662 let fy = if conf
.maxhfit
then state
.winh
else 0 in
6665 then state
.maxy - fy
6666 else if y >= state
.maxy - fy then 0 else y
6668 if state
.mode = View
6669 then gotoxy_and_clear_text state
.x y
6670 else gotoxy state
.x y;
6673 else deadline
+. 0.01
6678 let rec checkfds = function
6680 | fd
:: rest
when fd
= state
.ss ->
6681 let cmd = rcmd state
.ss in
6685 | fd
:: rest
when fd
= state
.wsfd ->
6689 | fd
:: rest
when Some fd
= !optrfd ->
6690 begin match remote fd
with
6691 | None
-> optrfd := remoteopen !rcmdpath;
6692 | opt -> optrfd := opt
6697 dolog
"select returned unknown descriptor";
6703 if deadline
= infinity
6707 match state
.autoscroll
with
6708 | Some step
when step
!= 0 -> deadline1
6709 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6714 match loop infinity
with
6716 Config.save leavebirdseye;
6717 if hasunsavedchanges
()
6719 | _ -> error
"umpossible - infinity reached"