6 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
7 external seltext
: opaque
-> (int * int * int * int) -> unit = "ml_seltext";;
8 external hassel
: opaque
-> bool = "ml_hassel";;
9 external copysel
: Unix.file_descr
-> opaque
-> unit = "ml_copysel";;
10 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
11 external whatsunder
: opaque
-> int -> int -> under
= "ml_whatsunder";;
12 external markunder
: opaque
-> int -> int -> mark
-> bool = "ml_markunder";;
13 external clearmark
: opaque
-> unit = "ml_clearmark";;
14 external zoomforh
: int -> int -> int -> int -> float = "ml_zoom_for_height";;
15 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
16 external measurestr
: int -> string -> float = "ml_measure_string";;
17 external postprocess
:
18 opaque
-> int -> int -> int -> (int * string * int) -> int
20 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
21 external setaalevel
: int -> unit = "ml_setaalevel";;
22 external realloctexts
: int -> bool = "ml_realloctexts";;
23 external findlink
: opaque
-> linkdir
-> link
= "ml_findlink";;
24 external getlink
: opaque
-> int -> under
= "ml_getlink";;
25 external getlinkrect
: opaque
-> int -> irect
= "ml_getlinkrect";;
26 external getlinkcount
: opaque
-> int = "ml_getlinkcount";;
27 external findpwl
: int -> int -> pagewithlinks
= "ml_find_page_with_links";;
28 external getpbo
: width
-> height
-> colorspace
-> opaque
= "ml_getpbo";;
29 external freepbo
: opaque
-> unit = "ml_freepbo";;
30 external unmappbo
: opaque
-> unit = "ml_unmappbo";;
31 external pbousable
: unit -> bool = "ml_pbo_usable";;
32 external unproject
: opaque
-> int -> int -> (int * int) option
34 external drawtile
: tileparams
-> opaque
-> unit = "ml_drawtile";;
35 external rectofblock
: opaque
-> int -> int -> float array
option
37 external begintiles
: unit -> unit = "ml_begintiles";;
38 external endtiles
: unit -> unit = "ml_endtiles";;
39 external addannot
: opaque
-> int -> int -> string -> unit = "ml_addannot";;
40 external modannot
: opaque
-> slinkindex
-> string -> unit = "ml_modannot";;
41 external delannot
: opaque
-> slinkindex
-> unit = "ml_delannot";;
42 external hasunsavedchanges
: unit -> bool = "ml_hasunsavedchanges";;
43 external savedoc
: string -> unit = "ml_savedoc";;
44 external getannotcontents
: opaque
-> slinkindex
-> string
45 = "ml_getannotcontents";;
47 let selfexec = ref E.s
;;
49 let drawstring size x y s
=
51 Gl.enable `texture_2d
;
52 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
53 ignore
(drawstr size x y s
);
55 Gl.disable `texture_2d
;
58 let drawstring1 size x y s
=
62 let drawstring2 size x y fmt
=
63 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
67 dolog
"l %d dim=%d {" l
.pageno l
.pagedimno
;
68 dolog
" WxH %dx%d" l
.pagew l
.pageh
;
69 dolog
" vWxH %dx%d" l
.pagevw l
.pagevh
;
70 dolog
" pagex,y %d,%d" l
.pagex l
.pagey
;
71 dolog
" dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
72 dolog
" column %d" l
.pagecol
;
76 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
78 dolog
" x0,y0=(% f, % f)" x0 y0
;
79 dolog
" x1,y1=(% f, % f)" x1 y1
;
80 dolog
" x2,y2=(% f, % f)" x2 y2
;
81 dolog
" x3,y3=(% f, % f)" x3 y3
;
85 let isbirdseye = function
92 let istextentry = function
99 let wtmode = ref false;;
100 let cxack = ref false;;
102 let pgscale h
= truncate
(float h
*. conf
.pgscale);;
105 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbhv
= 0)
106 || (state
.x
= 0 && state
.w
<= state
.winw
- conf
.scrollbw
)
112 if not state
.uioh#alwaysscrolly
&& (conf
.scrollb
land scrollbvv
= 0)
117 let wadjsb () = -vscrollw ();;
118 let xadjsb () = if conf
.leftscroll
then vscrollw () else 0;;
121 fstate
.fontsize
<- n
;
122 fstate
.wwidth
<- measurestr fstate
.fontsize
"w";
123 fstate
.maxrows
<- (state
.winh
- fstate
.fontsize
- 1) / (fstate
.fontsize
+ 1);
129 else Printf.kprintf ignore fmt
133 if emptystr conf
.pathlauncher
134 then dolog
"%s" state
.path
136 let command = Str.global_replace percentsre state
.path conf
.pathlauncher
in
137 try addpid
@@ popen
command []
138 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
144 let postRedisplay who
=
145 vlog "redisplay for [%S]" who
;
146 state
.redisplay
<- true;
150 let getopaque pageno
=
151 try Some
(Hashtbl.find state
.pagemap
(pageno
, state
.gen
))
152 with Not_found
-> None
155 let putopaque pageno opaque
=
156 Hashtbl.replace state
.pagemap
(pageno
, state
.gen
) opaque
159 let pagetranslatepoint l x y
=
160 let dy = y
- l
.pagedispy
in
161 let y = dy + l
.pagey
in
162 let dx = x
- l
.pagedispx
in
163 let x = dx + l
.pagex
in
167 let onppundermouse g
x y d
=
170 begin match getopaque l
.pageno
with
172 let x0 = l
.pagedispx
in
173 let x1 = x0 + l
.pagevw
in
174 let y0 = l
.pagedispy
in
175 let y1 = y0 + l
.pagevh
in
176 if y >= y0 && y <= y1 && x >= x0 && x <= x1
178 let px, py
= pagetranslatepoint l
x y in
179 match g opaque l
px py
with
192 let g opaque l
px py
=
195 match rectofblock opaque
px py
with
197 let rect = (a
.(0),a
.(2),a
.(1),a
.(2),a
.(1),a
.(3),a
.(0),a
.(3)) in
198 state
.rects
<- [l
.pageno
, l
.pageno
mod 3, rect];
199 G.postRedisplay "getunder";
202 let under = whatsunder opaque
px py
in
203 if under = Unone
then None
else Some
under
205 onppundermouse g x y Unone
210 match unproject opaque
x y with
211 | Some
(x, y) -> Some
(Some
(opaque
, l
.pageno
, x, y))
214 onppundermouse g x y None
;
218 state
.text
<- Printf.sprintf
"%c%s" c s
;
219 G.postRedisplay "showtext";
222 let pipesel opaque cmd
=
225 match Unix.pipe
() with
228 (Printf.sprintf
"pipesel can not create pipe: %s" (exntos exn
));
230 let doclose what fd
=
231 Ne.clo fd
(fun msg
-> dolog
"%s close failed: %s" what msg
)
234 try popen cmd
[r
, 0; w
, -1]
236 dolog
"can not execute %S: %s" cmd
(exntos exn
);
242 G.postRedisplay "pipesel";
244 else doclose "pipesel pipe/w" w
;
245 doclose "pipesel pipe/r" r
;
249 let g opaque l
px py
=
250 if markunder opaque
px py conf
.paxmark
253 match getopaque l
.pageno
with
255 | Some opaque
-> pipesel opaque conf
.paxcmd
260 G.postRedisplay "paxunder";
261 if conf
.paxmark
= Mark_page
264 match getopaque l
.pageno
with
266 | Some opaque
-> clearmark opaque
) state
.layout
;
268 onppundermouse g x y (fun () -> showtext '
!'
"Whoopsie daisy");
272 match Unix.pipe
() with
274 showtext '
!'
(Printf.sprintf
"pipe failed: %s" (exntos exn
))
277 Ne.clo fd
(fun msg
->
278 showtext '
!'
(Printf.sprintf
"failed to close %s: %s" cap msg
)
282 try popen conf
.selcmd
[r
, 0; w
, -1]
285 (Printf.sprintf
"failed to execute %s: %s"
286 conf
.selcmd
(exntos exn
));
292 let l = String.length s
in
293 let bytes = Bytes.unsafe_of_string s
in
294 let n = tempfailureretry
(Unix.write w
bytes 0) l in
299 "failed to write %d characters to sel pipe, wrote %d"
304 (Printf.sprintf
"failed to write to sel pipe: %s"
309 clo "selstring pipe/r" r
;
310 clo "selstring pipe/w" w
;
313 let undertext ?
(nopath
=false) = function
316 | Ulinkgoto
(pageno
, _
) ->
318 then "page " ^ string_of_int
(pageno
+1)
319 else Printf.sprintf
"%s: page %d" state
.path
(pageno
+1)
320 | Utext s
-> "font: " ^ s
321 | Uunexpected s
-> "unexpected: " ^ s
322 | Ulaunch s
-> "launch: " ^ s
323 | Unamed s
-> "named: " ^ s
324 | Uremote
(filename
, pageno
) ->
325 Printf.sprintf
"%s: page %d" filename
(pageno
+1)
326 | Uremotedest
(filename
, destname
) ->
327 Printf.sprintf
"%s: destination %S" filename destname
328 | Uannotation
(opaque
, slinkindex
) ->
329 "annotation: " ^ getannotcontents opaque slinkindex
332 let updateunder x y =
333 match getunder x y with
334 | Unone
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
336 if conf
.underinfo
then showtext 'u'
("ri: " ^ uri
);
337 Wsi.setcursor
Wsi.CURSOR_INFO
338 | Ulinkgoto
(pageno
, _
) ->
340 then showtext 'p'
("age: " ^ string_of_int
(pageno
+1));
341 Wsi.setcursor
Wsi.CURSOR_INFO
343 if conf
.underinfo
then showtext '
f'
("ont: " ^ s
);
344 Wsi.setcursor
Wsi.CURSOR_TEXT
346 if conf
.underinfo
then showtext 'u'
("nexpected: " ^ s
);
347 Wsi.setcursor
Wsi.CURSOR_INHERIT
349 if conf
.underinfo
then showtext '
l'
("aunch: " ^ s
);
350 Wsi.setcursor
Wsi.CURSOR_INHERIT
352 if conf
.underinfo
then showtext '
n'
("amed: " ^ s
);
353 Wsi.setcursor
Wsi.CURSOR_INHERIT
354 | Uremote
(filename
, pageno
) ->
355 if conf
.underinfo
then showtext 'r'
356 (Printf.sprintf
"emote: %s (%d)" filename
(pageno
+1));
357 Wsi.setcursor
Wsi.CURSOR_INFO
358 | Uremotedest
(filename
, destname
) ->
359 if conf
.underinfo
then showtext 'r'
360 (Printf.sprintf
"emote destination: %s (%S)" filename destname
);
361 Wsi.setcursor
Wsi.CURSOR_INFO
363 if conf
.underinfo
then showtext 'a'
"nnotation";
364 Wsi.setcursor
Wsi.CURSOR_INFO
367 let showlinktype under =
368 if conf
.underinfo
&& under != Unone
369 then showtext ' '
@@ undertext under
372 let intentry_with_suffix text key
=
374 if key
>= 32 && key
< 127
378 match Char.lowercase
c with
380 let text = addchar
text c in
384 let text = addchar
text c in
388 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
393 let s = Bytes.create
4 in
394 let n = tempfailureretry
(Unix.read fd
s 0) 4 in
395 if n != 4 then error
"incomplete read(len) = %d" n;
396 let len = (Char.code
(Bytes.get
s 0) lsl 24)
397 lor (Char.code
(Bytes.get
s 1) lsl 16)
398 lor (Char.code
(Bytes.get
s 2) lsl 8)
399 lor (Char.code
(Bytes.get
s 3))
401 let s = Bytes.create
len in
402 let n = tempfailureretry
(Unix.read fd
s 0) len in
403 if n != len then error
"incomplete read(data) %d vs %d" n len;
408 let b = Buffer.create
16 in
409 Buffer.add_string
b "llll";
412 let s = Buffer.to_bytes
b in
413 let n = Bytes.length
s in
415 (* dolog "wcmd %S" (String.sub s 4 len); *)
416 Bytes.set
s 0 (Char.chr
((len lsr 24) land 0xff));
417 Bytes.set
s 1 (Char.chr
((len lsr 16) land 0xff));
418 Bytes.set
s 2 (Char.chr
((len lsr 8) land 0xff));
419 Bytes.set
s 3 (Char.chr
(len land 0xff));
420 let n'
= tempfailureretry
(Unix.write state
.ss
s 0) n in
421 if n'
!= n then error
"write failed %d vs %d" n'
n;
425 let nogeomcmds cmds
=
427 | s, [] -> emptystr
s
431 let layoutN ((columns
, coverA
, coverB
), b) y sh
=
432 let sh = sh - (hscrollh ()) in
433 let wadj = wadjsb () in
434 let rec fold accu
n =
435 if n = Array.length
b
438 let pdimno, dx, vy
, (_
, w
, h
, xoff
) = b.(n) in
441 || n = state
.pagecount
- coverB
442 || (n - coverA
) mod columns
= columns
- 1)
448 let pagey = max
0 (y - vy
) in
449 let pagedispy = if pagey > 0 then 0 else vy
- y in
450 let pagedispx, pagex
=
452 if n = coverA
- 1 || n = state
.pagecount
- coverB
453 then state
.x + (wadj + state
.winw
- w
) / 2
454 else dx + xoff
+ state
.x
461 let vw = wadj + state
.winw
- pagedispx in
462 let pw = w
- pagex
in
465 let pagevh = min
(h
- pagey) (sh - pagedispy) in
466 if pagevw > 0 && pagevh > 0
477 ; pagedispx = pagedispx
478 ; pagedispy = pagedispy
490 if Array.length
b = 0
492 else List.rev
(fold [] (page_of_y
y))
495 let layoutS (columns
, b) y sh =
496 let sh = sh - hscrollh () in
497 let wadj = wadjsb () in
498 let rec fold accu n =
499 if n = Array.length
b
502 let pdimno, px, vy
, (_
, pagew
, pageh
, xoff
) = b.(n) in
509 let x = xoff
+ state
.x in
510 let pagey = max
0 (y - vy
) in
511 let pagedispy = if pagey > 0 then 0 else vy
- y in
512 let pagedispx, pagex
=
526 let pagecolw = pagew
/columns
in
528 if pagecolw < state
.winw
529 then pagedispx + ((wadj + state
.winw
- pagecolw) / 2)
533 let vw = wadj + state
.winw
- pagedispx in
534 let pw = pagew
- pagex
in
537 let pagevw = min
pagevw pagecolw in
538 let pagevh = min
(pageh
- pagey) (sh - pagedispy) in
539 if pagevw > 0 && pagevh > 0
550 ; pagedispx = pagedispx
551 ; pagedispy = pagedispy
552 ; pagecol
= n mod columns
567 if nogeomcmds state
.geomcmds
569 match conf
.columns
with
570 | Csingle
b -> layoutN ((1, 0, 0), b) y sh
571 | Cmulti
c -> layoutN c y sh
572 | Csplit
s -> layoutS s y sh
577 let y = state
.y + incr
in
579 let y = min
y (state
.maxy
- (if conf
.maxhfit
then state
.winh
else 0)) in
584 let tilex = l.pagex
mod conf
.tilew
in
585 let tiley = l.pagey mod conf
.tileh
in
587 let col = l.pagex
/ conf
.tilew
in
588 let row = l.pagey / conf
.tileh
in
590 let xadj = xadjsb () in
591 let rec rowloop row y0 dispy h
=
595 let dh = conf
.tileh
- y0 in
597 let rec colloop col x0 dispx w
=
601 let dw = conf
.tilew
- x0 in
603 let dispx'
= xadj + dispx in
604 f col row dispx' dispy
x0 y0 dw dh;
605 colloop (col+1) 0 (dispx+dw) (w
-dw)
608 colloop col tilex l.pagedispx l.pagevw;
609 rowloop (row+1) 0 (dispy
+dh) (h
-dh)
612 if l.pagevw > 0 && l.pagevh > 0
613 then rowloop row tiley l.pagedispy l.pagevh;
616 let gettileopaque l col row =
618 l.pageno
, state
.gen
, conf
.colorspace
, conf
.angle
, l.pagew
, l.pageh
, col, row
620 try Some
(Hashtbl.find state
.tilemap
key)
621 with Not_found
-> None
624 let puttileopaque l col row gen colorspace angle opaque size elapsed
=
625 let key = l.pageno
, gen
, colorspace
, angle
, l.pagew
, l.pageh
, col, row in
626 Hashtbl.add state
.tilemap
key (opaque
, size
, elapsed
)
629 let filledrect x0 y0 x1 y1 =
630 GlArray.disable `texture_coord
;
631 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
632 GlArray.vertex `two state
.vraw
;
633 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
634 GlArray.enable `texture_coord
;
637 let linerect x0 y0 x1 y1 =
638 GlArray.disable `texture_coord
;
639 Raw.sets_float state
.vraw ~pos
:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
640 GlArray.vertex `two state
.vraw
;
641 GlArray.draw_arrays `line_loop ~first
:0 ~count
:4;
642 GlArray.enable `texture_coord
;
645 let drawtiles l color
=
647 let wadj = wadjsb () in
649 let f col row x y tilex tiley w h
=
650 match gettileopaque l col row with
651 | Some
(opaque
, _
, t
) ->
652 let params = x, y, w
, h
, tilex, tiley in
654 then GlTex.env
(`mode `blend
);
655 drawtile
params opaque
;
657 then GlTex.env
(`mode `modulate
);
661 let s = Printf.sprintf
665 let w = measurestr fstate
.fontsize
s in
666 GlDraw.color
(0.0, 0.0, 0.0);
667 filledrect (float (x-2))
670 (float (y + fstate
.fontsize
+ 2));
671 GlDraw.color
(1.0, 1.0, 1.0);
672 drawstring fstate
.fontsize
x (y + fstate
.fontsize
- 1) s;
682 let lw = wadj + state
.winw
- x in
685 let lh = state
.winh
- y in
689 then GlTex.env
(`mode `blend
);
690 begin match state
.checkerstexid
with
692 Gl.enable `texture_2d
;
693 GlTex.bind_texture ~target
:`texture_2d id
;
697 and y1 = float (y+h
) in
699 let tw = float w /. 16.0
700 and th
= float h
/. 16.0 in
701 let tx0 = float tilex /. 16.0
702 and ty0
= float tiley /. 16.0 in
704 and ty1
= ty0
+. th
in
705 Raw.sets_float state
.vraw ~pos
:0
706 [| x0; y0; x0; y1; x1; y0; x1; y1 |];
707 Raw.sets_float state
.traw ~pos
:0
708 [| tx0; ty0
; tx0; ty1
; tx1; ty0
; tx1; ty1
|];
709 GlArray.vertex `two state
.vraw
;
710 GlArray.tex_coord `two state
.traw
;
711 GlArray.draw_arrays `triangle_strip ~first
:0 ~count
:4;
712 Gl.disable `texture_2d
;
715 GlDraw.color
(1.0, 1.0, 1.0);
716 filledrect (float x) (float y) (float (x+w)) (float (y+h
));
719 then GlTex.env
(`mode `modulate
);
720 if w > 128 && h
> fstate
.fontsize
+ 10
722 let c = if conf
.invert
then 1.0 else 0.0 in
723 GlDraw.color
(c, c, c);
726 then (col*conf
.tilew
, row*conf
.tileh
)
729 drawstring2 fstate
.fontsize
x y "Loading %d [%d,%d]" l.pageno
c r
;
738 let pagevisible layout n = List.exists
(fun l -> l.pageno
= n) layout;;
740 let tilevisible1 l x y =
742 and ax1
= l.pagex
+ l.pagevw
744 and ay1
= l.pagey + l.pagevh in
748 let bx1 = min
(bx0 + conf
.tilew
) l.pagew
749 and by1
= min
(by0
+ conf
.tileh
) l.pageh
in
751 let rx0 = max
ax0 bx0
752 and ry0
= max ay0 by0
753 and rx1
= min ax1
bx1
754 and ry1
= min ay1 by1
in
756 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
760 let tilevisible layout n x y =
761 let rec findpageinlayout m
= function
762 | l :: rest
when l.pageno
= n ->
763 tilevisible1 l x y || (
764 match conf
.columns
with
765 | Csplit
(c, _
) when c > m
-> findpageinlayout (m
+1) rest
770 | _
:: rest
-> findpageinlayout 0 rest
773 findpageinlayout 0 layout;
776 let tileready l x y =
777 tilevisible1 l x y &&
778 gettileopaque l (x/conf
.tilew
) (y/conf
.tileh
) != None
781 let tilepage n p
layout =
782 let rec loop = function
786 let f col row _ _ _ _ _ _
=
787 if state
.currently
= Idle
789 match gettileopaque l col row with
792 let x = col*conf
.tilew
793 and y = row*conf
.tileh
in
795 let w = l.pagew
- x in
799 let h = l.pageh
- y in
804 then getpbo
w h conf
.colorspace
807 wcmd "tile %s %d %d %d %d %s"
808 (~
> p
) x y w h (~
> pbo);
811 l, p
, conf
.colorspace
, conf
.angle
,
812 state
.gen
, col, row, conf
.tilew
, conf
.tileh
821 if nogeomcmds state
.geomcmds
825 let preloadlayout y =
826 let y = if y < state
.winh
then 0 else y - state
.winh
in
827 let h = state
.winh
*3 in
833 if state
.currently
!= Idle
838 begin match getopaque l.pageno
with
840 wcmd "page %d %d" l.pageno
l.pagedimno
;
841 state
.currently
<- Loading
(l, state
.gen
);
843 tilepage l.pageno opaque pages
;
848 if nogeomcmds state
.geomcmds
854 if conf
.preload && state
.currently
= Idle
855 then load (preloadlayout state
.y);
858 let layoutready layout =
859 let rec fold all ls
=
862 let seen = ref false in
863 let allvisible = ref true in
864 let foo col row _ _ _ _ _ _
=
866 allvisible := !allvisible &&
867 begin match gettileopaque l col row with
873 fold (!seen && !allvisible) rest
876 let alltilesvisible = fold true layout in
881 let y = bound
y 0 state
.maxy
in
882 let y, layout, proceed
=
883 match conf
.maxwait
with
884 | Some time
when state
.ghyll
== noghyll
->
885 begin match state
.throttle
with
887 let layout = layout y state
.winh
in
888 let ready = layoutready layout in
892 state
.throttle
<- Some
(layout, y, now
());
894 else G.postRedisplay "gotoy showall (None)";
896 | Some
(_
, _
, started
) ->
897 let dt = now
() -. started
in
900 state
.throttle
<- None
;
901 let layout = layout y state
.winh
in
903 G.postRedisplay "maxwait";
910 let layout = layout y state
.winh
in
911 if not
!wtmode || layoutready layout
912 then G.postRedisplay "gotoy ready";
918 state
.layout <- layout;
919 begin match state
.mode
with
922 | Ltexact
(pageno
, linkno
) ->
923 let rec loop = function
925 state
.mode
<- LinkNav
(Ltgendir
0)
926 | l :: _
when l.pageno
= pageno
->
927 begin match getopaque pageno
with
928 | None
-> state
.mode
<- LinkNav
(Ltnotready
(pageno
, 0))
930 let x0, y0, x1, y1 = getlinkrect opaque linkno
in
931 if not
(x0 >= l.pagex
&& x1 <= l.pagex
+ l.pagevw
932 && y0 >= l.pagey && y1 <= l.pagey + l.pagevh)
933 then state
.mode
<- LinkNav
(Ltgendir
0)
935 | _
:: rest
-> loop rest
938 | Ltnotready _
| Ltgendir _
-> ()
944 begin match state
.mode
with
945 | Birdseye
(conf
, leftx
, pageno
, hooverpageno
, anchor
) ->
946 if not
(pagevisible layout pageno
)
948 match state
.layout with
951 state
.mode
<- Birdseye
(
952 conf
, leftx
, l.pageno
, hooverpageno
, anchor
957 | Ltnotready
(_
, dir
)
960 let rec loop = function
963 match getopaque l.pageno
with
964 | None
-> Ltnotready
(l.pageno
, dir
)
969 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
971 if dir
> 0 then LDfirst
else LDlast
977 | Lnotfound
-> loop rest
979 showlinktype (getlink opaque
n);
980 Ltexact
(l.pageno
, n)
984 state
.mode
<- LinkNav
linknav
992 state
.ghyll
<- noghyll
;
995 let mx, my
= state
.mpos
in
1000 let conttiling pageno opaque
=
1001 tilepage pageno opaque
1002 (if conf
.preload then preloadlayout state
.y else state
.layout)
1005 let gotoy_and_clear_text y =
1006 if not conf
.verbose
then state
.text <- E.s;
1010 let getanchory (n, top
, dtop
) =
1011 let y, h = getpageyh
n in
1012 if conf
.presentation
1014 let ips = calcips
h in
1015 y + truncate
(top
*.float h -. dtop
*.float ips) + ips;
1017 y + truncate
(top
*.float h -. dtop
*.float conf
.interpagespace
)
1020 let gotoanchor anchor
=
1021 gotoy (getanchory anchor
);
1025 cbput state
.hists
.nav
(getanchor
());
1029 let anchor = cbgetc state
.hists
.nav dir
in
1033 let gotoghyll1 single
y =
1034 let scroll f n a
b =
1035 (* http://devmaster.net/forums/topic/9796-ease-in-ease-out-algorithm/ *)
1037 let s x = 3.0*.x**2.0 -. 2.0*.x**3.0 in
1039 then s (float f /. float a
)
1042 then 1.0 -. s ((float (f-b) /. float (n-b)))
1048 let ins = float a
*. 0.5
1049 and outs
= float (n-b) *. 0.5 in
1051 ins +. outs
+. float ones
1053 let rec set nab
y sy
=
1054 let (_N
, _A
, _B
), y =
1057 let scl = if y > sy
then 2 else -2 in
1058 let _N, _
, _
= nab
in
1059 (_N,0,_N), y+conf
.scrollstep
*scl
1061 let sum = summa
_N _A _B
in
1062 let dy = float (y - sy
) in
1066 then state
.ghyll
<- noghyll
1069 let s = scroll n _N _A _B
in
1070 let y1 = y1 +. ((s *. dy) /. sum) in
1071 gotoy_and_clear_text (truncate
y1);
1072 state
.ghyll
<- gf (n+1) y1;
1076 | Some
y'
when single
-> set nab
y' state
.y
1077 | Some
y'
-> set (_N/2, 1, 1) y' state
.y
1079 gf 0 (float state
.y)
1082 match conf
.ghyllscroll
with
1083 | Some nab
when not conf
.presentation
->
1084 if state
.ghyll
== noghyll
1085 then set nab
y state
.y
1086 else state
.ghyll
(Some
y)
1088 gotoy_and_clear_text y
1091 let gotoghyll = gotoghyll1 false;;
1093 let gotopage n top
=
1094 let y, h = getpageyh
n in
1095 let y = y + (truncate
(top
*. float h)) in
1099 let gotopage1 n top
=
1100 let y = getpagey
n in
1105 let invalidate s f =
1110 match state
.geomcmds
with
1111 | ps
, [] when emptystr ps
->
1113 state
.geomcmds
<- s, [];
1116 state
.geomcmds
<- ps
, [s, f];
1118 | ps
, (s'
, _
) :: rest
when s'
= s ->
1119 state
.geomcmds
<- ps
, ((s, f) :: rest
);
1122 state
.geomcmds
<- ps
, ((s, f) :: cmds
);
1126 Hashtbl.iter
(fun _ opaque
->
1127 wcmd "freepage %s" (~
> opaque
);
1129 Hashtbl.clear state
.pagemap
;
1133 if not
(Queue.is_empty state
.tilelru
)
1135 Queue.iter
(fun (k
, p
, s) ->
1136 wcmd "freetile %s" (~
> p
);
1137 state
.memused
<- state
.memused
- s;
1138 Hashtbl.remove state
.tilemap k
;
1140 state
.uioh#infochanged Memused
;
1141 Queue.clear state
.tilelru
;
1147 let h = truncate
(float h*.conf
.zoom
) in
1148 let d = conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0) in
1152 let opendoc path password
=
1154 state
.password
<- password
;
1155 state
.gen
<- state
.gen
+ 1;
1156 state
.docinfo
<- [];
1157 state
.outlines
<- [||];
1160 setaalevel conf
.aalevel
;
1162 if emptystr state
.origin
1166 Wsi.settitle
("llpp " ^
(mbtoutf8
(Filename.basename
titlepath)));
1167 wcmd "open %d %d %s\000%s\000" (btod
!wtmode) (btod
!cxack) path password
;
1168 invalidate "reqlayout"
1170 wcmd "reqlayout %d %d %d %s\000"
1171 conf
.angle
(FMTE.to_int conf
.fitmodel
)
1172 (stateh state
.winh
) state
.nameddest
1177 state
.anchor <- getanchor
();
1178 opendoc state
.path state
.password
;
1182 let c = c *. conf
.colorscale
in
1186 let scalecolor2 (r
, g, b) =
1187 (r
*. conf
.colorscale
, g *. conf
.colorscale
, b *. conf
.colorscale
);
1190 let docolumns columns
=
1191 let wadj = wadjsb () in
1194 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1195 let wadj = wadjsb () in
1196 let rec loop pageno
pdimno pdim
y ph pdims
=
1197 if pageno
= state
.pagecount
1200 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1202 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1203 pdimno+1, pdim
, rest
1207 let x = max
0 (((wadj + state
.winw
- w) / 2) - xoff
) in
1209 (if conf
.presentation
1210 then (if pageno
= 0 then calcips
h else calcips ph
+ calcips
h)
1211 else (if pageno
= 0 then 0 else conf
.interpagespace
)
1214 a.(pageno
) <- (pdimno, x, y, pdim
);
1215 loop (pageno
+1) pdimno pdim
(y + h) h pdims
1217 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 state
.pdims
;
1218 conf
.columns
<- Csingle
a;
1220 | Cmulti
((columns
, coverA
, coverB
), _
) ->
1221 let a = Array.make state
.pagecount
(-1, -1, -1, (-1, -1, -1, -1)) in
1222 let rec loop pageno
pdimno pdim
x y rowh pdims
=
1223 let rec fixrow m
= if m
= pageno
then () else
1224 let (pdimno, x, y, ((_
, _
, h, _
) as pdim
)) = a.(m
) in
1227 let y = y + (rowh
- h) / 2 in
1228 a.(m
) <- (pdimno, x, y, pdim
);
1232 if pageno
= state
.pagecount
1233 then fixrow (((pageno
- 1) / columns
) * columns
)
1235 let pdimno, ((_
, w, h, xoff
) as pdim
), pdims
=
1237 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1238 pdimno+1, pdim
, rest
1243 if pageno
= coverA
- 1 || pageno
= state
.pagecount
- coverB
1245 let x = (wadj + state
.winw
- w) / 2 in
1247 if conf
.presentation
then calcips
h else conf
.interpagespace
in
1248 x, y + ips + rowh
, h
1251 if (pageno
- coverA
) mod columns
= 0
1253 let x = max
0 (wadj + state
.winw
- state
.w) / 2 in
1255 if conf
.presentation
1257 let ips = calcips
h in
1258 y + (if pageno
= 0 then 0 else calcips rowh
+ ips)
1260 y + (if pageno
= 0 then 0 else conf
.interpagespace
)
1264 else x, y, max rowh
h
1268 if pageno
> 1 && (pageno
- coverA
) mod columns
= 0
1271 if pageno
= columns
&& conf
.presentation
1273 let ips = calcips rowh
in
1274 for i
= 0 to pred columns
1276 let (pdimno, x, y, pdim
) = a.(i
) in
1277 a.(i
) <- (pdimno, x, y+ips, pdim
)
1283 fixrow (pageno
- columns
);
1288 a.(pageno
) <- (pdimno, x, y, pdim
);
1289 let x = x + w + xoff
*2 + conf
.interpagespace
in
1290 loop (pageno
+1) pdimno pdim
x y rowh' pdims
1292 loop 0 ~
-1 (-1,-1,-1,-1) 0 0 0 state
.pdims
;
1293 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), a);
1296 let a = Array.make
(state
.pagecount
*c) (-1, -1, -1, (-1, -1, -1, -1)) in
1297 let rec loop pageno
pdimno pdim
y pdims
=
1298 if pageno
= state
.pagecount
1301 let pdimno, ((_
, w, h, _
) as pdim
), pdims
=
1303 | ((pageno'
, _
, _
, _
) as pdim
) :: rest
when pageno'
= pageno
->
1304 pdimno+1, pdim
, rest
1309 let rec loop1 n x y =
1310 if n = c then y else (
1311 a.(pageno
*c + n) <- (pdimno, x, y, pdim
);
1312 loop1 (n+1) (x+cw) (y + h + conf
.interpagespace
)
1315 let y = loop1 0 0 y in
1316 loop (pageno
+1) pdimno pdim
y pdims
1318 loop 0 ~
-1 (-1,-1,-1,-1) 0 state
.pdims
;
1319 conf
.columns
<- Csplit
(c, a);
1323 docolumns conf
.columns
;
1324 state
.maxy
<- calcheight
();
1325 if state
.reprf
== noreprf
1327 match state
.mode
with
1328 | Birdseye
(_
, _
, pageno
, _
, _
) ->
1329 let y, h = getpageyh pageno
in
1330 let top = (state
.winh
- h) / 2 in
1331 gotoy (max
0 (y - top))
1334 | LinkNav _
-> gotoanchor state
.anchor
1338 state
.reprf
<- noreprf
;
1342 let reshape ?
(firsttime
=false) w h =
1343 GlDraw.viewport ~
x:0 ~
y:0 ~
w:w ~
h:h;
1344 if not firsttime
&& nogeomcmds state
.geomcmds
1345 then state
.anchor <- getanchor
();
1348 let w = wadjsb () + (truncate
(float w *. conf
.zoom
)) in
1351 setfontsize fstate
.fontsize
;
1352 GlMat.mode `modelview
;
1353 GlMat.load_identity
();
1355 GlMat.mode `projection
;
1356 GlMat.load_identity
();
1357 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1358 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1359 GlMat.scale3
(2.0 /. float state
.winw
, 2.0 /. float state
.winh
, 1.0);
1364 else float state
.x /. float state
.w
1366 invalidate "geometry"
1370 then state
.x <- truncate
(relx *. float w);
1372 match conf
.columns
with
1374 | Cmulti
((c, _
, _
), _
) -> (w - (c-1)*conf
.interpagespace
) / c
1375 | Csplit
(c, _
) -> w * c
1377 wcmd "geometry %d %d %d"
1378 w (stateh h) (FMTE.to_int conf
.fitmodel
)
1383 let len = String.length state
.text in
1384 let x0 = xadjsb () in
1387 match state
.mode
with
1388 | Textentry _
| View
| LinkNav _
->
1389 let h, _
, _
= state
.uioh#scrollpw
in
1394 filledrect x (float (state
.winh
- (fstate
.fontsize
+ 4) - hscrollh))
1395 (x+.w) (float (state
.winh
- hscrollh))
1398 let w = float (wadjsb () + state
.winw
- 1) in
1399 if state
.progress
>= 0.0 && state
.progress
< 1.0
1401 GlDraw.color
(0.3, 0.3, 0.3);
1402 let w1 = w *. state
.progress
in
1404 GlDraw.color
(0.0, 0.0, 0.0);
1405 rect (float x0+.w1) (float x0+.w-.w1)
1408 GlDraw.color
(0.0, 0.0, 0.0);
1412 GlDraw.color
(1.0, 1.0, 1.0);
1413 drawstring fstate
.fontsize
1414 (if conf
.leftscroll
then x0 + 2 else x0 + if len > 0 then 8 else 2)
1415 (state
.winh
- hscrollh - 5) s;
1418 match state
.mode
with
1419 | Textentry
((prefix
, text, _
, _
, _
, _
), _
) ->
1423 Printf.sprintf
"%s%s_ [%s]" prefix
text state
.text
1425 Printf.sprintf
"%s%s_" prefix
text
1431 | LinkNav _
-> state
.text
1436 if not
(istextentry state
.mode
) && state
.uioh#eformsgs
1438 let s1 = "(press 'e' to review error messasges)" in
1439 if nonemptystr
s then s ^
" " ^
s1 else s1
1449 let len = Queue.length state
.tilelru
in
1451 match state
.throttle
with
1454 then preloadlayout state
.y
1456 | Some
(layout, _
, _
) ->
1460 if state
.memused
<= conf
.memlimit
1465 let (k
, p
, s) as lruitem
= Queue.pop state
.tilelru
in
1466 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1467 let (_
, pw, ph
, _
) = getpagedim
n in
1470 && colorspace
= conf
.colorspace
1471 && angle
= conf
.angle
1475 let x = col*conf
.tilew
1476 and y = row*conf
.tileh
in
1477 tilevisible (Lazy.force_val
layout) n x y
1479 then Queue.push lruitem state
.tilelru
1482 wcmd "freetile %s" (~
> p
);
1483 state
.memused
<- state
.memused
- s;
1484 state
.uioh#infochanged Memused
;
1485 Hashtbl.remove state
.tilemap k
;
1493 let onpagerect pageno
f =
1495 match conf
.columns
with
1496 | Cmulti
(_
, b) -> b
1498 | Csplit
(_
, b) -> b
1500 if pageno
>= 0 && pageno
< Array.length
b
1502 let (_
, _
, _
, (_
, w, h, _
)) = b.(pageno
) in
1506 let gotopagexy1 pageno
x y =
1507 let _,w1,h1
,leftx
= getpagedim pageno
in
1508 let top = y /. (float h1
) in
1509 let left = x /. (float w1) in
1510 let py, w, h = getpageywh pageno
in
1511 let wh = state
.winh
- hscrollh () in
1512 let x = left *. (float w) in
1513 let x = leftx
+ state
.x + truncate
x in
1514 let wadj = wadjsb () in
1516 if x < 0 || x >= wadj + state
.winw
1520 let pdy = truncate
(top *. float h) in
1521 let y'
= py + pdy in
1522 let dy = y'
- state
.y in
1524 if x != state
.x || not
(dy > 0 && dy < wh)
1526 if conf
.presentation
1528 if abs
(py - y'
) > wh
1535 if state
.x != sx || state
.y != sy
1540 let ww = wadj + state
.winw
in
1542 and qy
= pdy / wh in
1544 and y = py + qy
* wh in
1545 let x = if -x + ww > w1 then -(w1-ww) else x
1546 and y'
= if y + wh > state
.maxy
then state
.maxy
- wh else y in
1548 if conf
.presentation
1550 if abs
(py - y'
) > wh
1560 gotoy_and_clear_text y;
1562 else gotoy_and_clear_text state
.y;
1565 let gotopagexy pageno
x y =
1566 match state
.mode
with
1567 | Birdseye
_ -> gotopage pageno
0.0
1570 | LinkNav
_ -> gotopagexy1 pageno
x y
1573 let getpassword () =
1574 let passcmd = getenvwithdef
"LLPP_ASKPASS" conf
.passcmd in
1579 showtext '
!'
@@ "error getting password: " ^
s;
1580 dolog
"%s" s) passcmd;
1584 (* dolog "%S" cmds; *)
1585 let cl = splitatspace cmds
in
1587 try Scanf.sscanf
s fmt
f
1589 dolog
"error processing '%S': %s" cmds
(exntos exn
);
1592 let addoutline outline
=
1593 match state
.currently
with
1594 | Outlining outlines
->
1595 state
.currently
<- Outlining
(outline
:: outlines
)
1596 | Idle
-> state
.currently
<- Outlining
[outline
]
1599 dolog
"invalid outlining state";
1600 logcurrently state
.currently
1604 state
.uioh#infochanged Pdim
;
1607 | "clearrects" :: [] ->
1608 state
.rects
<- state
.rects1
;
1609 G.postRedisplay "clearrects";
1611 | "continue" :: args
:: [] ->
1612 let n = scan args
"%u" (fun n -> n) in
1613 state
.pagecount
<- n;
1614 begin match state
.currently
with
1616 state
.currently
<- Idle
;
1617 state
.outlines
<- Array.of_list
(List.rev
l)
1623 let cur, cmds
= state
.geomcmds
in
1625 then failwith
"umpossible";
1627 begin match List.rev cmds
with
1629 state
.geomcmds
<- E.s, [];
1630 state
.throttle
<- None
;
1634 state
.geomcmds
<- s, List.rev rest
;
1636 if conf
.maxwait
= None
&& not
!wtmode
1637 then G.postRedisplay "continue";
1639 | "msg" :: args
:: [] ->
1642 | "vmsg" :: args
:: [] ->
1644 then showtext ' ' args
1646 | "emsg" :: args
:: [] ->
1647 Buffer.add_string state
.errmsgs args
;
1648 state
.newerrmsgs
<- true;
1649 G.postRedisplay "error message"
1651 | "progress" :: args
:: [] ->
1652 let progress, text =
1655 f, String.sub args pos
(String.length args
- pos
))
1658 state
.progress <- progress;
1659 G.postRedisplay "progress"
1661 | "firstmatch" :: args
:: [] ->
1662 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1663 scan args
"%u %d %f %f %f %f %f %f %f %f"
1664 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1665 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1667 let xoff = float (xadjsb ()) in
1671 and x3
= x3
+. xoff in
1672 let y = (getpagey
pageno) + truncate
y0 in
1675 state
.rects1
<- [pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)]
1677 | "match" :: args
:: [] ->
1678 let pageno, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
=
1679 scan args
"%u %d %f %f %f %f %f %f %f %f"
1680 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1681 (p
, c, x0, y0, x1, y1, x2
, y2
, x3
, y3
))
1683 let xoff = float (xadjsb ()) in
1687 and x3
= x3
+. xoff in
1689 (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) :: state
.rects1
1691 | "page" :: args
:: [] ->
1692 let pageopaques, t
= scan args
"%s %f" (fun p t
-> p
, t
) in
1693 let pageopaque = ~
< pageopaques in
1694 begin match state
.currently
with
1695 | Loading
(l, gen
) ->
1696 vlog "page %d took %f sec" l.pageno t
;
1697 Hashtbl.replace state
.pagemap
(l.pageno, gen
) pageopaque;
1698 begin match state
.throttle
with
1700 let preloadedpages =
1702 then preloadlayout state
.y
1707 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1708 IntSet.empty
preloadedpages
1711 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1712 if not
(IntSet.mem
pageno set)
1714 wcmd "freepage %s" (~
> opaque
);
1720 List.iter
(Hashtbl.remove state
.pagemap
) evictedpages;
1723 state
.currently
<- Idle
;
1726 tilepage l.pageno pageopaque state
.layout;
1728 load preloadedpages;
1729 let visible = pagevisible state
.layout l.pageno in
1732 match state
.mode
with
1733 | LinkNav
(Ltnotready
(pageno, dir
)) ->
1734 if pageno = l.pageno
1739 then LDfirstvisible
(l.pagex
, l.pagey, dir
)
1741 if dir
> 0 then LDfirst
else LDlast
1744 findlink
pageopaque ld
1749 showlinktype (getlink
pageopaque n);
1750 state
.mode
<- LinkNav
(Ltexact
(l.pageno, n))
1752 | LinkNav
(Ltgendir
_)
1753 | LinkNav
(Ltexact
_)
1759 if visible && layoutready state
.layout
1761 G.postRedisplay "page";
1765 | Some
(layout, _, _) ->
1766 state
.currently
<- Idle
;
1767 tilepage l.pageno pageopaque layout;
1774 dolog
"Inconsistent loading state";
1775 logcurrently state
.currently
;
1779 | "tile" :: args
:: [] ->
1780 let (x, y, opaques
, size
, t
) =
1781 scan args
"%u %u %s %u %f"
1782 (fun x y p size t
-> (x, y, p
, size
, t
))
1784 let opaque = ~
< opaques
in
1785 begin match state
.currently
with
1786 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1787 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1790 if tilew
!= conf
.tilew
|| tileh
!= conf
.tileh
1792 wcmd "freetile %s" (~
> opaque);
1793 state
.currently
<- Idle
;
1797 puttileopaque l col row gen cs angle
opaque size t
;
1798 state
.memused
<- state
.memused
+ size
;
1799 state
.uioh#infochanged Memused
;
1801 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1802 opaque, size
) state
.tilelru
;
1805 match state
.throttle
with
1806 | None
-> state
.layout
1807 | Some
(layout, _, _) -> layout
1810 state
.currently
<- Idle
;
1812 && conf
.colorspace
= cs
1813 && conf
.angle
= angle
1814 && tilevisible layout l.pageno x y
1815 then conttiling l.pageno pageopaque;
1817 begin match state
.throttle
with
1819 preload state
.layout;
1821 && conf
.colorspace
= cs
1822 && conf
.angle
= angle
1823 && tilevisible state
.layout l.pageno x y
1824 && (not
!wtmode || layoutready state
.layout)
1825 then G.postRedisplay "tile nothrottle";
1827 | Some
(layout, y, _) ->
1828 let ready = layoutready layout in
1832 state
.layout <- layout;
1833 state
.throttle
<- None
;
1834 G.postRedisplay "throttle";
1843 dolog
"Inconsistent tiling state";
1844 logcurrently state
.currently
;
1848 | "pdim" :: args
:: [] ->
1849 let (n, w, h, _) as pdim
=
1850 scan args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1853 match conf
.fitmodel
with
1855 | FitPage
| FitProportional
->
1856 match conf
.columns
with
1857 | Csplit
_ -> (n, w, h, 0)
1858 | Csingle
_ | Cmulti
_ -> pdim
1860 state
.uioh#infochanged Pdim
;
1861 state
.pdims
<- pdim :: state
.pdims
1863 | "o" :: args
:: [] ->
1864 let (l, n, t
, h, pos
) =
1865 scan args
"%u %u %d %u %n"
1866 (fun l n t
h pos
-> l, n, t
, h, pos
)
1868 let s = String.sub args pos
(String.length args
- pos
) in
1869 addoutline (s, l, Oanchor
(n, float t
/. float h, 0.0))
1871 | "ou" :: args
:: [] ->
1872 let (l, len, pos
) = scan args
"%u %u %n" (fun l len pos
-> l, len, pos
) in
1873 let s = String.sub args pos
len in
1874 let pos2 = pos
+ len + 1 in
1875 let uri = String.sub args
pos2 (String.length args
- pos2) in
1876 addoutline (s, l, Ouri
uri)
1878 | "on" :: args
:: [] ->
1879 let (l, pos
) = scan args
"%u %n" (fun l pos
-> l, pos
) in
1880 let s = String.sub args pos
(String.length args
- pos
) in
1881 addoutline (s, l, Onone
)
1883 | "a" :: args
:: [] ->
1885 scan args
"%u %d %d" (fun n l t
-> n, l, t
)
1887 state
.reprf
<- (fun () -> gotopagexy n (float l) (float t
))
1889 | "info" :: args
:: [] ->
1890 let pos = nindex args '
\t'
in
1891 if pos >= 0 && String.sub args
0 pos = "Title"
1893 let s = String.sub args
(pos+1) @@ String.length args
- pos - 1 in
1897 state
.docinfo
<- (1, args
) :: state
.docinfo
1899 | "infoend" :: [] ->
1900 state
.uioh#infochanged Docinfo
;
1901 state
.docinfo
<- List.rev state
.docinfo
1905 then Wsi.settitle
"Wrong password";
1906 let password = getpassword () in
1907 if emptystr
password
1908 then error
"document is password protected"
1909 else opendoc state
.path
password
1912 error
"unknown cmd `%S'" cmds
1917 let action = function
1918 | HCprev
-> cbget cb ~
-1
1919 | HCnext
-> cbget cb
1
1920 | HCfirst
-> cbget cb ~
-(cb
.rc)
1921 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1922 and cancel
() = cb
.rc <- rc
1926 let search pattern forward
=
1927 match conf
.columns
with
1929 showtext '
!'
"searching does not work properly in split columns mode"
1932 if nonemptystr pattern
1935 match state
.layout with
1938 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1940 wcmd "search %d %d %d %d,%s\000"
1941 (btod conf
.icase
) pn py (btod forward
) pattern
;
1944 let intentry text key =
1946 if key >= 32 && key < 127
1952 let text = addchar
text c in
1956 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1964 let l = String.length
s in
1965 let rec loop pos n = if pos = l then n else
1966 let m = Char.code
s.[pos] - (if pos = 0 && l > 1 then 96 else 97) in
1967 loop (pos+1) (n*26 + m)
1970 let rec loop n = function
1973 match getopaque l.pageno with
1974 | None
-> loop n rest
1976 let m = getlinkcount
opaque in
1979 let under = getlink
opaque n in
1982 else loop (n-m) rest
1984 loop n state
.layout;
1988 let linknentry text key =
1990 if key >= 32 && key < 127
1996 let text = addchar
text c in
1997 linknact (fun under -> state
.text <- undertext ~nopath
:true under) text;
2001 state
.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
2005 let textentry text key =
2006 if key land 0xff00 = 0xff00
2008 else TEcont
(text ^ toutf8
key)
2011 let reqlayout angle fitmodel
=
2012 match state
.throttle
with
2014 if nogeomcmds state
.geomcmds
2015 then state
.anchor <- getanchor
();
2016 conf
.angle
<- angle
mod 360;
2019 match state
.mode
with
2020 | LinkNav
_ -> state
.mode
<- View
2025 conf
.fitmodel
<- fitmodel
;
2026 invalidate "reqlayout"
2028 wcmd "reqlayout %d %d %d"
2029 conf
.angle
(FMTE.to_int conf
.fitmodel
) (stateh state
.winh
)
2034 let settrim trimmargins trimfuzz
=
2035 if nogeomcmds state
.geomcmds
2036 then state
.anchor <- getanchor
();
2037 conf
.trimmargins
<- trimmargins
;
2038 conf
.trimfuzz
<- trimfuzz
;
2039 let x0, y0, x1, y1 = trimfuzz
in
2040 invalidate "settrim"
2042 wcmd "settrim %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1);
2047 match state
.throttle
with
2049 let zoom = max
0.0001 zoom in
2050 if zoom <> conf
.zoom
2052 state
.prevzoom
<- (conf
.zoom, state
.x);
2054 reshape state
.winw state
.winh
;
2055 state
.text <- Printf.sprintf
"zoom is now %-5.2f" (zoom *. 100.0);
2058 | Some
(layout, y, started
) ->
2060 match conf
.maxwait
with
2064 let dt = now
() -. started
in
2072 let setcolumns mode columns coverA coverB
=
2073 state
.prevcolumns
<- Some
(conf
.columns
, conf
.zoom);
2077 then showtext '
!'
"split mode doesn't work in bird's eye"
2079 conf
.columns
<- Csplit
(-columns
, E.a);
2087 conf
.columns
<- Csingle
E.a;
2092 conf
.columns
<- Cmulti
((columns
, coverA
, coverB
), E.a);
2096 reshape state
.winw state
.winh
;
2099 let resetmstate () =
2100 state
.mstate
<- Mnone
;
2101 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
2104 let enterbirdseye () =
2105 let zoom = float conf
.thumbw
/. float state
.winw
in
2106 let birdseyepageno =
2107 let cy = state
.winh
/ 2 in
2111 let rec fold best
= function
2114 let d = cy - (l.pagedispy + l.pagevh/2)
2115 and dbest
= cy - (best
.pagedispy + best
.pagevh/2) in
2116 if abs
d < abs dbest
2123 state
.mode
<- Birdseye
(
2124 { conf
with zoom = conf
.zoom }, state
.x, birdseyepageno, -1, getanchor
()
2128 conf
.presentation
<- false;
2129 conf
.interpagespace
<- 10;
2130 conf
.hlinks
<- false;
2131 conf
.fitmodel
<- FitPage
;
2133 conf
.maxwait
<- None
;
2135 match conf
.beyecolumns
with
2138 Cmulti
((c, 0, 0), E.a)
2139 | None
-> Csingle
E.a
2143 state
.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
2148 reshape state
.winw state
.winh
;
2151 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
2153 conf
.zoom <- c.zoom;
2154 conf
.presentation
<- c.presentation
;
2155 conf
.interpagespace
<- c.interpagespace
;
2156 conf
.maxwait
<- c.maxwait
;
2157 conf
.hlinks
<- c.hlinks
;
2158 conf
.fitmodel
<- c.fitmodel
;
2159 conf
.beyecolumns
<- (
2160 match conf
.columns
with
2161 | Cmulti
((c, _, _), _) -> Some
c
2163 | Csplit
_ -> failwith
"leaving bird's eye split mode"
2166 match c.columns
with
2167 | Cmulti
(c, _) -> Cmulti
(c, E.a)
2168 | Csingle
_ -> Csingle
E.a
2169 | Csplit
(c, _) -> Csplit
(c, E.a)
2173 state
.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
2176 reshape state
.winw state
.winh
;
2177 state
.anchor <- if goback
then anchor else (pageno, 0.0, 1.0);
2181 let togglebirdseye () =
2182 match state
.mode
with
2183 | Birdseye vals
-> leavebirdseye vals
true
2184 | View
-> enterbirdseye ()
2189 let upbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2190 let pageno = max
0 (pageno - incr
) in
2191 let rec loop = function
2192 | [] -> gotopage1 pageno 0
2193 | l :: _ when l.pageno = pageno ->
2194 if l.pagedispy >= 0 && l.pagey = 0
2195 then G.postRedisplay "upbirdseye"
2196 else gotopage1 pageno 0
2197 | _ :: rest
-> loop rest
2201 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor)
2204 let downbirdseye incr
(conf
, leftx
, pageno, hooverpageno
, anchor) =
2205 let pageno = min
(state
.pagecount
- 1) (pageno + incr
) in
2206 state
.mode
<- Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor);
2207 let rec loop = function
2209 let y, h = getpageyh
pageno in
2210 let dy = (y - state
.y) - (state
.winh
- h - conf
.interpagespace
) in
2212 | l :: _ when l.pageno = pageno ->
2213 if l.pagevh != l.pageh
2214 then gotoy (clamp (l.pageh
- l.pagevh + conf
.interpagespace
))
2215 else G.postRedisplay "downbirdseye"
2216 | _ :: rest
-> loop rest
2222 let optentry mode
_ key =
2223 let btos b = if b then "on" else "off" in
2224 if key >= 32 && key < 127
2226 let c = Char.chr
key in
2230 try conf
.scrollstep
<- int_of_string
s with exc
->
2231 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2233 TEswitch
("scroll step: ", E.s, None
, intentry, ondone, true)
2238 conf
.autoscrollstep
<- boundastep state
.winh
(int_of_string
s);
2239 if state
.autoscroll
<> None
2240 then state
.autoscroll
<- Some conf
.autoscrollstep
2242 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2244 TEswitch
("auto scroll step: ", E.s, None
, intentry, ondone, true)
2249 let n, a, b = multicolumns_of_string
s in
2250 setcolumns mode
n a b;
2252 state
.text <- Printf.sprintf
"bad columns `%s': %s" s (exntos exc
)
2254 TEswitch
("columns: ", E.s, None
, textentry, ondone, true)
2259 let zoom = float (int_of_string
s) /. 100.0 in
2262 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2264 TEswitch
("zoom: ", E.s, None
, intentry, ondone, true)
2269 conf
.thumbw
<- bound
(int_of_string
s) 2 4096;
2271 Printf.sprintf
"thumbnail width is set to %d" conf
.thumbw
;
2272 begin match mode
with
2274 leavebirdseye beye
false;
2281 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2283 TEswitch
("thumbnail width: ", E.s, None
, intentry, ondone, true)
2288 Some
(int_of_string
s)
2290 state
.text <- Printf.sprintf
"bad integer `%s': %s"
2294 | Some angle
-> reqlayout angle conf
.fitmodel
2297 TEswitch
("rotation: ", E.s, None
, intentry, ondone, true)
2300 conf
.icase
<- not conf
.icase
;
2301 TEdone
("case insensitive search " ^
(btos conf
.icase
))
2304 conf
.preload <- not conf
.preload;
2306 TEdone
("preload " ^
(btos conf
.preload))
2309 conf
.verbose
<- not conf
.verbose
;
2310 TEdone
("verbose " ^
(btos conf
.verbose
))
2313 conf
.debug
<- not conf
.debug
;
2314 TEdone
("debug " ^
(btos conf
.debug
))
2317 conf
.maxhfit
<- not conf
.maxhfit
;
2318 state
.maxy
<- calcheight
();
2319 TEdone
("maxhfit " ^
(btos conf
.maxhfit
))
2322 conf
.crophack
<- not conf
.crophack
;
2323 TEdone
("crophack " ^
btos conf
.crophack
)
2327 match conf
.maxwait
with
2329 conf
.maxwait
<- Some infinity
;
2330 "always wait for page to complete"
2332 conf
.maxwait
<- None
;
2333 "show placeholder if page is not ready"
2338 conf
.underinfo
<- not conf
.underinfo
;
2339 TEdone
("underinfo " ^
btos conf
.underinfo
)
2342 conf
.savebmarks
<- not conf
.savebmarks
;
2343 TEdone
("persistent bookmarks " ^
btos conf
.savebmarks
)
2349 match state
.layout with
2354 conf
.interpagespace
<- int_of_string
s;
2355 docolumns conf
.columns
;
2356 state
.maxy
<- calcheight
();
2357 let y = getpagey
pageno in
2360 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
)
2362 TEswitch
("vertical margin: ", E.s, None
, intentry, ondone, true)
2366 match conf
.fitmodel
with
2367 | FitProportional
-> FitWidth
2368 | FitWidth
| FitPage
-> FitProportional
2370 reqlayout conf
.angle
fm;
2371 TEdone
("proportional display " ^
btos (fm == FitProportional
))
2374 settrim (not conf
.trimmargins
) conf
.trimfuzz
;
2375 TEdone
("trim margins " ^
btos conf
.trimmargins
)
2378 conf
.invert
<- not conf
.invert
;
2379 TEdone
("invert colors " ^
btos conf
.invert
)
2383 cbput state
.hists
.sel
s;
2386 TEswitch
("selection command: ", E.s, Some
(onhist state
.hists
.sel
),
2387 textentry, ondone, true)
2391 then conf
.pax
<- Some
(ref (0.0, 0, 0))
2392 else conf
.pax
<- None
;
2393 TEdone
("PAX " ^
btos (conf
.pax
!= None
))
2396 state
.text <- Printf.sprintf
"bad option %d `%c'" key c;
2402 class type lvsource
= object
2403 method getitemcount
: int
2404 method getitem
: int -> (string * int)
2405 method hasaction
: int -> bool
2413 method getactive
: int
2414 method getfirst
: int
2416 method getminfo
: (int * int) array
2419 class virtual lvsourcebase
= object
2420 val mutable m_active
= 0
2421 val mutable m_first
= 0
2422 val mutable m_pan
= 0
2423 method getactive
= m_active
2424 method getfirst
= m_first
2425 method getpan
= m_pan
2426 method getminfo
: (int * int) array
= E.a
2429 let textentrykeyboard
2430 key _mask
((c, text, opthist
, onkey
, ondone, cancelonempty
), onleave
) =
2433 if key >= 0xffb0 && key <= 0xffb9
2434 then key - 0xffb0 + 48 else key
2437 state
.mode
<- Textentry
(te
, onleave
);
2439 G.postRedisplay "textentrykeyboard enttext";
2441 let histaction cmd
=
2444 | Some
(action, _) ->
2445 state
.mode
<- Textentry
(
2446 (c, action cmd
, opthist
, onkey
, ondone, cancelonempty
), onleave
2448 G.postRedisplay "textentry histaction"
2452 if emptystr
text && cancelonempty
2455 G.postRedisplay "textentrykeyboard after cancel";
2458 let s = withoutlastutf8
text in
2459 enttext (c, s, opthist
, onkey
, ondone, cancelonempty
)
2461 | @enter
| @kpenter
->
2464 G.postRedisplay "textentrykeyboard after confirm"
2466 | @up
| @kpup
-> histaction HCprev
2467 | @down
| @kpdown
-> histaction HCnext
2468 | @home
| @kphome
-> histaction HCfirst
2469 | @jend
| @kpend
-> histaction HClast
2474 begin match opthist
with
2476 | Some
(_, onhistcancel
) -> onhistcancel
()
2480 G.postRedisplay "textentrykeyboard after cancel2"
2483 enttext (c, E.s, opthist
, onkey
, ondone, cancelonempty
)
2486 | @delete
| @kpdelete
-> ()
2489 && key land 0xff00 != 0xff00 (* keyboard *)
2490 && key land 0xfe00 != 0xfe00 (* xkb *)
2491 && key land 0xfd00 != 0xfd00 (* 3270 *)
2493 begin match onkey
text key with
2497 G.postRedisplay "textentrykeyboard after confirm2";
2500 enttext (c, text, opthist
, onkey
, ondone, cancelonempty
);
2504 G.postRedisplay "textentrykeyboard after cancel3"
2507 state
.mode
<- Textentry
(te
, onleave
);
2508 G.postRedisplay "textentrykeyboard switch";
2512 vlog "unhandled key %s" (Wsi.keyname
key)
2515 let firstof first active
=
2516 if first
> active
|| abs
(first
- active
) > fstate
.maxrows
- 1
2517 then max
0 (active
- (fstate
.maxrows
/2))
2521 let calcfirst first active
=
2524 let rows = active
- first
in
2525 if rows > fstate
.maxrows
then active
- fstate
.maxrows
else first
2529 let scrollph y maxy
=
2530 let sh = float (maxy
+ state
.winh
) /. float state
.winh
in
2531 let sh = float state
.winh
/. sh in
2532 let sh = max
sh (float conf
.scrollh
) in
2534 let percent = float y /. float maxy
in
2535 let position = (float state
.winh
-. sh) *. percent in
2538 if position +. sh > float state
.winh
2539 then float state
.winh
-. sh
2545 let coe s = (s :> uioh
);;
2547 class listview ~zebra ~helpmode ~
(source
:lvsource
) ~trusted ~modehash
=
2549 val m_pan
= source#getpan
2550 val m_first
= source#getfirst
2551 val m_active
= source#getactive
2553 val m_prev_uioh
= state
.uioh
2555 method private elemunder
y =
2559 let n = y / (fstate
.fontsize
+1) in
2560 if m_first
+ n < source#getitemcount
2562 if source#hasaction
(m_first
+ n)
2563 then Some
(m_first
+ n)
2570 GlFunc.blend_func ~src
:`src_alpha ~dst
:`one_minus_src_alpha
;
2571 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2572 filledrect 0. 0. (float state
.winw
) (float state
.winh
);
2573 GlDraw.color
(1., 1., 1.);
2574 Gl.enable `texture_2d
;
2575 let fs = fstate
.fontsize
in
2577 let hw = (wadjsb () + xadjsb () + state
.winw
)/3 in
2578 let ww = fstate
.wwidth
in
2579 let tabw = 17.0*.ww in
2580 let itemcount = source#getitemcount
in
2581 let minfo = source#getminfo
in
2584 then float (xadjsb ()), float (state
.winw
- 1)
2585 else 0.0, float (state
.winw
- conf
.scrollbw
- 1)
2587 let xadj = xadjsb () in
2589 if (row - m_first
) > fstate
.maxrows
2592 if row >= 0 && row < itemcount
2594 let (s, level
) = source#getitem
row in
2595 let y = (row - m_first
) * nfs in
2597 (if conf
.leftscroll
then float xadj else 5.0)
2598 +. (float (level
+ m_pan
)) *. ww in
2601 (let c = if row land 1 = 0 then 1.0 else 0.92 in (c,c,c));
2605 Gl.disable `texture_2d
;
2606 let alpha = if source#hasaction
row then 0.9 else 0.3 in
2607 GlDraw.color
(1., 1., 1.) ~
alpha;
2608 linerect (x0 +. 1.) (float (y + 1)) (x1) (float (y + fs + 3));
2609 Gl.enable `texture_2d
;
2612 if zebra
&& row land 1 = 1
2616 GlDraw.color
(c,c,c);
2617 let drawtabularstring s =
2619 let x'
= truncate
(x0 +. x) in
2620 let pos = nindex
s '
\000'
in
2622 then drawstring1 fs x'
(y+nfs) s
2624 let s1 = String.sub
s 0 pos
2625 and s2
= String.sub
s (pos+1) (String.length
s - pos - 1) in
2630 let s'
= withoutlastutf8
s in
2631 let s = s' ^
"@Uellipsis" in
2632 let w = measurestr
fs s in
2633 if float x'
+. w +. ww < float (hw + x'
)
2638 if float x'
+. ww +. measurestr
fs s1 > float (hw + x'
)
2642 ignore
(drawstring1 fs x'
(y+nfs) s1);
2643 drawstring1 fs (hw + x'
) (y+nfs) s2
2647 let x = if helpmode
&& row > 0 then x +. ww else x in
2648 let tabpos = nindex
s '
\t'
in
2651 let len = String.length
s - tabpos - 1 in
2652 let s1 = String.sub
s 0 tabpos
2653 and s2
= String.sub
s (tabpos + 1) len in
2654 let nx = drawstr x s1 in
2656 let x = x +. (max
tabw sw) in
2659 let len = String.length
s - 2 in
2660 if len > 0 && s.[0] = '
\xc2'
&& s.[1] = '
\xb7'
2662 let s = String.sub
s 2 len in
2663 let x = if not helpmode
then x +. ww else x in
2664 GlDraw.color
(1.2, 1.2, 1.2);
2665 let vinc = drawstring1 (fs+fs/4)
2666 (truncate
(x -. ww)) (y+nfs) s in
2667 GlDraw.color
(1., 1., 1.);
2668 vinc +. (float fs *. 0.8)
2674 ignore
(drawtabularstring s);
2680 GlDraw.color
(1.0, 1.0, 1.0) ~
alpha:0.5;
2681 let xadj = float (xadjsb () + 5) in
2683 if (row - m_first
) > fstate
.maxrows
2686 if row >= 0 && row < itemcount
2688 let (s, level
) = source#getitem
row in
2689 let pos0 = nindex
s '
\000'
in
2690 let y = (row - m_first
) * nfs in
2691 let x = float (level
+ m_pan
) *. ww in
2692 let (first
, last
) = minfo.(row) in
2694 if pos0 > 0 && first
> pos0
2695 then String.sub
s (pos0+1) (first
-pos0-1)
2696 else String.sub
s 0 first
2698 let suffix = String.sub
s first
(last
- first
) in
2699 let w1 = measurestr fstate
.fontsize
prefix in
2700 let w2 = measurestr fstate
.fontsize
suffix in
2701 let x = x +. if conf
.leftscroll
then xadj else 5.0 in
2702 let x = if pos0 > 0 && first
> pos0 then x +. float hw else x in
2704 and y0 = float (y+2) in
2706 and y1 = float (y+fs+3) in
2707 filledrect x0 y0 x1 y1;
2712 Gl.disable `texture_2d
;
2713 if Array.length
minfo > 0 then loop m_first
;
2716 method updownlevel incr
=
2717 let len = source#getitemcount
in
2719 if m_active
>= 0 && m_active
< len
2720 then snd
(source#getitem m_active
)
2724 if i
= len then i
-1 else if i
= -1 then 0 else
2725 let _, l = source#getitem i
in
2726 if l != curlevel then i
else flow (i
+incr
)
2728 let active = flow m_active
in
2729 let first = calcfirst m_first
active in
2730 G.postRedisplay "outline updownlevel";
2731 {< m_active
= active; m_first
= first >}
2733 method private key1
key mask
=
2734 let set1 active first qsearch
=
2735 coe {< m_active
= active; m_first
= first; m_qsearch
= qsearch
>}
2737 let search active pattern incr
=
2738 let active = if active = -1 then m_first
else active in
2741 if n >= 0 && n < source#getitemcount
2743 let s, _ = source#getitem
n in
2745 (try ignore
(Str.search_forward re
s 0); true
2746 with Not_found
-> false)
2748 else loop (n + incr
)
2755 let re = Str.regexp_case_fold pattern
in
2761 let itemcount = source#getitemcount
in
2762 let find start incr
=
2764 if i
= -1 || i
= itemcount
2767 if source#hasaction i
2769 else find (i
+ incr
)
2774 let set active first =
2775 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2777 coe {< m_active
= active; m_first
= first; m_qsearch
= E.s >}
2780 let isvisible first n = n >= first && n - first <= fstate
.maxrows
in
2782 let incr1 = if incr
> 0 then 1 else -1 in
2783 if isvisible m_first m_active
2786 let next = m_active
+ incr
in
2788 if next < 0 || next >= itemcount
2790 else find next incr1
2792 if abs
(m_active
- next) > fstate
.maxrows
2798 let first = m_first
+ incr
in
2799 let first = bound
first 0 (itemcount - fstate
.maxrows
) in
2801 let next = m_active
+ incr
in
2802 let next = bound
next 0 (itemcount - 1) in
2809 if isvisible first next
2816 let first = min
next m_first
in
2818 if abs
(next - first) > fstate
.maxrows
2824 let first = m_first
+ incr
in
2825 let first = bound
first 0 (itemcount - 1) in
2827 let next = m_active
+ incr
in
2828 let next = bound
next 0 (itemcount - 1) in
2829 let next = find next incr1 in
2831 if next = -1 || abs
(m_active
- first) > fstate
.maxrows
2833 let active = if m_active
= -1 then next else m_active
in
2838 if isvisible first active
2844 G.postRedisplay "listview navigate";
2848 | (@r
|@s) when Wsi.withctrl mask
->
2849 let incr = if key = @r
then -1 else 1 in
2851 match search (m_active
+ incr) m_qsearch
incr with
2853 state
.text <- m_qsearch ^
" [not found]";
2856 state
.text <- m_qsearch
;
2857 active, firstof m_first
active
2859 G.postRedisplay "listview ctrl-r/s";
2860 set1 active first m_qsearch
;
2862 | @insert
when Wsi.withctrl mask
->
2863 if m_active
>= 0 && m_active
< source#getitemcount
2865 let s, _ = source#getitem m_active
in
2871 if emptystr m_qsearch
2874 let qsearch = withoutlastutf8 m_qsearch
in
2878 G.postRedisplay "listview empty qsearch";
2879 set1 m_active m_first
E.s;
2883 match search m_active
qsearch ~
-1 with
2885 state
.text <- qsearch ^
" [not found]";
2888 state
.text <- qsearch;
2889 active, firstof m_first
active
2891 G.postRedisplay "listview backspace qsearch";
2892 set1 active first qsearch
2895 | key when (key != 0 && key land 0xff00 != 0xff00) ->
2896 let pattern = m_qsearch ^ toutf8
key in
2898 match search m_active
pattern 1 with
2900 state
.text <- pattern ^
" [not found]";
2903 state
.text <- pattern;
2904 active, firstof m_first
active
2906 G.postRedisplay "listview qsearch add";
2907 set1 active first pattern;
2911 if emptystr m_qsearch
2913 G.postRedisplay "list view escape";
2914 let mx, my
= state
.mpos
in
2918 source#exit ~uioh
:(coe self
)
2919 ~cancel
:true ~
active:m_active ~
first:m_first ~pan
:m_pan
2921 | None
-> m_prev_uioh
2926 G.postRedisplay "list view kill qsearch";
2927 coe {< m_qsearch
= E.s >}
2930 | @enter
| @kpenter
->
2932 let self = {< m_qsearch
= E.s >} in
2934 G.postRedisplay "listview enter";
2935 if m_active
>= 0 && m_active
< source#getitemcount
2937 source#exit ~uioh
:(coe self) ~cancel
:false
2938 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2941 source#exit ~uioh
:(coe self) ~cancel
:true
2942 ~
active:m_active ~
first:m_first ~pan
:m_pan
;
2945 begin match opt with
2946 | None
-> m_prev_uioh
2950 | @delete
| @kpdelete
->
2953 | @up
| @kpup
-> navigate ~
-1
2954 | @down
| @kpdown
-> navigate 1
2955 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows
)
2956 | @next | @kpnext
-> navigate fstate
.maxrows
2958 | @right
| @kpright
->
2960 G.postRedisplay "listview right";
2961 coe {< m_pan
= m_pan
- 1 >}
2963 | @left | @kpleft
->
2965 G.postRedisplay "listview left";
2966 coe {< m_pan
= m_pan
+ 1 >}
2968 | @home
| @kphome
->
2969 let active = find 0 1 in
2970 G.postRedisplay "listview home";
2974 let first = max
0 (itemcount - fstate
.maxrows
) in
2975 let active = find (itemcount - 1) ~
-1 in
2976 G.postRedisplay "listview end";
2979 | key when (key = 0 || key land 0xff00 = 0xff00) ->
2983 dolog
"listview unknown key %#x" key; coe self
2985 method key key mask
=
2986 match state
.mode
with
2987 | Textentry te
-> textentrykeyboard key mask te
; coe self
2990 | LinkNav
_ -> self#key1
key mask
2992 method button button down
x y _ =
2995 | 1 when x > state
.winw
- conf
.scrollbw
->
2996 G.postRedisplay "listview scroll";
2999 let _, position, sh = self#
scrollph in
3000 if y > truncate
position && y < truncate
(position +. sh)
3002 state
.mstate
<- Mscrolly
;
3006 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3007 let first = truncate
(s *. float source#getitemcount
) in
3008 let first = min source#getitemcount
first in
3009 Some
(coe {< m_first
= first; m_active
= first >})
3011 state
.mstate
<- Mnone
;
3015 begin match self#elemunder
y with
3017 G.postRedisplay "listview click";
3018 source#exit ~uioh
:(coe {< m_active
= n >})
3019 ~cancel
:false ~
active:n ~
first:m_first ~pan
:m_pan
3023 | n when (n == 4 || n == 5) && not down
->
3024 let len = source#getitemcount
in
3026 if n = 5 && m_first
+ fstate
.maxrows
>= len
3030 let first = m_first
+ (if n == 4 then -1 else 1) in
3031 bound
first 0 (len - 1)
3033 G.postRedisplay "listview wheel";
3034 Some
(coe {< m_first
= first >})
3035 | n when (n = 6 || n = 7) && not down
->
3036 let inc = if n = 7 then -1 else 1 in
3037 G.postRedisplay "listview hwheel";
3038 Some
(coe {< m_pan
= m_pan
+ inc >})
3043 | None
-> m_prev_uioh
3046 method multiclick
_ x y = self#button
1 true x y
3049 match state
.mstate
with
3051 let s = float (max
0 (y - conf
.scrollh
)) /. float state
.winh
in
3052 let first = truncate
(s *. float source#getitemcount
) in
3053 let first = min source#getitemcount
first in
3054 G.postRedisplay "listview motion";
3055 coe {< m_first
= first; m_active
= first >}
3063 method pmotion
x y =
3064 if x < state
.winw
- conf
.scrollbw
3067 match self#elemunder
y with
3068 | None
-> Wsi.setcursor
Wsi.CURSOR_INHERIT
; m_active
3069 | Some
n -> Wsi.setcursor
Wsi.CURSOR_INFO
; n
3073 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
3078 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
3082 method infochanged
_ = ()
3084 method scrollpw
= (0, 0.0, 0.0)
3086 let nfs = fstate
.fontsize
+ 1 in
3087 let y = m_first
* nfs in
3088 let itemcount = source#getitemcount
in
3089 let maxi = max
0 (itemcount - fstate
.maxrows
) in
3090 let maxy = maxi * nfs in
3091 let p, h = scrollph y maxy in
3094 method modehash
= modehash
3095 method eformsgs
= false
3096 method alwaysscrolly
= true
3099 class outlinelistview ~zebra ~source
=
3100 let settext autonarrow
s =
3103 let ss = source#statestr
in
3107 else "{" ^
ss ^
"} [" ^
s ^
"]"
3108 else state
.text <- s
3114 ~source
:(source
:> lvsource
)
3116 ~modehash
:(findkeyhash conf
"outline")
3119 val m_autonarrow
= false
3121 method! key key mask
=
3123 if emptystr state
.text
3125 else fstate
.maxrows - 2
3127 let calcfirst first active =
3130 let rows = active - first in
3131 if rows > maxrows then active - maxrows else first
3135 let active = m_active
+ incr in
3136 let active = bound
active 0 (source#getitemcount
- 1) in
3137 let first = calcfirst m_first
active in
3138 G.postRedisplay "outline navigate";
3139 coe {< m_active
= active; m_first
= first >}
3141 let navscroll first =
3143 let dist = m_active
- first in
3149 else first + maxrows
3152 G.postRedisplay "outline navscroll";
3153 coe {< m_first
= first; m_active
= active >}
3155 let ctrl = Wsi.withctrl mask
in
3160 then (source#denarrow
; E.s)
3162 let pattern = source#renarrow
in
3163 if nonemptystr m_qsearch
3164 then (source#narrow m_qsearch
; m_qsearch
)
3168 settext (not m_autonarrow
) text;
3169 G.postRedisplay "toggle auto narrowing";
3170 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= not m_autonarrow
>}
3172 | @slash
when emptystr m_qsearch
&& not m_autonarrow
->
3174 G.postRedisplay "toggle auto narrowing";
3175 coe {< m_first
= 0; m_active
= 0; m_autonarrow
= true >}
3178 source#narrow m_qsearch
;
3180 then source#add_narrow_pattern m_qsearch
;
3181 G.postRedisplay "outline ctrl-n";
3182 coe {< m_first
= 0; m_active
= 0 >}
3185 let active = source#calcactive
(getanchor
()) in
3186 let first = firstof m_first
active in
3187 G.postRedisplay "outline ctrl-s";
3188 coe {< m_first
= first; m_active
= active >}
3191 G.postRedisplay "outline ctrl-u";
3192 if m_autonarrow
&& nonemptystr m_qsearch
3194 ignore
(source#renarrow
);
3195 settext m_autonarrow
E.s;
3196 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3199 source#del_narrow_pattern
;
3200 let pattern = source#renarrow
in
3202 if emptystr
pattern then E.s else "Narrowed to " ^
pattern
3204 settext m_autonarrow
text;
3205 coe {< m_first
= 0; m_active
= 0; m_qsearch
= E.s >}
3209 let first = max
0 (m_active
- (fstate
.maxrows / 2)) in
3210 G.postRedisplay "outline ctrl-l";
3211 coe {< m_first
= first >}
3213 | @tab
when m_autonarrow
->
3214 if nonemptystr m_qsearch
3216 G.postRedisplay "outline list view tab";
3217 source#add_narrow_pattern m_qsearch
;
3219 coe {< m_qsearch
= E.s >}
3223 | @escape
when m_autonarrow
->
3224 if nonemptystr m_qsearch
3225 then source#add_narrow_pattern m_qsearch
;
3228 | @enter
| @kpenter
when m_autonarrow
->
3229 if nonemptystr m_qsearch
3230 then source#add_narrow_pattern m_qsearch
;
3233 | key when m_autonarrow
&& (key != 0 && key land 0xff00 != 0xff00) ->
3234 let pattern = m_qsearch ^ toutf8
key in
3235 G.postRedisplay "outlinelistview autonarrow add";
3236 source#narrow
pattern;
3237 settext true pattern;
3238 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3240 | key when m_autonarrow
&& key = @backspace
->
3241 if emptystr m_qsearch
3244 let pattern = withoutlastutf8 m_qsearch
in
3245 G.postRedisplay "outlinelistview autonarrow backspace";
3246 ignore
(source#renarrow
);
3247 source#narrow
pattern;
3248 settext true pattern;
3249 coe {< m_first
= 0; m_active
= 0; m_qsearch
= pattern >}
3251 | @delete
| @kpdelete
->
3252 source#remove m_active
;
3253 G.postRedisplay "outline delete";
3254 let active = max
0 (m_active
-1) in
3255 coe {< m_first
= firstof m_first
active;
3256 m_active
= active >}
3258 | @up
| @kpup
when ctrl ->
3259 navscroll (max
0 (m_first
- 1))
3261 | @down
| @kpdown
when ctrl ->
3262 navscroll (min
(source#getitemcount
- 1) (m_first
+ 1))
3264 | @up
| @kpup
-> navigate ~
-1
3265 | @down
| @kpdown
-> navigate 1
3266 | @prior
| @kpprior
-> navigate ~
-(fstate
.maxrows)
3267 | @next | @kpnext
-> navigate fstate
.maxrows
3269 | @right
| @kpright
->
3273 G.postRedisplay "outline ctrl right";
3274 {< m_pan
= m_pan
+ 1 >}
3276 else self#updownlevel
1
3280 | @left | @kpleft
->
3284 G.postRedisplay "outline ctrl left";
3285 {< m_pan
= m_pan
- 1 >}
3287 else self#updownlevel ~
-1
3291 | @home
| @kphome
->
3292 G.postRedisplay "outline home";
3293 coe {< m_first
= 0; m_active
= 0 >}
3296 let active = source#getitemcount
- 1 in
3297 let first = max
0 (active - fstate
.maxrows) in
3298 G.postRedisplay "outline end";
3299 coe {< m_active
= active; m_first
= first >}
3301 | _ -> super#
key key mask
3304 let genhistoutlines =
3305 let order ty
(p1
, c1
, _, _, _, _) (p2
, c2
, _, _, _, _) =
3307 | `lastvisit
-> compare c1
.lastvisit c2
.lastvisit
3308 | `path
-> compare p2 p1
3309 | `file
-> compare
(Filename.basename p2
) (Filename.basename p1
)
3311 let e1 = emptystr c1
.title
3312 and e2
= emptystr c2
.title
in
3314 then compare
(Filename.basename p2
) (Filename.basename p1
)
3317 else compare c1
.title c2
.title
3319 let showfullpath = ref false in
3320 let showorigin = ref true in
3321 let orderty : historder
ref = ref `lastvisit
in
3324 let s = if !orderty = t
then "[@Uradical] " ^
s else "[ ] " ^
s in
3325 s, 0, Oreaction
(fun () -> orderty := t
; f ())
3327 match Config.gethist
() with
3332 (fun accu (path
, c, b, x, a, o) ->
3333 let hist = (path
, (c, b, x, a, o)) in
3335 let s = if nonemptystr
o && !showorigin then o else path
in
3336 if !showfullpath then s else Filename.basename
s
3338 let base = mbtoutf8
s in
3339 (base ^
"\000" ^
c.title
, 1, Ohistory
hist) :: accu
3341 [ setorty "Sort by time of last visit" `lastvisit
;
3342 setorty "Sort by file name" `file
;
3343 setorty "Sort by path" `path
;
3344 setorty "Sort by title" `title
;
3345 (if !showfullpath then "@Uradical "
3346 else " ") ^
"Show full path", 0, Oreaction
(fun () ->
3347 showfullpath := not
!showfullpath;
3349 (if !showorigin then "@Uradical "
3350 else " ") ^
"Show origin", 0, Oreaction
(fun () ->
3351 showorigin := not
!showorigin;
3353 ] (List.sort
(order !orderty) list
)
3359 let gotohist (path
, (c, bookmarks
, x, anchor, origin
)) =
3360 Config.save
leavebirdseye;
3361 state
.anchor <- anchor;
3362 state
.bookmarks
<- bookmarks
;
3363 state
.origin
<- origin
;
3366 let x0, y0, x1, y1 = conf
.trimfuzz
in
3367 wcmd "trimset %d %d %d %d %d" (btod conf
.trimmargins
) x0 y0 x1 y1;
3368 reshape ~firsttime
:true state
.winw state
.winh
;
3369 opendoc path origin
;
3373 let makecheckers () =
3374 (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
3376 converted by Issac Trotts. July 25, 2002 *)
3377 let image = GlPix.create `ubyte ~format
:`luminance ~width
:2 ~height
:2 in
3378 Raw.sets_string
(GlPix.to_raw
image) ~
pos:0 "\255\200\200\255";
3379 let id = GlTex.gen_texture
() in
3380 GlTex.bind_texture ~target
:`texture_2d
id;
3381 GlPix.store
(`unpack_alignment
1);
3382 GlTex.image2d
image;
3383 List.iter
(GlTex.parameter ~target
:`texture_2d
)
3384 [ `mag_filter `nearest
; `min_filter `nearest
];
3388 let setcheckers enabled
=
3389 match state
.checkerstexid
with
3391 if enabled
then state
.checkerstexid
<- Some
(makecheckers ())
3393 | Some checkerstexid
->
3396 GlTex.delete_texture checkerstexid
;
3397 state
.checkerstexid
<- None
;
3401 let describe_location () =
3402 let fn = page_of_y state
.y in
3403 let ln = page_of_y
(state
.y + state
.winh
- hscrollh () - 1) in
3404 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
3408 else (100. *. (float state
.y /. float maxy))
3412 Printf.sprintf
"page %d of %d [%.2f%%]"
3413 (fn+1) state
.pagecount
percent
3416 "pages %d-%d of %d [%.2f%%]"
3417 (fn+1) (ln+1) state
.pagecount
percent
3420 let setpresentationmode v
=
3421 let n = page_of_y state
.y in
3422 state
.anchor <- (n, 0.0, 1.0);
3423 conf
.presentation
<- v
;
3424 if conf
.fitmodel
= FitPage
3425 then reqlayout conf
.angle conf
.fitmodel
;
3430 let btos b = if b then "@Uradical" else E.s in
3431 let showextended = ref false in
3432 let leave mode
_ = state
.mode
<- mode
in
3435 val mutable m_first_time
= true
3436 val mutable m_l
= []
3437 val mutable m_a
= E.a
3438 val mutable m_prev_uioh
= nouioh
3439 val mutable m_prev_mode
= View
3441 inherit lvsourcebase
3443 method reset prev_mode prev_uioh
=
3444 m_a
<- Array.of_list
(List.rev m_l
);
3446 m_prev_mode
<- prev_mode
;
3447 m_prev_uioh
<- prev_uioh
;
3451 if n >= Array.length m_a
3455 | _, _, _, Action
_ -> m_active
<- n
3456 | _, _, _, Noaction
-> loop (n+1)
3459 m_first_time
<- false;
3462 method int name get
set =
3464 (name
, `
int get
, 1, Action
(
3467 try set (int_of_string
s)
3469 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3473 let te = name ^
": ", E.s, None
, intentry, ondone, true in
3474 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3478 method int_with_suffix name get
set =
3480 (name
, `intws get
, 1, Action
(
3483 try set (int_of_string_with_suffix
s)
3485 state
.text <- Printf.sprintf
"bad integer `%s': %s"
3490 name ^
": ", E.s, None
, intentry_with_suffix, ondone, true
3492 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3496 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
3498 (name
, `
bool (btos, get
), offset
, Action
(
3505 method color name get
set =
3507 (name
, `color get
, 1, Action
(
3509 let invalid = (nan
, nan
, nan
) in
3512 try color_of_string
s
3514 state
.text <- Printf.sprintf
"bad color `%s': %s"
3521 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3522 state
.text <- color_to_string
(get
());
3523 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3527 method string name get
set =
3529 (name
, `
string get
, 1, Action
(
3531 let ondone s = set s in
3532 let te = name ^
": ", E.s, None
, textentry, ondone, true in
3533 state
.mode
<- Textentry
(te, leave m_prev_mode
);
3537 method colorspace name get
set =
3539 (name
, `
string get
, 1, Action
(
3543 inherit lvsourcebase
3546 m_active
<- CSTE.to_int conf
.colorspace
;
3549 method getitemcount
=
3550 Array.length
CSTE.names
3553 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3554 ignore
(uioh
, first, pan
);
3555 if not cancel
then set active;
3557 method hasaction
_ = true
3561 let modehash = findkeyhash conf
"info" in
3562 coe (new listview ~zebra
:false ~helpmode
:false
3563 ~
source ~trusted
:true ~
modehash)
3566 method paxmark name get
set =
3568 (name
, `
string get
, 1, Action
(
3572 inherit lvsourcebase
3575 m_active
<- MTE.to_int conf
.paxmark
;
3578 method getitemcount
= Array.length
MTE.names
3579 method getitem
n = (MTE.names
.(n), 0)
3580 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3581 ignore
(uioh
, first, pan
);
3582 if not cancel
then set active;
3584 method hasaction
_ = true
3588 let modehash = findkeyhash conf
"info" in
3589 coe (new listview ~zebra
:false ~helpmode
:false
3590 ~
source ~trusted
:true ~
modehash)
3593 method fitmodel name get
set =
3595 (name
, `
string get
, 1, Action
(
3599 inherit lvsourcebase
3602 m_active
<- FMTE.to_int conf
.fitmodel
;
3605 method getitemcount
= Array.length
FMTE.names
3606 method getitem
n = (FMTE.names
.(n), 0)
3607 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3608 ignore
(uioh
, first, pan
);
3609 if not cancel
then set active;
3611 method hasaction
_ = true
3615 let modehash = findkeyhash conf
"info" in
3616 coe (new listview ~zebra
:false ~helpmode
:false
3617 ~
source ~trusted
:true ~
modehash)
3620 method caption
s offset
=
3621 m_l
<- (s, `empty
, offset
, Noaction
) :: m_l
3623 method caption2
s f offset
=
3624 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3626 method getitemcount
= Array.length m_a
3629 let tostr = function
3630 | `
int f -> string_of_int
(f ())
3631 | `intws
f -> string_with_suffix_of_int
(f ())
3633 | `color
f -> color_to_string
(f ())
3634 | `
bool (btos, f) -> btos (f ())
3637 let name, t
, offset
, _ = m_a
.(n) in
3638 ((let s = tostr t
in
3640 then Printf.sprintf
"%s\t%s" name s
3644 method exit ~uioh ~cancel ~
active ~
first ~pan
=
3649 match m_a
.(active) with
3650 | _, _, _, Action
f -> f uioh
3651 | _, _, _, Noaction
-> uioh
3662 method hasaction
n =
3664 | _, _, _, Action
_ -> true
3665 | _, _, _, Noaction
-> false
3668 let rec fillsrc prevmode prevuioh
=
3669 let sep () = src#caption
E.s 0 in
3670 let colorp name get
set =
3672 (fun () -> color_to_string
(get
()))
3675 let c = color_of_string
v in
3678 state
.text <- Printf.sprintf
"bad color `%s': %s" v (exntos exn
)
3681 let oldmode = state
.mode
in
3682 let birdseye = isbirdseye state
.mode
in
3684 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3686 src#
bool "presentation mode"
3687 (fun () -> conf
.presentation
)
3688 (fun v -> setpresentationmode v);
3690 src#
bool "ignore case in searches"
3691 (fun () -> conf
.icase
)
3692 (fun v -> conf
.icase
<- v);
3695 (fun () -> conf
.preload)
3696 (fun v -> conf
.preload <- v);
3698 src#
bool "highlight links"
3699 (fun () -> conf
.hlinks
)
3700 (fun v -> conf
.hlinks
<- v);
3702 src#
bool "under info"
3703 (fun () -> conf
.underinfo
)
3704 (fun v -> conf
.underinfo
<- v);
3706 src#
bool "persistent bookmarks"
3707 (fun () -> conf
.savebmarks
)
3708 (fun v -> conf
.savebmarks
<- v);
3710 src#fitmodel
"fit model"
3711 (fun () -> FMTE.to_string conf
.fitmodel
)
3712 (fun v -> reqlayout conf
.angle
(FMTE.of_int
v));
3714 src#
bool "trim margins"
3715 (fun () -> conf
.trimmargins
)
3716 (fun v -> settrim v conf
.trimfuzz
; fillsrc prevmode prevuioh
);
3718 src#
bool "persistent location"
3719 (fun () -> conf
.jumpback
)
3720 (fun v -> conf
.jumpback
<- v);
3723 src#
int "inter-page space"
3724 (fun () -> conf
.interpagespace
)
3726 conf
.interpagespace
<- n;
3727 docolumns conf
.columns
;
3729 match state
.layout with
3734 state
.maxy <- calcheight
();
3735 let y = getpagey
pageno in
3740 (fun () -> conf
.pagebias
)
3741 (fun v -> conf
.pagebias
<- v);
3743 src#
int "scroll step"
3744 (fun () -> conf
.scrollstep
)
3745 (fun n -> conf
.scrollstep
<- n);
3747 src#
int "horizontal scroll step"
3748 (fun () -> conf
.hscrollstep
)
3749 (fun v -> conf
.hscrollstep
<- v);
3751 src#
int "auto scroll step"
3753 match state
.autoscroll
with
3755 | _ -> conf
.autoscrollstep
)
3757 let n = boundastep state
.winh
n in
3758 if state
.autoscroll
<> None
3759 then state
.autoscroll
<- Some
n;
3760 conf
.autoscrollstep
<- n);
3763 (fun () -> truncate
(conf
.zoom *. 100.))
3764 (fun v -> setzoom ((float v) /. 100.));
3767 (fun () -> conf
.angle
)
3768 (fun v -> reqlayout v conf
.fitmodel
);
3770 src#
int "scroll bar width"
3771 (fun () -> conf
.scrollbw
)
3774 reshape state
.winw state
.winh
;
3777 src#
int "scroll handle height"
3778 (fun () -> conf
.scrollh
)
3779 (fun v -> conf
.scrollh
<- v;);
3781 src#
int "thumbnail width"
3782 (fun () -> conf
.thumbw
)
3784 conf
.thumbw
<- min
4096 v;
3787 leavebirdseye beye
false;
3794 let mode = state
.mode in
3795 src#
string "columns"
3797 match conf
.columns
with
3799 | Cmulti
(multi
, _) -> multicolumns_to_string multi
3800 | Csplit
(count
, _) -> "-" ^ string_of_int count
3803 let n, a, b = multicolumns_of_string
v in
3804 setcolumns mode n a b);
3807 src#caption
"Pixmap cache" 0;
3808 src#int_with_suffix
"size (advisory)"
3809 (fun () -> conf
.memlimit
)
3810 (fun v -> conf
.memlimit
<- v);
3813 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3814 (string_with_suffix_of_int state
.memused
)
3815 (Hashtbl.length state
.tilemap
)) 1;
3818 src#caption
"Layout" 0;
3819 src#caption2
"Dimension"
3821 Printf.sprintf
"%dx%d (virtual %dx%d)"
3822 state
.winw state
.winh
3827 src#caption2
"Position" (fun () ->
3828 Printf.sprintf
"%dx%d" state
.x state
.y
3831 src#caption2
"Position" (fun () -> describe_location ()) 1
3835 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3836 "Save these parameters as global defaults at exit"
3837 (fun () -> conf
.bedefault
)
3838 (fun v -> conf
.bedefault
<- v)
3842 let btos b = if b then "@Ulguillemet" else "@Urguillemet" in
3843 src#
bool ~offset
:0 ~
btos "Extended parameters"
3844 (fun () -> !showextended)
3845 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3849 (fun () -> conf
.checkers
)
3850 (fun v -> conf
.checkers
<- v; setcheckers v);
3851 src#
bool "update cursor"
3852 (fun () -> conf
.updatecurs
)
3853 (fun v -> conf
.updatecurs
<- v);
3854 src#
bool "scroll-bar on the left"
3855 (fun () -> conf
.leftscroll
)
3856 (fun v -> conf
.leftscroll
<- v);
3858 (fun () -> conf
.verbose
)
3859 (fun v -> conf
.verbose
<- v);
3860 src#
bool "invert colors"
3861 (fun () -> conf
.invert
)
3862 (fun v -> conf
.invert
<- v);
3864 (fun () -> conf
.maxhfit
)
3865 (fun v -> conf
.maxhfit
<- v);
3867 (fun () -> conf
.pax
!= None
)
3870 then conf
.pax
<- Some
(ref (now
(), 0, 0))
3871 else conf
.pax
<- None
);
3872 src#
string "uri launcher"
3873 (fun () -> conf
.urilauncher
)
3874 (fun v -> conf
.urilauncher
<- v);
3875 src#
string "path launcher"
3876 (fun () -> conf
.pathlauncher
)
3877 (fun v -> conf
.pathlauncher
<- v);
3878 src#
string "tile size"
3879 (fun () -> Printf.sprintf
"%dx%d" conf
.tilew conf
.tileh
)
3882 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3883 conf
.tilew
<- max
64 w;
3884 conf
.tileh
<- max
64 h;
3887 state
.text <- Printf.sprintf
"bad tile size `%s': %s"
3890 src#
int "texture count"
3891 (fun () -> conf
.texcount
)
3894 then conf
.texcount
<- v
3895 else showtext '
!'
" Failed to set texture count please retry later"
3897 src#
int "slice height"
3898 (fun () -> conf
.sliceheight
)
3900 conf
.sliceheight
<- v;
3901 wcmd "sliceh %d" conf
.sliceheight
;
3903 src#
int "anti-aliasing level"
3904 (fun () -> conf
.aalevel
)
3906 conf
.aalevel
<- bound
v 0 8;
3907 state
.anchor <- getanchor
();
3908 opendoc state
.path state
.password;
3910 src#
string "page scroll scaling factor"
3911 (fun () -> string_of_float conf
.pgscale)
3914 let s = float_of_string
v in
3917 state
.text <- Printf.sprintf
3918 "bad page scroll scaling factor `%s': %s" v (exntos exn
)
3921 src#
int "ui font size"
3922 (fun () -> fstate
.fontsize
)
3923 (fun v -> setfontsize (bound
v 5 100));
3924 src#
int "hint font size"
3925 (fun () -> conf
.hfsize
)
3926 (fun v -> conf
.hfsize
<- bound
v 5 100);
3927 colorp "background color"
3928 (fun () -> conf
.bgcolor
)
3929 (fun v -> conf
.bgcolor
<- v);
3930 src#
bool "crop hack"
3931 (fun () -> conf
.crophack
)
3932 (fun v -> conf
.crophack
<- v);
3933 src#
string "trim fuzz"
3934 (fun () -> irect_to_string conf
.trimfuzz
)
3937 conf
.trimfuzz
<- irect_of_string
v;
3939 then settrim true conf
.trimfuzz
;
3941 state
.text <- Printf.sprintf
"bad irect `%s': %s" v (exntos exn
)
3943 src#
string "throttle"
3945 match conf
.maxwait
with
3946 | None
-> "show place holder if page is not ready"
3949 then "wait for page to fully render"
3951 "wait " ^ string_of_float
time
3952 ^
" seconds before showing placeholder"
3956 let f = float_of_string
v in
3958 then conf
.maxwait
<- None
3959 else conf
.maxwait
<- Some
f
3961 state
.text <- Printf.sprintf
"bad time `%s': %s" v (exntos exn
)
3963 src#
string "ghyll scroll"
3965 match conf
.ghyllscroll
with
3967 | Some nab
-> ghyllscroll_to_string nab
3970 try conf
.ghyllscroll
<- ghyllscroll_of_string
v
3972 state
.text <- Printf.sprintf
"bad ghyll `%s': %s" v (exntos exn
)
3974 src#
string "selection command"
3975 (fun () -> conf
.selcmd
)
3976 (fun v -> conf
.selcmd
<- v);
3977 src#
string "synctex command"
3978 (fun () -> conf
.stcmd
)
3979 (fun v -> conf
.stcmd
<- v);
3980 src#
string "pax command"
3981 (fun () -> conf
.paxcmd
)
3982 (fun v -> conf
.paxcmd
<- v);
3983 src#
string "ask password command"
3984 (fun () -> conf
.passcmd)
3985 (fun v -> conf
.passcmd <- v);
3986 src#
string "save path command"
3987 (fun () -> conf
.savecmd
)
3988 (fun v -> conf
.savecmd
<- v);
3989 src#colorspace
"color space"
3990 (fun () -> CSTE.to_string conf
.colorspace
)
3992 conf
.colorspace
<- CSTE.of_int
v;
3996 src#paxmark
"pax mark method"
3997 (fun () -> MTE.to_string conf
.paxmark
)
3998 (fun v -> conf
.paxmark
<- MTE.of_int
v);
4002 (fun () -> conf
.usepbo
)
4003 (fun v -> conf
.usepbo
<- v);
4004 src#
bool "mouse wheel scrolls pages"
4005 (fun () -> conf
.wheelbypage
)
4006 (fun v -> conf
.wheelbypage
<- v);
4007 src#
bool "open remote links in a new instance"
4008 (fun () -> conf
.riani
)
4009 (fun v -> conf
.riani
<- v);
4010 src#
bool "edit annotations inline"
4011 (fun () -> conf
.annotinline
)
4012 (fun v -> conf
.annotinline
<- v);
4016 src#caption
"Document" 0;
4017 List.iter
(fun (_, s) -> src#caption
s 1) state
.docinfo
;
4018 src#caption2
"Pages"
4019 (fun () -> string_of_int state
.pagecount
) 1;
4020 src#caption2
"Dimensions"
4021 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4025 src#caption
"Trimmed margins" 0;
4026 src#caption2
"Dimensions"
4027 (fun () -> string_of_int
(List.length state
.pdims
)) 1;
4031 src#caption
"OpenGL" 0;
4032 src#caption
(Printf.sprintf
"Vendor\t%s" (GlMisc.get_string `vendor
)) 1;
4033 src#caption
(Printf.sprintf
"Renderer\t%s" (GlMisc.get_string `renderer
)) 1;
4036 src#caption
"Location" 0;
4037 if nonemptystr state
.origin
4038 then src#caption
("Orign\t" ^ mbtoutf8 state
.origin
) 1;
4039 src#caption
("Path\t" ^ mbtoutf8 state
.path
) 1;
4041 src#reset prevmode prevuioh
;
4046 let prevmode = state
.mode
4047 and prevuioh
= state
.uioh in
4048 fillsrc prevmode prevuioh
;
4049 let source = (src :> lvsource
) in
4050 let modehash = findkeyhash conf
"info" in
4051 state
.uioh <- coe (object (self)
4052 inherit listview ~zebra
:false ~helpmode
:false
4053 ~
source ~trusted
:true ~
modehash as super
4054 val mutable m_prevmemused
= 0
4055 method! infochanged
= function
4057 if m_prevmemused
!= state
.memused
4059 m_prevmemused
<- state
.memused
;
4060 G.postRedisplay "memusedchanged";
4062 | Pdim
-> G.postRedisplay "pdimchanged"
4063 | Docinfo
-> fillsrc prevmode prevuioh
4065 method! key key mask
=
4066 if not
(Wsi.withctrl mask
)
4069 | @left | @kpleft
-> coe (self#updownlevel ~
-1)
4070 | @right
| @kpright
-> coe (self#updownlevel
1)
4071 | _ -> super#
key key mask
4072 else super#
key key mask
4074 G.postRedisplay "info";
4080 inherit lvsourcebase
4081 method getitemcount
= Array.length state
.help
4083 let s, l, _ = state
.help
.(n) in
4086 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4090 match state
.help
.(active) with
4091 | _, _, Action
f -> Some
(f uioh)
4092 | _, _, Noaction
-> Some
uioh
4101 method hasaction
n =
4102 match state
.help
.(n) with
4103 | _, _, Action
_ -> true
4104 | _, _, Noaction
-> false
4110 let modehash = findkeyhash conf
"help" in
4112 state
.uioh <- coe (new listview
4113 ~zebra
:false ~helpmode
:true
4114 ~
source ~trusted
:true ~
modehash);
4115 G.postRedisplay "help";
4121 inherit lvsourcebase
4122 val mutable m_items
= E.a
4124 method getitemcount
= 1 + Array.length m_items
4129 else m_items
.(n-1), 0
4131 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4136 then Buffer.clear state
.errmsgs
;
4143 method hasaction
n =
4147 state
.newerrmsgs
<- false;
4148 let l = Str.split newlinere
(Buffer.contents state
.errmsgs
) in
4149 m_items
<- Array.of_list
l
4158 let source = (msgsource :> lvsource
) in
4159 let modehash = findkeyhash conf
"listview" in
4160 state
.uioh <- coe (object
4161 inherit listview ~zebra
:false ~helpmode
:false
4162 ~
source ~trusted
:false ~
modehash as super
4165 then msgsource#reset
;
4168 G.postRedisplay "msgs";
4172 let editor = getenvwithdef
"EDITOR" E.s in
4176 let tmppath = Filename.temp_file
"llpp" "note" in
4179 let oc = open_out
tmppath in
4183 let execstr = editor ^
" " ^
tmppath in
4185 match popen
execstr [] with
4186 | (exception exn
) ->
4188 Printf.sprintf
"popen(%S) failed: %s" execstr (exntos exn
);
4191 match Unix.waitpid
[] pid with
4192 | (exception exn
) ->
4194 Printf.sprintf
"waitpid(%d) failed: %s" pid (exntos exn
);
4198 | Unix.WEXITED
0 -> filecontents
tmppath
4201 Printf.sprintf
"editor process(%s) exited abnormally: %d"
4204 | Unix.WSIGNALED
n ->
4206 Printf.sprintf
"editor process(%s) was killed by signal %d"
4209 | Unix.WSTOPPED
n ->
4211 Printf.sprintf
"editor(%s) process was stopped by signal %d"
4215 match Unix.unlink
tmppath with
4216 | (exception exn
) ->
4217 showtext '
!'
@@ Printf.sprintf
"failed to ulink %S: %s"
4218 tmppath (exntos exn
);
4223 let enterannotmode opaque slinkindex
=
4226 inherit lvsourcebase
4227 val mutable m_text
= E.s
4228 val mutable m_items
= E.a
4230 method getitemcount
= Array.length m_items
4233 let label, _func
= m_items
.(n) in
4236 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4237 ignore
(uioh, first, pan
);
4240 let _label, func
= m_items
.(active) in
4245 method hasaction
n = nonemptystr
@@ fst m_items
.(n)
4248 let rec split accu b i
=
4250 if p = String.length
s
4251 then (String.sub
s b (p-b), unit) :: accu
4253 if (i
> 70 && s.[p] = ' '
) || s.[p] = '
\r'
|| s.[p] = '
\n'
4255 let ss = if i
= 0 then E.s else String.sub
s b i
in
4256 split ((ss, unit)::accu) (p+1) 0
4261 wcmd "freepage %s" (~
> opaque);
4263 Hashtbl.fold (fun key opaque'
accu ->
4264 if opaque'
= opaque'
4265 then key :: accu else accu) state
.pagemap
[]
4267 List.iter
(Hashtbl.remove state
.pagemap
) keys;
4272 delannot
opaque slinkindex
;
4275 let edit inline
() =
4280 modannot
opaque slinkindex
s;
4286 let mode = state
.mode in
4289 ("annotation: ", m_text
, None
, textentry, update, true),
4290 fun _ -> state
.mode <- mode);
4294 let s = getusertext m_text
in
4299 ( "[Copy]", fun () -> selstring m_text
)
4300 :: ("[Delete]", dele)
4301 :: ("[Edit]", edit conf
.annotinline
)
4303 :: split [] 0 0 |> List.rev
|> Array.of_list
4310 let s = getannotcontents
opaque slinkindex
in
4313 let source = (msgsource :> lvsource
) in
4314 let modehash = findkeyhash conf
"listview" in
4315 state
.uioh <- coe (object
4316 inherit listview ~zebra
:false ~helpmode
:false
4317 ~
source ~trusted
:false ~
modehash
4319 G.postRedisplay "enterannotmode";
4322 let gotounder under =
4323 let getpath filename
=
4325 if nonemptystr filename
4327 if Filename.is_relative filename
4329 let dir = Filename.dirname state
.path in
4331 if Filename.is_implicit
dir
4332 then Filename.concat
(Sys.getcwd
()) dir
4335 Filename.concat
dir filename
4339 if Sys.file_exists
path
4344 | Ulinkgoto
(pageno, top) ->
4348 gotopage1 pageno top;
4354 | Uremote
(filename
, pageno) ->
4355 let path = getpath filename
in
4360 let command = Printf.sprintf
"%s -page %d %S" !selfexec pageno path in
4361 try addpid
@@ popen
command []
4362 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
4364 let anchor = getanchor
() in
4365 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4366 state
.origin
<- E.s;
4367 state
.anchor <- (pageno, 0.0, 0.0);
4368 state
.ranchors
<- ranchor :: state
.ranchors
;
4371 else showtext '
!'
("Could not find " ^ filename
)
4373 | Uremotedest
(filename
, destname
) ->
4374 let path = getpath filename
in
4379 let command = !selfexec ^
" " ^
path ^
" -dest " ^ destname
in
4380 try addpid
@@ popen
command []
4381 with exn
-> dolog
"failed to execute `%s': %s" command (exntos exn
)
4383 let anchor = getanchor
() in
4384 let ranchor = state
.path, state
.password, anchor, state
.origin
in
4385 state
.origin
<- E.s;
4386 state
.nameddest
<- destname
;
4387 state
.ranchors
<- ranchor :: state
.ranchors
;
4390 else showtext '
!'
("Could not find " ^ filename
)
4392 | Uunexpected
_ | Ulaunch
_ | Unamed
_ | Utext
_ | Unone
-> ()
4393 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
4396 let gotooutline (_, _, kind
) =
4400 let (pageno, y, _) = anchor in
4402 (if conf
.presentation
then (pageno, y, 1.0) else anchor)
4407 | Ouri
uri -> gotounder (Ulinkuri
uri); None
4408 | Olaunch cmd
-> gotounder (Ulaunch cmd
); None
4409 | Oremote remote
-> gotounder (Uremote remote
); None
4410 | Ohistory
hist -> gotohist hist; None
4411 | Oremotedest remotedest
-> gotounder (Uremotedest remotedest
); None
4412 | Oaction
f -> f (); None
4413 | Oreaction
f -> Some
(f ())
4416 let outlinesource sourcetype
=
4418 inherit lvsourcebase
4419 val mutable m_items
= E.a
4420 val mutable m_minfo
= E.a
4421 val mutable m_orig_items
= E.a
4422 val mutable m_orig_minfo
= E.a
4423 val mutable m_narrow_patterns
= []
4424 val mutable m_hadremovals
= false
4425 val mutable m_gen
= -1
4427 method getitemcount
=
4428 Array.length m_items
+ (if m_hadremovals
then 1 else 0)
4431 if n == Array.length m_items
&& m_hadremovals
4433 ("[Confirm removal]", 0)
4435 let s, n, _ = m_items
.(n) in
4438 method exit ~
uioh ~cancel ~
active ~
first ~pan
=
4439 ignore
(uioh, first);
4440 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
4442 if m_narrow_patterns
= []
4443 then m_orig_items
, m_orig_minfo
4444 else m_items
, m_minfo
4449 if not
confrimremoval
4453 match gotooutline m_items
.(active) with
4456 self#reset emptyanchor outlines
;
4460 state
.bookmarks
<- Array.to_list m_items
;
4461 m_orig_items
<- m_items
;
4462 m_orig_minfo
<- m_minfo
;
4472 method hasaction
_ = true
4475 if Array.length m_items
!= Array.length m_orig_items
4478 match m_narrow_patterns
with
4480 | many
-> String.concat
"@Uellipsis" (List.rev many
)
4482 "Narrowed to " ^
s ^
" (ctrl-u to restore)"
4486 match m_narrow_patterns
with
4489 | head
:: _ -> "@Uellipsis" ^ head
4491 method narrow
pattern =
4492 match Str.regexp_case_fold
pattern with
4495 let rec loop accu minfo n =
4498 m_items
<- Array.of_list
accu;
4499 m_minfo
<- Array.of_list
minfo;
4502 let (s, _, t
) as o = m_items
.(n) in
4505 | Oaction
_ | Oreaction
_ -> o :: accu, (0, 0) :: minfo
4506 | Onone
| Oanchor
_ | Ouri
_ | Olaunch
_
4507 | Oremote
_ | Oremotedest
_ | Ohistory
_ ->
4508 match Str.search_forward
re s 0 with
4509 | exception Not_found
-> accu, minfo
4510 | first -> o :: accu, (first, Str.match_end
()) :: minfo
4512 loop accu minfo (n-1)
4514 loop [] [] (Array.length m_items
- 1)
4516 method! getminfo
= m_minfo
4520 match sourcetype
with
4521 | `bookmarks
-> Array.of_list state
.bookmarks
4522 | `outlines
-> state
.outlines
4523 | `history
-> genhistoutlines ()
4525 m_minfo
<- m_orig_minfo
;
4526 m_items
<- m_orig_items
4529 if sourcetype
= `bookmarks
4531 if m >= 0 && m < Array.length m_items
4533 m_hadremovals
<- true;
4534 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
4535 let n = if n >= m then n+1 else n in
4540 method add_narrow_pattern
pattern =
4541 m_narrow_patterns
<- pattern :: m_narrow_patterns
4543 method del_narrow_pattern
=
4544 match m_narrow_patterns
with
4545 | _ :: rest
-> m_narrow_patterns
<- rest
4550 match m_narrow_patterns
with
4551 | pattern :: [] -> self#narrow
pattern; pattern
4553 List.fold_left
(fun accu pattern ->
4554 self#narrow
pattern;
4555 pattern ^
"@Uellipsis" ^
accu) E.s list
4557 method calcactive
anchor =
4558 let rely = getanchory anchor in
4559 let rec loop n best bestd
=
4560 if n = Array.length m_items
4563 let _, _, kind
= m_items
.(n) in
4566 let orely = getanchory anchor in
4567 let d = abs
(orely - rely) in
4570 else loop (n+1) best bestd
4571 | Onone
| Oremote
_ | Olaunch
_
4572 | Oremotedest
_ | Ouri
_ | Ohistory
_ | Oaction
_ | Oreaction
_ ->
4573 loop (n+1) best bestd
4577 method reset
anchor items =
4578 m_hadremovals
<- false;
4579 if state
.gen
!= m_gen
4581 m_orig_items
<- items;
4583 m_narrow_patterns
<- [];
4585 m_orig_minfo
<- E.a;
4589 if items != m_orig_items
4591 m_orig_items
<- items;
4592 if m_narrow_patterns
== []
4593 then m_items
<- items;
4596 let active = self#calcactive
anchor in
4598 m_first
<- firstof m_first
active
4602 let enteroutlinemode, enterbookmarkmode
, enterhistmode
=
4603 let mkselector sourcetype
=
4604 let source = outlinesource sourcetype
in
4607 match sourcetype
with
4608 | `bookmarks
-> Array.of_list state
.bookmarks
4609 | `
outlines -> state
.outlines
4610 | `history
-> genhistoutlines ()
4612 if Array.length
outlines = 0
4614 showtext ' ' errmsg
;
4618 state
.text <- source#greetmsg
;
4619 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
4620 let anchor = getanchor
() in
4621 source#reset
anchor outlines;
4623 coe (new outlinelistview ~zebra
:(sourcetype
=`history
) ~
source);
4624 G.postRedisplay "enter selector";
4627 let mkenter sourcetype errmsg
=
4628 let enter = mkselector sourcetype
in
4629 fun () -> enter errmsg
4631 (**)mkenter `
outlines "Document has no outline"
4632 , mkenter `bookmarks
"Document has no bookmarks (yet)"
4633 , mkenter `history
"History is empty"
4636 let quickbookmark ?title
() =
4637 match state
.layout with
4643 let tm = Unix.localtime
(now
()) in
4645 "Quick (page %d) (bookmarked at %02d/%02d/%d %02d:%02d)"
4649 (tm.Unix.tm_year
+ 1900)
4652 | Some
title -> title
4654 state
.bookmarks
<- (title, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
4657 let setautoscrollspeed step goingdown
=
4658 let incr = max
1 ((abs step
) / 2) in
4659 let incr = if goingdown
then incr else -incr in
4660 let astep = boundastep state
.winh
(step
+ incr) in
4661 state
.autoscroll
<- Some
astep;
4665 match conf
.columns
with
4667 | Csingle
_ | Cmulti
_ -> state
.x != 0 || conf
.zoom > 1.0
4670 let panbound x = bound
x (-state
.w) (wadjsb () + state
.winw
);;
4672 let existsinrow pageno (columns
, coverA
, coverB
) p =
4673 let last = ((pageno - coverA
) mod columns
) + columns
in
4674 let rec any = function
4677 if l.pageno = coverA
- 1 || l.pageno = state
.pagecount
- coverB
4681 then (if l.pageno = last then false else any rest
)
4689 match state
.layout with
4691 let pageno = page_of_y state
.y in
4692 gotoghyll (getpagey
(pageno+1))
4694 match conf
.columns
with
4696 if conf
.presentation
&& rest
== [] && l.pageh
> l.pagey + l.pagevh
4698 let y = clamp (pgscale state
.winh
) in
4701 let pageno = min
(l.pageno+1) (state
.pagecount
-1) in
4702 gotoghyll (getpagey
pageno)
4703 | Cmulti
((c, _, _) as cl, _) ->
4704 if conf
.presentation
4705 && (existsinrow l.pageno cl
4706 (fun l -> l.pageh
> l.pagey + l.pagevh))
4708 let y = clamp (pgscale state
.winh
) in
4711 let pageno = min
(l.pageno+c) (state
.pagecount
-1) in
4712 gotoghyll (getpagey
pageno)
4714 if l.pageno < state
.pagecount
- 1 || l.pagecol
< n - 1
4716 let pagey, pageh
= getpageyh
l.pageno in
4717 let pagey = pagey + pageh
* l.pagecol
in
4718 let ips = if l.pagecol
= 0 then 0 else conf
.interpagespace
in
4719 gotoghyll (pagey + pageh
+ ips)
4723 match state
.layout with
4725 let pageno = page_of_y state
.y in
4726 gotoghyll (getpagey
(pageno-1))
4728 match conf
.columns
with
4730 if conf
.presentation
&& l.pagey != 0
4732 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4734 let pageno = max
0 (l.pageno-1) in
4735 gotoghyll (getpagey
pageno)
4736 | Cmulti
((c, _, coverB
) as cl, _) ->
4737 if conf
.presentation
&&
4738 (existsinrow l.pageno cl (fun l -> l.pagey != 0))
4740 gotoghyll (clamp (pgscale ~
-(state
.winh
)))
4743 if l.pageno = state
.pagecount
- coverB
4747 let pageno = max
0 (l.pageno-decr) in
4748 gotoghyll (getpagey
pageno)
4756 let pageno = max
0 (l.pageno-1) in
4757 let pagey, pageh
= getpageyh
pageno in
4760 let pagey, pageh
= getpageyh
l.pageno in
4761 pagey + pageh
* (l.pagecol
-1) - conf
.interpagespace
4767 if emptystr conf
.savecmd
4768 then error
"don't know where to save modified document"
4770 let savecmd = Str.global_replace percentsre state
.path conf
.savecmd in
4773 (fun s -> error
"failed to obtain path to the saved copy: %s" s)
4778 let tmp = path ^
".tmp" in
4780 Unix.rename
tmp path;
4783 let viewkeyboard key mask
=
4785 let mode = state
.mode in
4786 state
.mode <- Textentry
(te, fun _ -> state
.mode <- mode);
4789 G.postRedisplay "view:enttext"
4791 let ctrl = Wsi.withctrl mask
in
4793 if key >= 0xffb0 && key < 0xffb9 then key - 0xffb0 + 48 else key
4799 if hasunsavedchanges
()
4803 if conf
.angle
mod 360 = 0 && not
(isbirdseye state
.mode)
4805 state
.mode <- LinkNav
(Ltgendir
0);
4808 else showtext '
!'
"Keyboard link navigation does not work under rotation"
4811 begin match state
.mstate
with
4814 G.postRedisplay "kill rect";
4817 | Mscrolly
| Mscrollx
4820 begin match state
.mode with
4823 G.postRedisplay "esc leave linknav"
4827 match state
.ranchors
with
4829 | (path, password, anchor, origin
) :: rest
->
4830 state
.ranchors
<- rest
;
4831 state
.anchor <- anchor;
4832 state
.origin
<- origin
;
4833 state
.nameddest
<- E.s;
4834 opendoc path password
4839 gotoghyll (getnav ~
-1)
4850 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
;
4851 G.postRedisplay "dehighlight";
4853 | @slash
| @question
->
4854 let ondone isforw
s =
4855 cbput state
.hists
.pat
s;
4856 state
.searchpattern
<- s;
4859 let s = String.make
1 (Char.chr
key) in
4860 enttext (s, E.s, Some
(onhist state
.hists
.pat
),
4861 textentry, ondone (key = @slash
), true)
4863 | @plus
| @kpplus
| @equals
when ctrl ->
4864 let incr = if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
4865 setzoom (conf
.zoom +. incr)
4867 | @plus
| @kpplus
->
4870 try int_of_string
s with exc
->
4871 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4877 state
.text <- "page bias is now " ^ string_of_int
n;
4880 enttext ("page bias: ", E.s, None
, intentry, ondone, true)
4882 | @minus
| @kpminus
when ctrl ->
4883 let decr = if conf
.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
4884 setzoom (max
0.01 (conf
.zoom -. decr))
4886 | @minus
| @kpminus
->
4887 let ondone msg
= state
.text <- msg
in
4889 "option [acfhilpstvxACFPRSZTISM]: ", E.s, None
,
4890 optentry state
.mode, ondone, true
4901 | (@1 | @2) when ctrl && conf
.fitmodel
!= FitPage
-> (* ctrl-1/2 *)
4903 match conf
.columns
with
4904 | Csingle
_ | Cmulti
_ -> 1
4905 | Csplit
(n, _) -> n
4907 let h = state
.winh
-
4908 conf
.interpagespace
lsl (if conf
.presentation
then 1 else 0)
4910 let zoom = zoomforh state
.winw
h (vscrollw ()) cols in
4911 if zoom > 0.0 && (key = 50 || zoom < 1.0)
4916 match conf
.fitmodel
with
4917 | FitWidth
-> FitProportional
4918 | FitProportional
-> FitPage
4919 | FitPage
-> FitWidth
4921 state
.text <- "fit model: " ^
FMTE.to_string
fm;
4922 reqlayout conf
.angle
fm
4930 | (48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57)
4931 when not
ctrl -> (* 0..9 *)
4934 try int_of_string
s with exc
->
4935 state
.text <- Printf.sprintf
"bad integer `%s': %s" s (exntos exc
);
4941 cbput state
.hists
.pag
(string_of_int
n);
4942 gotopage1 (n + conf
.pagebias
- 1) 0;
4945 let pageentry text key =
4946 match Char.unsafe_chr
key with
4947 | '
g'
-> TEdone
text
4948 | _ -> intentry text key
4950 let text = String.make
1 (Char.chr
key) in
4951 enttext (":", text, Some
(onhist state
.hists
.pag
),
4952 pageentry, ondone, true)
4955 conf
.scrollb
<- if conf
.scrollb
= 0 then (scrollbvv
lor scrollbhv
) else 0;
4956 reshape state
.winw state
.winh
;
4959 state
.bzoom
<- not state
.bzoom
;
4961 showtext ' '
("block zoom " ^
if state
.bzoom
then "on" else "off")
4964 conf
.hlinks
<- not conf
.hlinks
;
4965 state
.text <- "highlightlinks " ^
if conf
.hlinks
then "on" else "off";
4966 G.postRedisplay "toggle highlightlinks";
4969 state
.glinks
<- true;
4970 let mode = state
.mode in
4971 state
.mode <- Textentry
(
4972 (":", E.s, None
, linknentry, linknact gotounder, false),
4974 state
.glinks
<- false;
4978 G.postRedisplay "view:linkent(F)"
4981 state
.glinks
<- true;
4982 let mode = state
.mode in
4983 state
.mode <- Textentry
(
4985 ":", E.s, None
, linknentry, linknact (fun under ->
4986 selstring (undertext under);
4990 state
.glinks
<- false;
4994 G.postRedisplay "view:linkent"
4997 begin match state
.autoscroll
with
4999 conf
.autoscrollstep
<- step
;
5000 state
.autoscroll
<- None
5002 if conf
.autoscrollstep
= 0
5003 then state
.autoscroll
<- Some
1
5004 else state
.autoscroll
<- Some conf
.autoscrollstep
5011 setpresentationmode (not conf
.presentation
);
5012 showtext ' '
("presentation mode " ^
5013 if conf
.presentation
then "on" else "off");
5016 if List.mem
Wsi.Fullscreen state
.winstate
5017 then Wsi.reshape conf
.cwinw conf
.cwinh
5018 else Wsi.fullscreen
()
5021 search state
.searchpattern
false
5024 search state
.searchpattern
true
5027 begin match state
.layout with
5030 gotoghyll (getpagey
l.pageno)
5036 | @delete
| @kpdelete
-> (* delete *)
5040 showtext ' '
(describe_location ());
5043 begin match state
.layout with
5046 Wsi.reshape (l.pagew
+ vscrollw ()) l.pageh
;
5051 enterbookmarkmode
()
5059 | @e when Buffer.length state
.errmsgs
> 0 ->
5064 match state
.layout with
5069 (s, 0, Oanchor
(getanchor1
l)) :: state
.bookmarks
5072 enttext ("bookmark: ", E.s, None
, textentry, ondone, true)
5076 showtext ' '
"Quick bookmark added";
5079 begin match state
.layout with
5081 let rect = getpdimrect
l.pagedimno
in
5085 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
5086 truncate
(1.2 *. (rect.(3) -. rect.(0))))
5088 (truncate
(rect.(1) -. rect.(0)),
5089 truncate
(rect.(3) -. rect.(0)))
5091 let w = truncate
((float w)*.conf
.zoom)
5092 and h = truncate
((float h)*.conf
.zoom) in
5095 state
.anchor <- getanchor
();
5096 Wsi.reshape (w + vscrollw ()) (h + conf
.interpagespace
)
5098 G.postRedisplay "z";
5103 | @x -> state
.roam
()
5106 reqlayout (conf
.angle
+
5107 (if key = @Gt
then 30 else -30)) conf
.fitmodel
5111 bound
(conf
.colorscale
+. (if key = 93 then 0.1 else -0.1)) 0.0 1.0
5113 G.postRedisplay "brightness";
5115 | @c when state
.mode = View
->
5120 let m = (wadjsb () + state
.winw
- state
.w) / 2 in
5122 gotoy_and_clear_text state
.y
5126 match state
.prevcolumns
with
5127 | None
-> (1, 0, 0), 1.0
5128 | Some
(columns
, z
) ->
5131 | Csplit
(c, _) -> -c, 0, 0
5132 | Cmulti
((c, a, b), _) -> c, a, b
5133 | Csingle
_ -> 1, 0, 0
5137 setcolumns View
c a b;
5140 | @down
| @up
when ctrl && Wsi.withshift mask
->
5141 let zoom, x = state
.prevzoom
in
5145 | @k
| @up
| @kpup
->
5146 begin match state
.autoscroll
with
5148 begin match state
.mode with
5149 | Birdseye beye
-> upbirdseye 1 beye
5154 then gotoy_and_clear_text (clamp ~
-(state
.winh
/2))
5156 if not
(Wsi.withshift mask
) && conf
.presentation
5158 else gotoghyll1 true (clamp (-conf
.scrollstep
))
5162 setautoscrollspeed n false
5165 | @j
| @down
| @kpdown
->
5166 begin match state
.autoscroll
with
5168 begin match state
.mode with
5169 | Birdseye beye
-> downbirdseye 1 beye
5174 then gotoy_and_clear_text (clamp (state
.winh
/2))
5176 if not
(Wsi.withshift mask
) && conf
.presentation
5178 else gotoghyll1 true (clamp (conf
.scrollstep
))
5182 setautoscrollspeed n true
5185 | @left | @right
| @kpleft
| @kpright
when not
(Wsi.withalt mask
) ->
5191 else conf
.hscrollstep
5193 let dx = if key = @left || key = @kpleft
then dx else -dx in
5194 state
.x <- panbound (state
.x + dx);
5195 gotoy_and_clear_text state
.y
5198 G.postRedisplay "left/right"
5201 | @prior
| @kpprior
->
5205 match state
.layout with
5207 | l :: _ -> state
.y - l.pagey
5209 clamp (pgscale (-state
.winh
))
5213 | @next | @kpnext
->
5217 match List.rev state
.layout with
5219 | l :: _ -> getpagey
l.pageno
5221 clamp (pgscale state
.winh
)
5225 | @g | @home
| @kphome
->
5228 | @G
| @jend
| @kpend
->
5230 gotoghyll (clamp state
.maxy)
5232 | @right
| @kpright
when Wsi.withalt mask
->
5233 gotoghyll (getnav 1)
5234 | @left | @kpleft
when Wsi.withalt mask
->
5235 gotoghyll (getnav ~
-1)
5240 | @v when conf
.debug
->
5243 match getopaque l.pageno with
5246 let x0, y0, x1, y1 = pagebbox
opaque in
5247 let a,b = float x0, float y0 in
5248 let c,d = float x1, float y0 in
5249 let e,f = float x1, float y1 in
5250 let h,j
= float x0, float y1 in
5251 let rect = (a,b,c,d,e,f,h,j
) in
5253 state
.rects
<- (l.pageno, l.pageno mod 3, rect) :: state
.rects
;
5255 G.postRedisplay "v";
5258 let mode = state
.mode in
5259 let cmd = ref E.s in
5260 let onleave = function
5261 | Cancel
-> state
.mode <- mode
5264 match getopaque l.pageno with
5265 | Some
opaque -> pipesel opaque !cmd
5266 | None
-> ()) state
.layout;
5270 cbput state
.hists
.sel
s;
5274 "| ", !cmd, Some
(onhist state
.hists
.sel
), textentry, ondone, true
5276 G.postRedisplay "|";
5277 state
.mode <- Textentry
(te, onleave);
5280 vlog "huh? %s" (Wsi.keyname
key)
5283 let linknavkeyboard key mask
linknav =
5284 let getpage pageno =
5285 let rec loop = function
5287 | l :: _ when l.pageno = pageno -> Some
l
5288 | _ :: rest
-> loop rest
5289 in loop state
.layout
5291 let doexact (pageno, n) =
5292 match getopaque pageno, getpage pageno with
5293 | Some
opaque, Some
l ->
5294 if key = @enter || key = @kpenter
5296 let under = getlink
opaque n in
5297 G.postRedisplay "link gotounder";
5304 Some
(findlink
opaque LDfirst
), -1
5307 Some
(findlink
opaque LDlast
), 1
5310 Some
(findlink
opaque (LDleft
n)), -1
5313 Some
(findlink
opaque (LDright
n)), 1
5316 Some
(findlink
opaque (LDup
n)), -1
5319 Some
(findlink
opaque (LDdown
n)), 1
5324 begin match findpwl
l.pageno dir with
5328 state
.mode <- LinkNav
(Ltgendir
dir);
5329 let y, h = getpageyh
pageno in
5332 then y + h - state
.winh
5337 begin match getopaque pageno, getpage pageno with
5338 | Some
opaque, Some
_ ->
5340 let ld = if dir > 0 then LDfirst
else LDlast
in
5343 begin match link with
5345 showlinktype (getlink
opaque m);
5346 state
.mode <- LinkNav
(Ltexact
(pageno, m));
5347 G.postRedisplay "linknav jpage";
5348 | Lnotfound
-> notfound dir
5354 begin match opt with
5355 | Some Lnotfound
-> pwl l dir;
5356 | Some
(Lfound
m) ->
5360 let _, y0, _, y1 = getlinkrect
opaque m in
5362 then gotopage1 l.pageno y0
5364 let d = fstate
.fontsize
+ 1 in
5365 if y1 - l.pagey > l.pagevh - d
5366 then gotopage1 l.pageno (y1 - state
.winh
- hscrollh () + d)
5367 else G.postRedisplay "linknav";
5369 showlinktype (getlink
opaque m);
5370 state
.mode <- LinkNav
(Ltexact
(l.pageno, m));
5373 | None
-> viewkeyboard key mask
5375 | _ -> viewkeyboard key mask
5380 G.postRedisplay "leave linknav"
5384 | Ltgendir
_ | Ltnotready
_ -> viewkeyboard key mask
5385 | Ltexact exact
-> doexact exact
5388 let keyboard key mask
=
5389 if (key = 103 && Wsi.withctrl mask
) && not
(istextentry state
.mode)
5390 then wcmd "interrupt"
5391 else state
.uioh <- state
.uioh#
key key mask
5394 let birdseyekeyboard key mask
5395 ((oconf
, leftx
, pageno, hooverpageno
, anchor) as beye
) =
5397 match conf
.columns
with
5399 | Cmulti
((c, _, _), _) -> c
5400 | Csplit
_ -> failwith
"bird's eye split mode"
5402 let pgh layout = List.fold_left
5403 (fun m l -> max
l.pageh
m) state
.winh
layout in
5405 | @l when Wsi.withctrl mask
->
5406 let y, h = getpageyh
pageno in
5407 let top = (state
.winh
- h) / 2 in
5408 gotoy (max
0 (y - top))
5409 | @enter | @kpenter
-> leavebirdseye beye
false
5410 | @escape
-> leavebirdseye beye
true
5411 | @up
-> upbirdseye incr beye
5412 | @down
-> downbirdseye incr beye
5413 | @left -> upbirdseye 1 beye
5414 | @right
-> downbirdseye 1 beye
5417 begin match state
.layout with
5421 state
.mode <- Birdseye
(
5422 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5424 gotopage1 l.pageno 0;
5427 let layout = layout (state
.y-state
.winh
) (pgh state
.layout) in
5429 | [] -> gotoy (clamp (-state
.winh
))
5431 state
.mode <- Birdseye
(
5432 oconf
, leftx
, l.pageno, hooverpageno
, anchor
5434 gotopage1 l.pageno 0
5437 | [] -> gotoy (clamp (-state
.winh
))
5441 begin match List.rev state
.layout with
5443 let layout = layout (state
.y + (pgh state
.layout)) state
.winh
in
5444 begin match layout with
5446 let incr = l.pageh
- l.pagevh in
5451 oconf
, leftx
, state
.pagecount
- 1, hooverpageno
, anchor
5453 G.postRedisplay "birdseye pagedown";
5455 else gotoy (clamp (incr + conf
.interpagespace
*2));
5459 Birdseye
(oconf
, leftx
, l.pageno, hooverpageno
, anchor);
5460 gotopage1 l.pageno 0;
5463 | [] -> gotoy (clamp state
.winh
)
5467 state
.mode <- Birdseye
(oconf
, leftx
, 0, hooverpageno
, anchor);
5471 let pageno = state
.pagecount
- 1 in
5472 state
.mode <- Birdseye
(oconf
, leftx
, pageno, hooverpageno
, anchor);
5473 if not
(pagevisible state
.layout pageno)
5476 match List.rev state
.pdims
with
5478 | (_, _, h, _) :: _ -> h
5480 gotoy (max
0 (getpagey
pageno - (state
.winh
- h - conf
.interpagespace
)))
5481 else G.postRedisplay "birdseye end";
5483 | _ -> viewkeyboard key mask
5488 match state
.mode with
5489 | Textentry
_ -> scalecolor 0.4
5491 | View
-> scalecolor 1.0
5492 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
5493 if l.pageno = hooverpageno
5496 if l.pageno = pageno
5498 let c = scalecolor 1.0 in
5500 GlDraw.line_width
3.0;
5501 let dispx = xadjsb () + l.pagedispx in
5503 (float (dispx-1)) (float (l.pagedispy-1))
5504 (float (dispx+l.pagevw+1))
5505 (float (l.pagedispy+l.pagevh+1))
5507 GlDraw.line_width
1.0;
5516 let postdrawpage l linkindexbase
=
5517 match getopaque l.pageno with
5519 if tileready l l.pagex
l.pagey
5521 let x = l.pagedispx - l.pagex
+ xadjsb ()
5522 and y = l.pagedispy - l.pagey in
5524 match conf
.columns
with
5525 | Csingle
_ | Cmulti
_ ->
5526 (if conf
.hlinks
then 1 else 0)
5528 && not
(isbirdseye state
.mode) then 2 else 0)
5532 match state
.mode with
5533 | Textentry
((_, s, _, _, _, _), _) when state
.glinks
-> s
5539 postprocess
opaque hlmask x y (linkindexbase
, s, conf
.hfsize
);
5544 let scrollindicator () =
5545 let sbw, ph
, sh = state
.uioh#
scrollph in
5546 let sbh, pw, sw = state
.uioh#scrollpw
in
5551 else ((state
.winw
- sbw), state
.winw
, 0)
5554 GlDraw.color (0.64, 0.64, 0.64);
5555 filledrect (float x0) 0. (float x1) (float state
.winh
);
5557 (float hx0
) (float (state
.winh
- sbh))
5558 (float (hx0
+ wadjsb () + state
.winw
)) (float state
.winh
)
5560 GlDraw.color (0.0, 0.0, 0.0);
5562 filledrect (float x0) ph
(float x1) (ph
+. sh);
5563 let pw = pw +. float hx0
in
5564 filledrect pw (float (state
.winh
- sbh)) (pw +. sw) (float state
.winh
);
5568 match state
.mstate
with
5569 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
5572 | Msel
((x0, y0), (x1, y1)) ->
5573 let identify opaque l px py = Some
(opaque, l.pageno, px, py) in
5574 let o0,n0
,px0
,py0
= onppundermouse identify x0 y0 (~
< E.s, -1, 0, 0) in
5575 let _o1,n1
,px1
,py1
= onppundermouse identify x1 y1 (~
< E.s, -1, 0, 0) in
5576 if n0
!= -1 && n0
= n1
then seltext
o0 (px0
, py0
, px1
, py1
);
5579 let showrects = function [] -> () | rects
->
5581 GlDraw.color (0.0, 0.0, 1.0) ~
alpha:0.5;
5582 GlFunc.blend_func ~
src:`src_alpha ~dst
:`one_minus_src_alpha
;
5584 (fun (pageno, c, (x0, y0, x1, y1, x2
, y2
, x3
, y3
)) ->
5586 if l.pageno = pageno
5588 let dx = float (l.pagedispx - l.pagex
) in
5589 let dy = float (l.pagedispy - l.pagey) in
5590 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~
alpha:0.5;
5591 Raw.sets_float state
.vraw ~
pos:0
5596 GlArray.vertex `two state
.vraw
;
5597 GlArray.draw_arrays `triangle_strip ~
first:0 ~count
:4;
5606 GlClear.color (scalecolor2 conf
.bgcolor
);
5607 GlClear.clear
[`
color];
5608 List.iter
drawpage state
.layout;
5610 match state
.mode with
5611 | LinkNav
(Ltexact
(pageno, linkno
)) ->
5612 begin match getopaque pageno with
5614 let dx = xadjsb () in
5615 let x0, y0, x1, y1 = getlinkrect
opaque linkno
in
5616 let x0 = x0 + dx and x1 = x1 + dx 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 gotoy (state
.y + y0);
5663 state
.anchor <- getanchor
();
5664 let zoom = (float state
.w) /. float (x1 - x0) in
5667 let adjw = wadjsb () + state
.winw
in
5669 then (adjw - state
.w) / 2
5672 match conf
.fitmodel
with
5673 | FitWidth
| FitProportional
-> simple ()
5675 match conf
.columns
with
5677 onppundermouse (fun _ l _ _ -> Some
l.pagedispx) x0 y0 x0
5678 | Cmulti
_ | Csingle
_ -> simple ()
5680 state
.x <- (state
.x + margin) - x0;
5685 let annot inline
x y =
5686 match unproject x y with
5687 | Some
(opaque, n, ux
, uy
) ->
5689 addannot
opaque ux uy
text;
5690 wcmd "freepage %s" (~
> opaque);
5691 Hashtbl.remove state
.pagemap
(n, state
.gen
);
5697 let ondone s = add s in
5698 let mode = state
.mode in
5699 state
.mode <- Textentry
(
5700 ("annotation: ", E.s, None
, textentry, ondone, true),
5701 fun _ -> state
.mode <- mode);
5704 G.postRedisplay "annot"
5706 add @@ getusertext E.s
5711 let g opaque l px py =
5712 match rectofblock
opaque px py with
5714 let x0 = a.(0) -. 20. in
5715 let x1 = a.(1) +. 20. in
5716 let y0 = a.(2) -. 20. in
5717 let zoom = (float state
.w) /. (x1 -. x0) in
5718 let pagey = getpagey
l.pageno in
5719 gotoy_and_clear_text (pagey + truncate
y0);
5720 state
.anchor <- getanchor
();
5721 let margin = (state
.w - l.pagew
)/2 in
5722 state
.x <- -truncate
x0 - margin;
5727 match conf
.columns
with
5729 showtext '
!'
"block zooming does not work properly in split columns mode"
5730 | Cmulti
_ | Csingle
_ -> onppundermouse g x y ()
5734 let winw = wadjsb () + state
.winw - 1 in
5735 let s = float x /. float winw in
5736 let destx = truncate
(float (state
.w + winw) *. s) in
5737 state
.x <- winw - destx;
5738 gotoy_and_clear_text state
.y;
5739 state
.mstate
<- Mscrollx
;
5743 let s = float y /. float state
.winh
in
5744 let desty = truncate
(float (state
.maxy - state
.winh
) *. s) in
5745 gotoy_and_clear_text desty;
5746 state
.mstate
<- Mscrolly
;
5749 let viewmulticlick clicks
x y mask
=
5750 let g opaque l px py =
5758 if markunder
opaque px py mark
5762 match getopaque l.pageno with
5764 | Some
opaque -> pipesel opaque cmd
5766 state
.roam
<- (fun () -> dopipe conf
.paxcmd
);
5767 if not
(Wsi.withctrl mask
) then dopipe conf
.selcmd
;
5772 G.postRedisplay "viewmulticlick";
5773 onppundermouse g x y (fun () -> showtext '
!'
"Nothing to select") ();
5777 match conf
.columns
with
5779 | Csingle
_ | Cmulti
_ -> conf
.angle
mod 360 = 0
5782 let viewmouse button down
x y mask
=
5784 | n when (n == 4 || n == 5) && not down
->
5785 if Wsi.withctrl mask
5787 match state
.mstate
with
5788 | Mzoom
(oldn
, i
) ->
5796 if conf
.zoom +. 0.01 > 0.1 then 0.1 else 0.01
5798 if conf
.zoom -. 0.1 < 0.1 then -0.01 else -0.1
5800 let zoom = conf
.zoom -. incr in
5802 state
.mstate
<- Mzoom
(n, 0);
5804 state
.mstate
<- Mzoom
(n, i
+1);
5806 else state
.mstate
<- Mzoom
(n, 0)
5810 | Mscrolly
| Mscrollx
5812 | Mnone
-> state
.mstate
<- Mzoom
(n, 0)
5815 match state
.autoscroll
with
5816 | Some step
-> setautoscrollspeed step
(n=4)
5818 if conf
.wheelbypage
|| conf
.presentation
5827 then -conf
.scrollstep
5828 else conf
.scrollstep
5830 let incr = incr * 2 in
5831 let y = clamp incr in
5832 gotoy_and_clear_text y
5835 | n when (n = 6 || n = 7) && not down
&& canpan () ->
5837 panbound (state
.x + (if n = 7 then -2 else 2) * conf
.hscrollstep
);
5838 gotoy_and_clear_text state
.y
5840 | 1 when Wsi.withshift mask
->
5841 state
.mstate
<- Mnone
;
5844 match unproject x y with
5845 | Some
(_, pageno, ux
, uy
) ->
5846 let cmd = Printf.sprintf
5848 conf
.stcmd state
.path pageno ux uy
5850 addpid
@@ popen
cmd []
5854 | 1 when Wsi.withctrl mask
->
5857 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5858 state
.mstate
<- Mpan
(x, y)
5861 state
.mstate
<- Mnone
5866 if Wsi.withshift mask
5868 annot conf
.annotinline
x y;
5869 G.postRedisplay "addannot"
5873 Wsi.setcursor
Wsi.CURSOR_CYCLE
;
5874 state
.mstate
<- Mzoomrect
(p, p)
5877 match state
.mstate
with
5878 | Mzoomrect
((x0, y0), _) ->
5879 if abs
(x-x0) > 10 && abs
(y - y0) > 10
5880 then zoomrect x0 y0 x y
5883 G.postRedisplay "kill accidental zoom rect";
5887 | Mscrolly
| Mscrollx
5893 | 1 when x > state
.winw - vscrollw () ->
5896 let _, position, sh = state
.uioh#
scrollph in
5897 if y > truncate
position && y < truncate
(position +. sh)
5898 then state
.mstate
<- Mscrolly
5901 state
.mstate
<- Mnone
5903 | 1 when y > state
.winh
- hscrollh () ->
5906 let _, position, sw = state
.uioh#scrollpw
in
5907 if x > truncate
position && x < truncate
(position +. sw)
5908 then state
.mstate
<- Mscrollx
5911 state
.mstate
<- Mnone
5913 | 1 when state
.bzoom
-> if not down
then zoomblock x y
5916 let dest = if down
then getunder x y else Unone
in
5917 begin match dest with
5920 | Uremote
_ | Uremotedest
_
5921 | Uunexpected
_ | Ulaunch
_ | Unamed
_ ->
5924 | Unone
when down
->
5925 Wsi.setcursor
Wsi.CURSOR_FLEUR
;
5926 state
.mstate
<- Mpan
(x, y);
5928 | Uannotation
(opaque, slinkindex
) -> enterannotmode opaque slinkindex
5930 | Unone
| Utext
_ ->
5935 state
.mstate
<- Msel
((x, y), (x, y));
5936 G.postRedisplay "mouse select";
5940 match state
.mstate
with
5943 | Mzoom
_ | Mscrollx
| Mscrolly
->
5944 state
.mstate
<- Mnone
5946 | Mzoomrect
((x0, y0), _) ->
5950 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
5951 state
.mstate
<- Mnone
5953 | Msel
((x0, y0), (x1, y1)) ->
5954 let rec loop = function
5958 let a0 = l.pagedispy in
5959 let a1 = a0 + l.pagevh in
5960 let b0 = l.pagedispx in
5961 let b1 = b0 + l.pagevw in
5962 ((y0 >= a0 && y0 <= a1) || (y1 >= a0 && y1 <= a1))
5963 && ((x0 >= b0 && x0 <= b1) || (x1 >= b0 && x1 <= b1))
5967 match getopaque l.pageno with
5970 match Unix.pipe
() with
5974 "can not create sel pipe: %s"
5978 Ne.clo fd
(fun msg
->
5979 dolog
"%s close failed: %s" what msg
)
5982 try popen
cmd [r
, 0; w, -1]
5984 dolog
"can not execute %S: %s"
5991 G.postRedisplay "copysel";
5993 else clo "Msel pipe/w" w;
5994 clo "Msel pipe/r" r
;
5996 dosel conf
.selcmd
();
5997 state
.roam
<- dosel conf
.paxcmd
;
6009 let birdseyemouse button down
x y mask
6010 (conf
, leftx
, _, hooverpageno
, anchor) =
6013 let rec loop = function
6016 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6017 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6019 leavebirdseye (conf
, leftx
, l.pageno, hooverpageno
, anchor) false;
6025 | _ -> viewmouse button down
x y mask
6031 method key key mask
=
6032 begin match state
.mode with
6033 | Textentry
textentry -> textentrykeyboard key mask
textentry
6034 | Birdseye
birdseye -> birdseyekeyboard key mask
birdseye
6035 | View
-> viewkeyboard key mask
6036 | LinkNav
linknav -> linknavkeyboard key mask
linknav
6040 method button button bstate
x y mask
=
6041 begin match state
.mode with
6043 | View
-> viewmouse button bstate
x y mask
6044 | Birdseye beye
-> birdseyemouse button bstate
x y mask beye
6049 method multiclick clicks
x y mask
=
6050 begin match state
.mode with
6052 | View
-> viewmulticlick clicks
x y mask
6059 begin match state
.mode with
6061 | View
| Birdseye
_ | LinkNav
_ ->
6062 match state
.mstate
with
6063 | Mzoom
_ | Mnone
-> ()
6068 state
.mstate
<- Mpan
(x, y);
6070 then state
.x <- panbound (state
.x + dx);
6072 gotoy_and_clear_text y
6075 state
.mstate
<- Msel
(a, (x, y));
6076 G.postRedisplay "motion select";
6079 let y = min state
.winh
(max
0 y) in
6083 let x = min state
.winw (max
0 x) in
6086 | Mzoomrect
(p0
, _) ->
6087 state
.mstate
<- Mzoomrect
(p0
, (x, y));
6088 G.postRedisplay "motion zoomrect";
6092 method pmotion
x y =
6093 begin match state
.mode with
6094 | Birdseye
(conf
, leftx
, pageno, hooverpageno
, anchor) ->
6095 let rec loop = function
6097 if hooverpageno
!= -1
6099 state
.mode <- Birdseye
(conf
, leftx
, pageno, -1, anchor);
6100 G.postRedisplay "pmotion birdseye no hoover";
6103 if y > l.pagedispy && y < l.pagedispy + l.pagevh
6104 && x > l.pagedispx && x < l.pagedispx + l.pagevw
6106 state
.mode <- Birdseye
(conf
, leftx
, pageno, l.pageno, anchor);
6107 G.postRedisplay "pmotion birdseye hoover";
6117 match state
.mstate
with
6118 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ -> ()
6126 let past, _, _ = !r
in
6128 let delta = now -. past in
6131 else r
:= (now, x, y)
6135 method infochanged
_ = ()
6138 let maxy = state
.maxy - (if conf
.maxhfit
then state
.winh
else 0) in
6141 then 0.0, float state
.winh
6142 else scrollph state
.y maxy
6147 let winw = wadjsb () + state
.winw in
6148 let fwinw = float winw in
6150 let sw = fwinw /. float state
.w in
6151 let sw = fwinw *. sw in
6152 max
sw (float conf
.scrollh
)
6155 let maxx = state
.w + winw in
6156 let x = winw - state
.x in
6157 let percent = float x /. float maxx in
6158 (fwinw -. sw) *. percent
6160 hscrollh (), position, sw
6164 match state
.mode with
6165 | LinkNav
_ -> "links"
6166 | Textentry
_ -> "textentry"
6167 | Birdseye
_ -> "birdseye"
6170 findkeyhash conf
modename
6172 method eformsgs
= true
6173 method alwaysscrolly
= false
6176 let adderrmsg src msg
=
6177 Buffer.add_string state
.errmsgs msg
;
6178 state
.newerrmsgs
<- true;
6182 let adderrfmt src fmt
=
6183 Format.ksprintf
(fun s -> adderrmsg src s) fmt
;
6187 let cl = splitatspace cmds
in
6189 try Scanf.sscanf
s fmt
f
6191 adderrfmt "remote exec"
6192 "error processing '%S': %s\n" cmds
(exntos exn
)
6195 | "reload" :: [] -> reload ()
6196 | "goto" :: args
:: [] ->
6197 scan args
"%u %f %f"
6199 let cmd, _ = state
.geomcmds
in
6201 then gotopagexy pageno x y
6204 gotopagexy pageno x y;
6207 state
.reprf
<- f state
.reprf
6209 | "goto1" :: args
:: [] -> scan args
"%u %f" gotopage
6210 | "gotor" :: args
:: [] ->
6212 (fun filename
pageno -> gotounder (Uremote
(filename
, pageno)))
6213 | "gotord" :: args
:: [] ->
6215 (fun filename
dest -> gotounder (Uremotedest
(filename
, dest)))
6216 | "rect" :: args
:: [] ->
6217 scan args
"%u %u %f %f %f %f"
6218 (fun pageno color x0 y0 x1 y1 ->
6219 onpagerect pageno (fun w h ->
6220 let _,w1,h1
,_ = getpagedim
pageno in
6221 let sw = float w1 /. float w
6222 and sh = float h1
/. float h in
6226 and y1s
= y1 *. sh in
6227 let rect = (x0s,y0s
,x1s
,y0s
,x1s
,y1s
,x0s,y1s
) in
6229 state
.rects <- (pageno, color, rect) :: state
.rects;
6230 G.postRedisplay "rect";
6233 | "activatewin" :: [] -> Wsi.activatewin
()
6234 | "quit" :: [] -> raise Quit
6236 adderrfmt "remote command"
6237 "error processing remote command: %S\n" cmds
;
6241 let scratch = Bytes.create
80 in
6242 let buf = Buffer.create
80 in
6244 match tempfailureretry
(Unix.read fd
scratch 0) 80 with
6245 | exception Unix.Unix_error
(Unix.EAGAIN
, _, _) -> None
6248 if Buffer.length
buf > 0
6250 let s = Buffer.contents
buf in
6258 match Bytes.index_from
scratch ppos '
\n'
with
6259 | pos -> if pos >= n then -1 else pos
6260 | exception Not_found
-> -1
6264 Buffer.add_subbytes
buf scratch ppos
(nlpos-ppos
);
6265 let s = Buffer.contents
buf in
6271 Buffer.add_subbytes
buf scratch ppos
(n-ppos
);
6277 let remoteopen path =
6278 try Some
(Unix.openfile
path [Unix.O_NONBLOCK
; Unix.O_RDONLY
] 0o0)
6280 adderrfmt "remoteopen" "error opening %S: %s" path (exntos exn
);
6285 let gcconfig = ref E.s in
6286 let trimcachepath = ref E.s in
6287 let rcmdpath = ref E.s in
6288 let pageno = ref None
in
6289 let rootwid = ref 0 in
6290 let openlast = ref false in
6291 let nofc = ref false in
6292 let doreap = ref false in
6293 selfexec := Sys.executable_name
;
6296 [("-p", Arg.String
(fun s -> state
.password <- s),
6297 "<password> Set password");
6301 Config.fontpath
:= s;
6302 selfexec := !selfexec ^
" -f " ^
Filename.quote
s;
6304 "<path> Set path to the user interface font");
6308 selfexec := !selfexec ^
" -c " ^
Filename.quote
s;
6309 Config.confpath
:= s),
6310 "<path> Set path to the configuration file");
6312 ("-last", Arg.Set
openlast, " Open last document");
6314 ("-page", Arg.Int
(fun pageno1
-> pageno := Some
(pageno1
-1)),
6315 "<page-number> Jump to page");
6317 ("-tcf", Arg.String
(fun s -> trimcachepath := s),
6318 "<path> Set path to the trim cache file");
6320 ("-dest", Arg.String
(fun s -> state
.nameddest
<- s),
6321 "<named-destination> Set named destination");
6323 ("-wtmode", Arg.Set
wtmode, " Operate in wt mode");
6324 ("-cxack", Arg.Set
cxack, " Cut corners");
6326 ("-remote", Arg.String
(fun s -> rcmdpath := s),
6327 "<path> Set path to the remote commands source");
6329 ("-origin", Arg.String
(fun s -> state
.origin
<- s),
6330 "<original-path> Set original path");
6332 ("-gc", Arg.Set_string
gcconfig,
6333 "<script-path> Collect garbage with the help of a script");
6335 ("-nofc", Arg.Set
nofc, " Do not use fontconfig");
6337 ("-v", Arg.Unit
(fun () ->
6339 "%s\nconfiguration path: %s\n"
6343 exit
0), " Print version and exit");
6345 ("-embed", Arg.Set_int
rootwid,
6346 "<window-id> Embed into window")
6349 (fun s -> state
.path <- s)
6350 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
6353 then selfexec := !selfexec ^
" -wtmode";
6355 let histmode = emptystr state
.path && not
!openlast in
6357 if not
(Config.load !openlast)
6358 then dolog
"Failed to load configuration";
6359 begin match !pageno with
6360 | Some
pageno -> state
.anchor <- (pageno, 0.0, 0.0)
6364 if nonemptystr
!gcconfig
6367 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6369 error
"gc socketpair failed: %s" (exntos exn
)
6372 match addpid
@@ popen
!gcconfig [(c, 0); (c, 1)] with
6374 error
"failed to popen gc script: %s" (exntos exn
);
6380 let wsfd, winw, winh
= Wsi.init
(object (self)
6381 val mutable m_clicks
= 0
6382 val mutable m_click_x
= 0
6383 val mutable m_click_y
= 0
6384 val mutable m_lastclicktime
= infinity
6386 method private cleanup =
6387 state
.roam
<- noroam
;
6388 Hashtbl.iter
(fun _ opaque -> clearmark
opaque) state
.pagemap
6389 method expose
= G.postRedisplay"expose"
6393 | Wsi.Unobscured
-> "unobscured"
6394 | Wsi.PartiallyObscured
-> "partiallyobscured"
6395 | Wsi.FullyObscured
-> "fullyobscured"
6397 vlog "visibility change %s" name
6398 method display = display ()
6399 method map mapped
= vlog "mappped %b" mapped
6400 method reshape w h =
6403 method mouse
b d x y m =
6404 if d && canselect ()
6406 (* http://blogs.msdn.com/b/oldnewthing/archive/2004/10/18/243925.aspx *)
6412 if abs
x - m_click_x
> 10
6413 || abs
y - m_click_y
> 10
6414 || abs_float
(t -. m_lastclicktime
) > 0.3
6416 m_clicks
<- m_clicks
+ 1;
6417 m_lastclicktime
<- t;
6421 G.postRedisplay "cleanup";
6422 state
.uioh <- state
.uioh#button
b d x y m;
6424 else state
.uioh <- state
.uioh#multiclick m_clicks
x y m
6429 m_lastclicktime
<- infinity
;
6430 state
.uioh <- state
.uioh#button
b d x y m
6434 state
.uioh <- state
.uioh#button
b d x y m
6437 state
.mpos
<- (x, y);
6438 state
.uioh <- state
.uioh#motion
x y
6439 method pmotion
x y =
6440 state
.mpos
<- (x, y);
6441 state
.uioh <- state
.uioh#pmotion
x y
6443 let mascm = m land (
6444 Wsi.altmask
+ Wsi.shiftmask
+ Wsi.ctrlmask
+ Wsi.metamask
6447 let x = state
.x and y = state
.y in
6449 if x != state
.x || y != state
.y then self#
cleanup
6451 match state
.keystate
with
6453 let km = k
, mascm in
6456 let modehash = state
.uioh#
modehash in
6457 try Hashtbl.find modehash km
6459 try Hashtbl.find (findkeyhash conf
"global") km
6460 with Not_found
-> KMinsrt
(k
, m)
6462 | KMinsrt
(k
, m) -> keyboard k
m
6463 | KMinsrl
l -> List.iter
(fun (k
, m) -> keyboard k
m) l
6464 | KMmulti
(l, r
) -> state
.keystate
<- KSinto
(l, r
)
6466 | KSinto
((k'
, m'
) :: [], insrt
) when k'
=k
&& m'
land mascm = m'
->
6467 List.iter
(fun (k
, m) -> keyboard k
m) insrt
;
6468 state
.keystate
<- KSnone
6469 | KSinto
((k'
, m'
) :: keys, insrt
) when k'
=k
&& m'
land mascm = m'
->
6470 state
.keystate
<- KSinto
(keys, insrt
)
6471 | KSinto
_ -> state
.keystate
<- KSnone
6474 state
.mpos
<- (x, y);
6475 state
.uioh <- state
.uioh#pmotion
x y
6476 method leave = state
.mpos
<- (-1, -1)
6477 method winstate wsl
= state
.winstate
<- wsl
6478 method quit
= raise Quit
6479 end) !rootwid conf
.cwinw conf
.cwinh platform
in
6484 List.exists
GlMisc.check_extension
6485 [ "GL_ARB_texture_rectangle"
6486 ; "GL_EXT_texture_recangle"
6487 ; "GL_NV_texture_rectangle" ]
6489 then (dolog
"OpenGL does not suppport rectangular textures"; exit
1);
6492 let r = GlMisc.get_string `renderer
in
6493 let p = "Mesa DRI Intel(" in
6494 let l = String.length
p in
6495 String.length
r > l && String.sub
r 0 l = p
6498 defconf
.sliceheight
<- 1024;
6499 defconf
.texcount
<- 32;
6500 defconf
.usepbo
<- true;
6504 match Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0 with
6506 dolog
"socketpair failed: %s" (exntos exn
);
6514 setcheckers conf
.checkers
;
6517 conf
.angle
, conf
.fitmodel
, (conf
.trimmargins
, conf
.trimfuzz
),
6518 conf
.texcount
, conf
.sliceheight
, conf
.mustoresize
, conf
.colorspace
,
6519 !Config.fontpath
, !trimcachepath,
6520 GlMisc.check_extension
"GL_ARB_pixel_buffer_object",
6523 List.iter
GlArray.enable
[`texture_coord
; `vertex
];
6525 reshape ~firsttime
:true winw winh
;
6529 Wsi.settitle
"llpp (history)";
6533 state
.text <- "Opening " ^
(mbtoutf8 state
.path);
6534 opendoc state
.path state
.password;
6538 Wsi.setcursor
Wsi.CURSOR_INHERIT
;
6539 Sys.set_signal
Sys.sighup
(Sys.Signal_handle
(fun _ -> reload ()));
6542 match Unix.waitpid
[Unix.WNOHANG
] ~
-1 with
6543 | (exception (Unix.Unix_error
(Unix.ECHILD
, _, _))) -> ()
6544 | (exception exn
) -> dolog
"Unix.waitpid: %s" @@ exntos exn
6546 | _pid
, _status
-> reap ()
6548 Sys.set_signal
Sys.sigchld
(Sys.Signal_handle
(fun _ -> doreap := true));
6552 if nonemptystr
!rcmdpath
6553 then remoteopen !rcmdpath
6558 let rec loop deadline
=
6564 let r = [state
.ss; state
.wsfd] in
6568 | Some fd
-> fd
:: r
6572 state
.redisplay
<- false;
6579 if deadline
= infinity
6581 else max
0.0 (deadline
-. now)
6586 try Unix.select
r [] [] timeout
6587 with Unix.Unix_error
(Unix.EINTR
, _, _) -> [], [], []
6593 if state
.ghyll
== noghyll
6595 match state
.autoscroll
with
6596 | Some step
when step
!= 0 ->
6597 let y = state
.y + step
in
6601 else if y >= state
.maxy then 0 else y
6604 if state
.mode = View
6605 then state
.text <- E.s;
6608 else deadline
+. 0.01
6613 let rec checkfds = function
6615 | fd
:: rest
when fd
= state
.ss ->
6616 let cmd = readcmd state
.ss in
6620 | fd
:: rest
when fd
= state
.wsfd ->
6624 | fd
:: rest
when Some fd
= !optrfd ->
6625 begin match remote fd
with
6626 | None
-> optrfd := remoteopen !rcmdpath;
6627 | opt -> optrfd := opt
6632 dolog
"select returned unknown descriptor";
6638 if deadline
= infinity
6642 match state
.autoscroll
with
6643 | Some step
when step
!= 0 -> deadline1
6644 | _ -> if state
.ghyll
== noghyll
then infinity
else deadline1
6652 Config.save leavebirdseye;
6653 if hasunsavedchanges
()