4 | Ulinkgoto
of (int * int)
6 and facename
= string;;
8 let dolog fmt
= Printf.kprintf prerr_endline fmt
;;
9 let now = Unix.gettimeofday
;;
13 type params
= (angle
* proportional
* trimparams
14 * texcount
* sliceheight
* memsize
15 * colorspace
* wmclasshack
* fontpath
)
24 and proportional
= bool
25 and trimmargins
= bool
26 and interpagespace
= int
34 and wmclasshack
= bool
35 and irect
= (int * int * int * int)
36 and trimparams
= (trimmargins
* irect
)
37 and colorspace
= | Rgb
| Bgr
| Gray
40 type platform
= | Punknown
| Plinux
| Pwindows
| Posx
| Psun
41 | Pfreebsd
| Pdragonflybsd
| Popenbsd
| Pmingw
| Pcygwin
;;
43 external init
: Unix.file_descr
-> params
-> unit = "ml_init";;
44 external seltext
: string -> (int * int * int * int) -> unit = "ml_seltext";;
45 external copysel
: string -> unit = "ml_copysel";;
46 external getpdimrect
: int -> float array
= "ml_getpdimrect";;
47 external whatsunder
: string -> int -> int -> under
= "ml_whatsunder";;
48 external zoomforh
: int -> int -> int -> float = "ml_zoom_for_height";;
49 external drawstr
: int -> int -> int -> string -> float = "ml_draw_string";;
50 external measurestr
: int -> string -> float = "ml_measure_string";;
51 external getmaxw
: unit -> float = "ml_getmaxw";;
52 external postprocess
: opaque
-> bool -> int -> int -> unit = "ml_postprocess";;
53 external pagebbox
: opaque
-> (int * int * int * int) = "ml_getpagebox";;
54 external platform
: unit -> platform
= "ml_platform";;
55 external setaalevel
: int -> unit = "ml_setaalevel";;
57 let platform_to_string = function
58 | Punknown
-> "unknown"
60 | Pwindows
-> "Windows"
63 | Pfreebsd
-> "FreeBSD"
64 | Pdragonflybsd
-> "DragonflyBSD"
65 | Popenbsd
-> "OpenBSD"
70 let platform = platform ();;
74 | Pwindows
| Pmingw
-> true
82 and tileparams
= (x
* y
* width
* height
* tilex
* tiley
)
85 external drawtile
: tileparams
-> string -> unit = "ml_drawtile";;
89 | Msel
of (mpos
* mpos
)
92 | Mzoom
of (int * int)
93 | Mzoomrect
of (mpos
* mpos
)
97 type textentry
= string * string * onhist
option * onkey
* ondone
98 and onkey
= string -> int -> te
99 and ondone
= string -> unit
100 and histcancel
= unit -> unit
101 and onhist
= ((histcmd
-> string) * histcancel
)
102 and histcmd
= HCnext
| HCprev
| HCfirst
| HClast
107 | TEswitch
of textentry
118 let bound v minv maxv
=
119 max minv
(min maxv v
);
123 { store
= Array.create n v
130 let drawstring size x y s
=
132 Gl.enable `texture_2d
;
133 ignore
(drawstr size x y s
);
135 Gl.disable `texture_2d
;
138 let drawstring1 size x y s
=
142 let drawstring2 size x y fmt
=
143 Printf.kprintf
(drawstring size
(x
+1) (y
+size
+1)) fmt
146 let cbcap b
= Array.length b
.store
;;
151 b
.wc
<- (b
.wc
+ 1) mod cap;
153 b
.len
<- min
(b
.len
+ 1) cap;
156 let cbempty b
= b
.len
= 0;;
158 let cbgetg b circular dir
=
162 let rc = b
.rc + dir
in
174 else max
0 (min
rc (b
.len
-1))
180 let cbget b
= cbgetg b
false;;
181 let cbgetc b
= cbgetg b
true;;
198 dolog "l %d dim=%d {" l
.pageno l
.pagedimno
;
199 dolog " WxH %dx%d" l
.pagew l
.pageh
;
200 dolog " vWxH %dx%d" l
.pagevw l
.pagevh
;
201 dolog " pagex,y %d,%d" l
.pagex l
.pagey
;
202 dolog " dispx,y %d,%d" l
.pagedispx l
.pagedispy
;
206 let debugrect (x0
, y0
, x1
, y1
, x2
, y2
, x3
, y3
) =
208 dolog " x0,y0=(% f, % f)" x0 y0
;
209 dolog " x1,y1=(% f, % f)" x1 y1
;
210 dolog " x2,y2=(% f, % f)" x2 y2
;
211 dolog " x3,y3=(% f, % f)" x3 y3
;
216 { mutable scrollbw
: int
217 ; mutable scrollh
: int
218 ; mutable icase
: bool
219 ; mutable preload
: bool
220 ; mutable pagebias
: int
221 ; mutable verbose
: bool
222 ; mutable debug
: bool
223 ; mutable scrollstep
: int
224 ; mutable maxhfit
: bool
225 ; mutable crophack
: bool
226 ; mutable autoscrollstep
: int
227 ; mutable maxwait
: float option
228 ; mutable hlinks
: bool
229 ; mutable underinfo
: bool
230 ; mutable interpagespace
: interpagespace
231 ; mutable zoom
: float
232 ; mutable presentation
: bool
233 ; mutable angle
: angle
236 ; mutable savebmarks
: bool
237 ; mutable proportional
: proportional
238 ; mutable trimmargins
: trimmargins
239 ; mutable trimfuzz
: irect
240 ; mutable memlimit
: memsize
241 ; mutable texcount
: texcount
242 ; mutable sliceheight
: sliceheight
243 ; mutable thumbw
: width
244 ; mutable jumpback
: bool
245 ; mutable bgcolor
: float * float * float
246 ; mutable bedefault
: bool
247 ; mutable scrollbarinpm
: bool
248 ; mutable tilew
: int
249 ; mutable tileh
: int
250 ; mutable mumemlimit
: memsize
251 ; mutable checkers
: bool
252 ; mutable aalevel
: int
253 ; mutable urilauncher
: string
254 ; mutable colorspace
: colorspace
255 ; mutable invert
: bool
259 type anchor
= pageno
* top
;;
261 type outline
= string * int * anchor
;;
263 type rect
= float * float * float * float * float * float * float * float;;
265 type tile
= opaque
* pixmapsize
* elapsed
266 and elapsed
= float;;
267 type pagemapkey
= pageno
* gen
;;
268 type tilemapkey
= pageno
* gen
* colorspace
* angle
* width
* height
* col
* row
272 let emptyanchor = (0, 0.0);;
274 type infochange
= | Memused
| Docinfo
| Pdim
;;
276 class type uioh
= object
277 method display
: unit
278 method key
: int -> uioh
279 method special
: Glut.special_key_t
-> uioh
281 Glut.button_t
-> Glut.mouse_button_state_t
-> int -> int -> uioh
282 method motion
: int -> int -> uioh
283 method pmotion
: int -> int -> uioh
284 method infochanged
: infochange
-> unit
288 | Birdseye
of (conf
* leftx
* pageno
* pageno
* anchor
)
289 | Textentry
of (textentry
* onleave
)
291 and onleave
= leavetextentrystatus
-> unit
292 and leavetextentrystatus
= | Cancel
| Confirm
293 and helpitem
= string * int * action
296 | Action
of (uioh
-> uioh
)
299 let isbirdseye = function Birdseye _
-> true | _
-> false;;
300 let istextentry = function Textentry _
-> true | _
-> false;;
304 | Loading
of (page
* gen
)
306 page
* opaque
* colorspace
* angle
* gen
* col
* row
* width
* height
308 | Outlining
of outline list
311 let nouioh : uioh
= object (self
)
314 method special _
= self
315 method button _ _ _ _
= self
316 method motion _ _
= self
317 method pmotion _ _
= self
318 method infochanged _
= ()
322 { mutable csock
: Unix.file_descr
323 ; mutable ssock
: Unix.file_descr
327 ; mutable scrollw
: int
328 ; mutable hscrollh
: int
329 ; mutable anchor
: anchor
331 ; mutable layout
: page list
332 ; pagemap
: (pagemapkey
, opaque
) Hashtbl.t
333 ; tilemap
: (tilemapkey
, tile
) Hashtbl.t
334 ; tilelru
: (tilemapkey
* opaque
* pixmapsize
) Queue.t
335 ; mutable pdims
: (pageno
* width
* height
* leftx
) list
336 ; mutable pagecount
: int
337 ; mutable currently
: currently
338 ; mutable mstate
: mstate
339 ; mutable searchpattern
: string
340 ; mutable rects
: (pageno
* recttype
* rect
) list
341 ; mutable rects1
: (pageno
* recttype
* rect
) list
342 ; mutable text
: string
343 ; mutable fullscreen
: (width
* height
) option
344 ; mutable mode
: mode
345 ; mutable uioh
: uioh
346 ; mutable outlines
: outline array
347 ; mutable bookmarks
: outline list
348 ; mutable path
: string
349 ; mutable password
: string
350 ; mutable invalidated
: int
351 ; mutable colorscale
: float
352 ; mutable memused
: memsize
354 ; mutable throttle
: (page list
* int * float) option
355 ; mutable autoscroll
: int option
356 ; mutable help
: helpitem array
357 ; mutable docinfo
: (int * string) list
358 ; mutable deadline
: float
359 ; mutable texid
: GlTex.texture_id
option
361 ; mutable prevzoom
: float
362 ; mutable progress
: float
365 { pat
: string circbuf
366 ; pag
: string circbuf
367 ; nav
: anchor circbuf
388 ; presentation
= false
393 ; proportional
= true
394 ; trimmargins
= false
395 ; trimfuzz
= (0,0,0,0)
396 ; memlimit
= 32 lsl 20
401 ; bgcolor
= (0.5, 0.5, 0.5)
403 ; scrollbarinpm
= true
406 ; mumemlimit
= 128 lsl 20
411 | Plinux
| Pfreebsd
| Pdragonflybsd
| Popenbsd
| Psun
-> "xdg-open \"%s\""
412 | Posx
-> "open \"%s\""
413 | Pwindows
| Pcygwin
| Pmingw
-> "iexplore \"%s\""
420 let conf = { defconf with angle
= defconf.angle
};;
422 let uifontsize = ref 14;;
423 let wwidth = ref nan
;;
426 if String.length
conf.urilauncher
= 0
427 then print_endline uri
429 let re = Str.regexp
"%s" in
430 let command = Str.global_replace
re uri
conf.urilauncher
in
432 try Some
(Unix.open_process_in
command)
435 "failed to execute `%s': %s\n" command (Printexc.to_string exn
);
440 | Some ic
-> close_in ic
445 let strings = ("llpp version " ^
Help.version
) :: "" :: Help.keys
in
447 let r = Str.regexp
"\\(http://[^ ]+\\)" in
449 if (try Str.search_forward
r s
0 with Not_found
-> -1) >= 0
451 let uri = Str.matched_string s
in
452 (s
, 0, Action
(fun u
-> gotouri uri; u
))
453 else s
, 0, Noaction
) strings
465 ; anchor
= emptyanchor
468 ; tilelru
= Queue.create
()
469 ; pagemap
= Hashtbl.create
10
470 ; tilemap
= Hashtbl.create
10
487 { nav
= cbnew 10 (0, 0.0)
509 Printf.kprintf prerr_endline fmt
511 Printf.kprintf ignore fmt
516 let postRedisplay who
=
518 then prerr_endline
("redisplay for " ^ who
);
519 Glut.postRedisplay ();
524 let b = Buffer.create
(String.length s
+ 1) in
525 Buffer.add_string
b s
;
530 let colorspace_of_string s
=
531 match String.lowercase s
with
535 | _
-> failwith
"invalid colorspace"
538 let int_of_colorspace = function
544 let colorspace_of_int = function
548 | n
-> failwith
("invalid colorspace index " ^ string_of_int n
)
551 let colorspace_to_string = function
557 let intentry_with_suffix text key
=
558 let c = Char.unsafe_chr key
in
559 match Char.lowercase
c with
561 let text = addchar text c in
565 let text = addchar text c in
569 state.text <- Printf.sprintf
"invalid char (%d, `%c')" key
c;
574 let len = String.length s
in
576 let b = Buffer.create
n in
577 Buffer.add_char
b (Char.chr
((len lsr 24) land 0xff));
578 Buffer.add_char
b (Char.chr
((len lsr 16) land 0xff));
579 Buffer.add_char
b (Char.chr
((len lsr 8) land 0xff));
580 Buffer.add_char
b (Char.chr
((len lsr 0) land 0xff));
581 Buffer.add_string
b s
;
582 let s'
= Buffer.contents
b in
583 let n'
= Unix.write fd
s'
0 n in
584 if n'
!= n then failwith
"write failed";
589 let n = Unix.read fd
s 0 4 in
590 if n != 4 then failwith
"incomplete read(len)";
592 lor (Char.code
s.[0] lsl 24)
593 lor (Char.code
s.[1] lsl 16)
594 lor (Char.code
s.[2] lsl 8)
595 lor (Char.code
s.[3] lsl 0)
597 let s = String.create
len in
598 let n = Unix.read fd
s 0 len in
599 if n != len then failwith
"incomplete read(data)";
604 let b = Buffer.create
10 in
605 Buffer.add_string
b s;
606 let rec combine = function
609 Buffer.add_char
b ' '
;
612 | `
b b -> if b then "1" else "0"
614 | `i i
-> string_of_int i
615 | `f f
-> string_of_float f
616 | `I f
-> string_of_int
(truncate f
)
618 Buffer.add_string
b s;
625 let cmd = Buffer.contents
(makecmd s l
) in
626 writecmd state.csock
cmd;
632 let d = conf.winh
- h
in
639 let rec f pn ph pi fh l
=
641 | (n, _
, h
, _
) :: rest
->
642 let ips = calcips h
in
647 if isbirdseye state.mode
&& pn
= 0
652 let fh = fh + ((n - pn
) * (ph
+ pi
)) in
657 if conf.presentation
|| (isbirdseye state.mode
&& pn
= 0)
661 let fh = fh + ((state.pagecount
- pn
) * (ph
+ pi
)) + inc in
664 let fh = f 0 0 0 0 state.pdims
in
668 let getpageyh pageno
=
669 let rec f pn ph pi y l
=
671 | (n, _
, h
, _
) :: rest
->
672 let ips = calcips h
in
675 let h = if n = pageno
then h else ph
in
676 if conf.presentation
&& n = pageno
678 y
+ (pageno
- pn
) * (ph
+ pi
) + pi
, h
680 y
+ (pageno
- pn
) * (ph
+ pi
), h
682 let y = y + (if conf.presentation
then pi
else 0) in
683 let y = y + (n - pn
) * (ph
+ pi
) in
687 y + (pageno
- pn
) * (ph
+ pi
), ph
689 f 0 0 0 0 state.pdims
692 let getpagedim pageno
=
695 | (n, _
, _
, _
) as pdim
:: rest
->
697 then (if n = pageno
then pdim
else ppdim
)
702 f (-1, -1, -1, -1) state.pdims
705 let getpageh pageno
=
706 let _, _, h, _ = getpagedim pageno
in
710 let getpagew pageno
=
711 let _, w
, _, _ = getpagedim pageno
in
715 let getpagey pageno
= fst
(getpageyh pageno
);;
718 let sh = sh - state.hscrollh
in
719 let rec f ~pageno ~pdimno ~prev ~py ~dy ~pdims ~accu
=
720 let ((w
, h, ips, xoff
) as curr
), rest
, pdimno
, yinc
=
722 | (pageno'
, w
, h, xoff
) :: rest
when pageno'
= pageno
->
723 let ips = calcips h in
725 if conf.presentation
|| (isbirdseye state.mode
&& pageno
= 0)
729 (w
, h, ips, xoff
), rest
, pdimno
+ 1, yinc
731 prev
, pdims
, pdimno
, 0
733 let dy = dy + yinc in
734 let py = py + yinc in
735 if pageno
= state.pagecount
|| dy >= sh
740 if py + h <= vy - yinc
742 let py = py + h + ips in
743 let dy = max
0 (py - y) in
752 let pagey = vy - py in
753 let pagevh = h - pagey in
754 let pagevh = min
(sh - dy) pagevh in
755 let off = if yinc > 0 then py - vy else 0 in
756 let py = py + h + ips in
759 if state.w
< conf.winw
- state.scrollw
760 then (conf.winw
- state.scrollw
- state.w
) / 2
763 let dispx = xoff + state.x
in
769 let lw = w
- pagex in
770 min
lw (conf.winw
- state.scrollw
)
778 ; pagey = pagey + off
780 ; pagevh = pagevh - off
782 ; pagedispy
= dy + off
785 let accu = e :: accu in
794 if state.invalidated
= 0
813 let y = state.y + incr
in
815 let y = min
y (state.maxy
- (if conf.maxhfit
then conf.winh
else 0)) in
819 let getopaque pageno
=
820 try Some
(Hashtbl.find
state.pagemap
(pageno
, state.gen
))
821 with Not_found
-> None
824 let putopaque pageno opaque
=
825 Hashtbl.replace
state.pagemap
(pageno
, state.gen
) opaque
829 let tilex = l
.pagex mod conf.tilew
in
830 let tiley = l
.pagey mod conf.tileh
in
832 let col = l
.pagex / conf.tilew
in
833 let row = l
.pagey / conf.tileh
in
836 let a = l
.pagew
- l
.pagex in
837 let b = conf.winw
- state.scrollw
in
841 let rec rowloop row y0 dispy
h =
845 let dh = conf.tileh
- y0
in
847 let rec colloop col x0
dispx w
=
851 let dw = conf.tilew
- x0
in
854 f col row dispx dispy x0 y0
dw dh;
855 colloop (col+1) 0 (dispx+dw) (w
-dw)
858 colloop col tilex l
.pagedispx
vw;
859 rowloop (row+1) 0 (dispy
+dh) (h-dh)
863 then rowloop row tiley l
.pagedispy vh
;
866 let gettileopaque l
col row =
868 l
.pageno
, state.gen
, conf.colorspace
, conf.angle
, l
.pagew
, l
.pageh
, col, row
870 try Some
(Hashtbl.find
state.tilemap
key)
871 with Not_found
-> None
874 let puttileopaque l
col row gen colorspace angle opaque size elapsed
=
875 let key = l
.pageno
, gen
, colorspace
, angle
, l
.pagew
, l
.pageh
, col, row in
876 Hashtbl.add
state.tilemap
key (opaque
, size
, elapsed
)
879 let drawtiles l color
=
881 let f col row x
y tilex tiley w
h =
882 match gettileopaque l
col row with
883 | Some
(opaque
, _, t
) ->
884 let params = x
, y, w
, h, tilex, tiley in
888 GlFunc.blend_func `zero `one_minus_src_color
;
890 drawtile
params opaque
;
892 then Gl.disable `blend
;
895 let s = Printf.sprintf
900 GlMisc.push_attrib
[`current
];
901 GlDraw.color
(0.0, 0.0, 0.0);
903 (float (x
-2), float (y-2))
904 (float (x
+2) +. ww, float (y + !uifontsize + 2));
905 GlDraw.color
(1.0, 1.0, 1.0);
906 drawstring !uifontsize x
(y + !uifontsize - 1) s;
907 GlMisc.pop_attrib
();
912 let lw = conf.winw
- state.scrollw
- x
in
915 let lh = conf.winh
- y in
918 Gl.enable `texture_2d
;
919 begin match state.texid
with
921 GlTex.bind_texture `texture_2d id
;
925 and y1
= float (y+h) in
927 let tw = float w /. 64.0
928 and th
= float h /. 64.0 in
929 let tx0 = float tilex /. 64.0
930 and ty0
= float tiley /. 64.0 in
932 and ty1
= ty0
+. th
in
933 GlDraw.begins `quads
;
934 GlTex.coord2
(tx0, ty0
); GlDraw.vertex2
(x0, y0
);
935 GlTex.coord2
(tx0, ty1
); GlDraw.vertex2
(x0, y1
);
936 GlTex.coord2
(tx1, ty1
); GlDraw.vertex2
(x1
, y1
);
937 GlTex.coord2
(tx1, ty0
); GlDraw.vertex2
(x1
, y0
);
940 Gl.disable `texture_2d
;
942 GlDraw.color
(1.0, 1.0, 1.0);
945 (float (x
+w), float (y+h));
947 if w > 128 && h > !uifontsize + 10
949 GlDraw.color
(0.0, 0.0, 0.0);
952 then (col*conf.tilew
, row*conf.tileh
)
955 drawstring2 !uifontsize x
y "Loading %d [%d,%d]" l
.pageno
c r;
962 let pagevisible layout n = List.exists
(fun l
-> l
.pageno
= n) layout;;
964 let tilevisible1 l x
y =
966 and ax1
= l
.pagex + l
.pagevw
968 and ay1
= l
.pagey + l
.pagevh in
972 let bx1 = min
(bx0 + conf.tilew
) l
.pagew
973 and by1
= min
(by0
+ conf.tileh
) l
.pageh
in
975 let rx0 = max
ax0 bx0
976 and ry0
= max ay0 by0
977 and rx1
= min ax1
bx1
978 and ry1
= min ay1 by1
in
980 let nonemptyintersection = rx1
> rx0 && ry1
> ry0
in
984 let tilevisible layout n x
y =
985 let rec findpageinlayout = function
986 | l
:: _ when l
.pageno
= n -> tilevisible1 l x
y
987 | _ :: rest
-> findpageinlayout rest
990 findpageinlayout layout
993 let tileready l x
y =
994 tilevisible1 l x
y &&
995 gettileopaque l
(x
/conf.tilew
) (y/conf.tileh
) != None
998 let tilepage n p
layout =
999 let rec loop = function
1003 let f col row _ _ _ _ _ _ =
1004 if state.currently
= Idle
1006 match gettileopaque l
col row with
1009 let x = col*conf.tilew
1010 and y = row*conf.tileh
in
1012 let w = l
.pagew
- x in
1016 let h = l
.pageh
- y in
1028 l
, p
, conf.colorspace
, conf.angle
, state.gen
, col, row,
1029 conf.tilew
, conf.tileh
1038 if state.invalidated
= 0 then loop layout;
1041 let preloadlayout visiblepages
=
1042 let presentation = conf.presentation in
1043 let interpagespace = conf.interpagespace in
1044 let maxy = state.maxy in
1045 conf.presentation <- false;
1046 conf.interpagespace <- 0;
1047 state.maxy <- calcheight ();
1049 match visiblepages
with
1051 | l
:: _ -> getpagey l
.pageno
+ l
.pagey
1053 let y = if y < conf.winh
then 0 else y - conf.winh
in
1054 let h = state.y - y + conf.winh
*3 in
1055 let pages = layout y h in
1056 conf.presentation <- presentation;
1057 conf.interpagespace <- interpagespace;
1063 let rec loop pages =
1064 if state.currently
!= Idle
1069 begin match getopaque l
.pageno
with
1071 wcmd "page" [`i l
.pageno
; `i l
.pagedimno
];
1072 state.currently
<- Loading
(l
, state.gen
);
1074 tilepage l
.pageno opaque
pages;
1079 if state.invalidated
= 0 then loop pages
1084 if conf.preload && state.currently
= Idle
1085 then load (preloadlayout pages);
1088 let layoutready layout =
1089 let rec fold all ls
=
1090 all
&& match ls
with
1092 let seen = ref false in
1093 let allvisible = ref true in
1094 let foo col row _ _ _ _ _ _ =
1096 allvisible := !allvisible &&
1097 begin match gettileopaque l
col row with
1103 fold (!seen && !allvisible) rest
1106 let alltilesvisible = fold true layout in
1111 let y = bound y 0 state.maxy in
1112 let y, layout, proceed
=
1113 match conf.maxwait
with
1115 begin match state.throttle
with
1117 let layout = layout y conf.winh
in
1118 let ready = layoutready layout in
1122 state.throttle
<- Some
(layout, y, now ());
1124 else G.postRedisplay "gotoy showall (None)";
1126 | Some
(_, _, started
) ->
1127 let dt = now () -. started
in
1130 state.throttle
<- None
;
1131 let layout = layout y conf.winh
in
1133 G.postRedisplay "maxwait";
1140 let layout = layout y conf.winh
in
1141 if true || layoutready layout
1142 then G.postRedisplay "gotoy ready";
1148 state.layout <- layout;
1149 begin match state.mode
with
1150 | Birdseye
(conf, leftx
, pageno
, hooverpageno
, anchor
) ->
1151 if not
(pagevisible layout pageno
)
1153 match state.layout with
1156 state.mode
<- Birdseye
(
1157 conf, leftx
, l
.pageno
, hooverpageno
, anchor
1166 let conttiling pageno opaque
=
1167 tilepage pageno opaque
1168 (if conf.preload then preloadlayout state.layout else state.layout)
1171 let gotoy_and_clear_text y =
1173 if not
conf.verbose
then state.text <- "";
1177 match state.layout with
1179 | l
:: _ -> (l
.pageno
, float l
.pagey /. float l
.pageh
)
1182 let getanchory (n, top
) =
1183 let y, h = getpageyh n in
1184 y + (truncate
(top
*. float h));
1187 let gotoanchor anchor
=
1188 gotoy (getanchory anchor
);
1192 cbput state.hists
.nav
(getanchor ());
1196 let anchor = cbgetc state.hists
.nav dir
in
1200 let gotopage n top
=
1201 let y, h = getpageyh n in
1202 gotoy_and_clear_text (y + (truncate
(top
*. float h)));
1205 let gotopage1 n top
=
1206 let y = getpagey n in
1207 gotoy_and_clear_text (y + top
);
1215 state.invalidated
<- state.invalidated
+ 1;
1218 let writeopen path password
=
1219 writecmd state.csock
("open " ^ path ^
"\000" ^ password ^
"\000");
1222 let opendoc path password
=
1225 state.password
<- password
;
1226 state.gen
<- state.gen
+ 1;
1227 state.docinfo
<- [];
1229 setaalevel
conf.aalevel
;
1230 writeopen path password
;
1231 Glut.setWindowTitle
("llpp " ^
Filename.basename path
);
1232 wcmd "geometry" [`i
state.w; `i
conf.winh
];
1236 let c = c *. state.colorscale
in
1240 let scalecolor2 (r, g
, b) =
1241 (r *. state.colorscale
, g
*. state.colorscale
, b *. state.colorscale
);
1245 state.maxy <- calcheight ();
1247 if state.w <= conf.winw
- state.scrollw
1251 match state.mode
with
1252 | Birdseye
(_, _, pageno
, _, _) ->
1253 let y, h = getpageyh pageno
in
1254 let top = (conf.winh
- h) / 2 in
1255 gotoy (max
0 (y - top))
1256 | _ -> gotoanchor state.anchor
1260 let firsttime = ref true in
1262 GlDraw.viewport
0 0 w h;
1263 if state.invalidated
= 0 && not
!firsttime
1264 then state.anchor <- getanchor ();
1268 let w = truncate
(float w *. conf.zoom
) - state.scrollw
in
1272 GlMat.mode `modelview
;
1273 GlMat.load_identity
();
1275 GlMat.mode `projection
;
1276 GlMat.load_identity
();
1277 GlMat.rotate ~
x:1.0 ~angle
:180.0 ();
1278 GlMat.translate ~
x:~
-.1.0 ~
y:~
-.1.0 ();
1279 GlMat.scale3
(2.0 /. float conf.winw
, 2.0 /. float conf.winh
, 1.0);
1282 wcmd "geometry" [`i
w; `i
h];
1286 let len = String.length
state.text in
1289 match state.mode
with
1290 | View
-> state.hscrollh
1295 (x, float (conf.winh
- (!uifontsize + 4) - hscrollh))
1296 (x+.w, float (conf.winh
- hscrollh))
1299 let w = float (conf.winw
- state.scrollw
- 1) in
1300 if state.progress
>= 0.0 && state.progress
< 1.0
1302 GlDraw.color
(0.3, 0.3, 0.3);
1303 let w1 = w *. state.progress
in
1305 GlDraw.color
(0.0, 0.0, 0.0);
1309 GlDraw.color
(0.0, 0.0, 0.0);
1313 GlDraw.color
(1.0, 1.0, 1.0);
1314 drawstring !uifontsize
1315 (if len > 0 then 8 else 2) (conf.winh
- hscrollh - 5) s;
1317 match state.mode
with
1318 | Textentry
((prefix
, text, _, _, _), _) ->
1322 Printf.sprintf
"%s%s_ [%s]" prefix
text state.text
1324 Printf.sprintf
"%s%s_" prefix
text
1329 if len > 0 then drawstring state.text
1333 state.text <- Printf.sprintf
"%c%s" c s;
1334 G.postRedisplay "showtext";
1338 let len = Queue.length
state.tilelru
in
1340 if state.memused
<= conf.memlimit
1345 let (k
, p
, s) as lruitem
= Queue.pop
state.tilelru
in
1346 let n, gen
, colorspace
, angle
, pagew
, pageh
, col, row = k
in
1349 && colorspace
= conf.colorspace
1350 && angle
= conf.angle
1351 && pagew
= getpagew n
1352 && pageh
= getpageh n
1356 then preloadlayout state.layout
1359 let x = col*conf.tilew
1360 and y = row*conf.tileh
in
1361 tilevisible layout n x y
1363 then Queue.push lruitem
state.tilelru
1365 wcmd "freetile" [`
s p
];
1366 state.memused
<- state.memused
- s;
1367 state.uioh#infochanged Memused
;
1368 Hashtbl.remove
state.tilemap k
;
1377 Queue.iter
(fun (k
, p
, s) ->
1378 wcmd "freetile" [`
s p
];
1379 state.memused
<- state.memused
- s;
1380 state.uioh#infochanged Memused
;
1381 Hashtbl.remove
state.tilemap k
;
1383 Queue.clear
state.tilelru
;
1387 let logcurrently = function
1388 | Idle
-> dolog "Idle"
1389 | Loading
(l
, gen
) ->
1390 dolog "Loading %d gen=%d curgen=%d" l
.pageno gen
state.gen
1391 | Tiling
(l
, pageopaque
, colorspace
, angle
, gen
, col, row, tilew
, tileh
) ->
1393 "Tiling %d[%d,%d] page=%s cs=%s angle"
1394 l
.pageno
col row pageopaque
1395 (colorspace_to_string colorspace
)
1397 dolog "gen=(%d,%d) (%d,%d) tile=(%d,%d) (%d,%d)"
1398 angle gen
conf.angle
state.gen
1400 conf.tilew
conf.tileh
1407 (* dolog "%S" cmds; *)
1410 try String.index cmds ' '
1411 with Not_found
-> -1
1416 let l = String.length cmds
in
1417 let op = String.sub cmds
0 spacepos in
1419 if l - spacepos < 2 then ""
1420 else String.sub cmds
(spacepos+1) (l-spacepos-1)
1425 state.uioh#infochanged Pdim
;
1429 state.rects
<- state.rects1
;
1430 G.postRedisplay "clearrects";
1433 let n = Scanf.sscanf args
"%u" (fun n -> n) in
1434 state.pagecount
<- n;
1435 state.invalidated
<- state.invalidated
- 1;
1436 begin match state.currently
with
1438 state.currently
<- Idle
;
1439 state.outlines
<- Array.of_list
(List.rev
l)
1442 if state.invalidated
= 0
1444 if conf.maxwait
= None
1445 then G.postRedisplay "continue";
1448 Glut.setWindowTitle args
1455 then showtext ' ' args
1458 let progress, text = Scanf.sscanf args
"%f %n"
1460 f, String.sub args pos
(String.length args
- pos
)
1464 state.progress <- progress;
1465 G.postRedisplay "progress"
1468 let pageno, c, x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
=
1469 Scanf.sscanf args
"%u %d %f %f %f %f %f %f %f %f"
1470 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1471 (p
, c, x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
))
1473 let y = (getpagey pageno) + truncate y0
in
1476 state.rects1
<- [pageno, c, (x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
)]
1479 let pageno, c, x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
=
1480 Scanf.sscanf args
"%u %d %f %f %f %f %f %f %f %f"
1481 (fun p
c x0 y0 x1 y1 x2 y2 x3 y3
->
1482 (p
, c, x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
))
1485 (pageno, c, (x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
)) :: state.rects1
1488 let pageopaque, t
= Scanf.sscanf args
"%s %f" (fun p t
-> p
, t
) in
1489 begin match state.currently
with
1490 | Loading
(l, gen
) ->
1491 vlog "page %d took %f sec" l.pageno t
;
1492 Hashtbl.replace
state.pagemap
(l.pageno, gen
) pageopaque;
1493 begin match state.throttle
with
1495 let preloadedpages =
1497 then preloadlayout state.layout
1502 Set.Make
(struct type t
= int let compare = (-) end) in
1504 List.fold_left
(fun s l -> IntSet.add
l.pageno s)
1505 IntSet.empty
preloadedpages
1508 Hashtbl.fold (fun ((pageno, _) as key) opaque
accu ->
1509 if not
(IntSet.mem
pageno set)
1511 wcmd "freepage" [`
s opaque
];
1517 List.iter
(Hashtbl.remove
state.pagemap
) evictedpages;
1520 state.currently
<- Idle
;
1523 tilepage l.pageno pageopaque state.layout;
1525 load preloadedpages;
1526 if pagevisible state.layout l.pageno
1527 && layoutready state.layout
1528 then G.postRedisplay "page";
1531 | Some
(layout, _, _) ->
1532 state.currently
<- Idle
;
1533 tilepage l.pageno pageopaque layout;
1538 dolog "Inconsistent loading state";
1539 logcurrently state.currently
;
1544 let (x, y, opaque
, size
, t
) =
1545 Scanf.sscanf args
"%u %u %s %u %f"
1546 (fun x y p size t
-> (x, y, p
, size
, t
))
1548 begin match state.currently
with
1549 | Tiling
(l, pageopaque, cs
, angle
, gen
, col, row, tilew
, tileh
) ->
1550 vlog "tile %d [%d,%d] took %f sec" l.pageno col row t
;
1552 if tilew
!= conf.tilew
|| tileh
!= conf.tileh
1554 wcmd "freetile" [`
s opaque
];
1555 state.currently
<- Idle
;
1559 puttileopaque l col row gen cs angle opaque size t
;
1560 state.memused
<- state.memused
+ size
;
1561 state.uioh#infochanged Memused
;
1563 Queue.push
((l.pageno, gen
, cs
, angle
, l.pagew
, l.pageh
, col, row),
1564 opaque
, size
) state.tilelru
;
1566 state.currently
<- Idle
;
1568 && conf.colorspace
= cs
1569 && conf.angle
= angle
1570 && tilevisible state.layout l.pageno x y
1571 then conttiling l.pageno pageopaque;
1573 begin match state.throttle
with
1575 preload state.layout;
1577 && conf.colorspace
= cs
1578 && conf.angle
= angle
1579 && tilevisible state.layout l.pageno x y
1580 then G.postRedisplay "tile nothrottle";
1582 | Some
(layout, y, _) ->
1583 let ready = layoutready layout in
1587 state.layout <- layout;
1588 state.throttle
<- None
;
1589 G.postRedisplay "throttle";
1596 dolog "Inconsistent tiling state";
1597 logcurrently state.currently
;
1603 Scanf.sscanf args
"%u %u %u %u" (fun n w h x -> n, w, h, x)
1605 state.uioh#infochanged Pdim
;
1606 state.pdims
<- pdim :: state.pdims
1609 let (l, n, t
, h, pos
) =
1610 Scanf.sscanf args
"%u %u %d %u %n" (fun l n t
h pos
-> l, n, t
, h, pos
)
1612 let s = String.sub args pos
(String.length args
- pos
) in
1613 let outline = (s, l, (n, float t
/. float h)) in
1614 begin match state.currently
with
1615 | Outlining outlines
->
1616 state.currently
<- Outlining
(outline :: outlines
)
1618 state.currently
<- Outlining
[outline]
1620 dolog "invalid outlining state";
1621 logcurrently currently
1625 state.docinfo
<- (1, args
) :: state.docinfo
1628 state.uioh#infochanged Docinfo
;
1629 state.docinfo
<- List.rev
state.docinfo
1632 dolog "unknown cmd `%S'" cmds
1636 if state.deadline
== nan
then state.deadline
<- now ();
1637 let rec loop delay
=
1640 then max
0.0 (state.deadline
-. now ())
1643 let r, _, _ = Unix.select
[state.csock
] [] [] timeout in
1646 begin match state.autoscroll
with
1647 | Some step
when step
!= 0 ->
1648 let y = state.y + step
in
1652 else if y >= state.maxy then 0 else y
1655 if state.mode
= View
1656 then state.text <- "";
1657 state.deadline
<- state.deadline
+. 0.005;
1660 state.deadline
<- state.deadline
+. delay
;
1664 let cmd = readcmd state.csock
in
1673 let action = function
1674 | HCprev
-> cbget cb ~
-1
1675 | HCnext
-> cbget cb
1
1676 | HCfirst
-> cbget cb ~
-(cb
.rc)
1677 | HClast
-> cbget cb
(cb
.len - 1 - cb
.rc)
1678 and cancel
() = cb
.rc <- rc
1682 let search pattern forward
=
1683 if String.length pattern
> 0
1686 match state.layout with
1689 l.pageno, (l.pagey + if forward
then 0 else 0*l.pagevh)
1692 let b = makecmd "search"
1693 [`
b conf.icase
; `i
pn; `i
py; `i
(if forward
then 1 else 0)]
1695 Buffer.add_char
b '
,'
;
1696 Buffer.add_string
b pattern
;
1697 Buffer.add_char
b '
\000'
;
1700 writecmd state.csock
cmd;
1703 let intentry text key =
1704 let c = Char.unsafe_chr
key in
1707 let text = addchar text c in
1711 state.text <- Printf.sprintf
"invalid char (%d, `%c')" key c;
1715 let textentry text key =
1716 let c = Char.unsafe_chr
key in
1718 | _ when key >= 32 && key < 127 ->
1719 let text = addchar text c in
1723 dolog "unhandled key %d char `%c'" key (Char.unsafe_chr
key);
1727 let reqlayout angle proportional
=
1728 match state.throttle
with
1730 if state.invalidated
= 0 then state.anchor <- getanchor ();
1731 conf.angle
<- angle
mod 360;
1732 conf.proportional
<- proportional
;
1734 wcmd "reqlayout" [`i
conf.angle
; `
b proportional
];
1738 let settrim trimmargins trimfuzz
=
1739 if state.invalidated
= 0 then state.anchor <- getanchor ();
1740 conf.trimmargins
<- trimmargins
;
1741 conf.trimfuzz
<- trimfuzz
;
1742 let x0, y0
, x1
, y1
= trimfuzz
in
1745 `
b conf.trimmargins
;
1751 Hashtbl.iter
(fun _ opaque
->
1752 wcmd "freepage" [`
s opaque
];
1754 Hashtbl.clear
state.pagemap
;
1758 match state.throttle
with
1760 let zoom = max
0.01 zoom in
1761 if zoom <> conf.zoom
1763 state.prevzoom
<- conf.zoom;
1766 then (state.x <- 0; 0.0)
1767 else float state.x /. float state.w
1770 reshape conf.winw
conf.winh
;
1773 let x = relx *. float state.w in
1774 state.x <- truncate
x;
1776 state.text <- Printf.sprintf
"zoom is now %-5.1f" (zoom *. 100.0);
1782 let enterbirdseye () =
1783 let zoom = float conf.thumbw
/. float conf.winw
in
1784 let birdseyepageno =
1785 let cy = conf.winh
/ 2 in
1789 let rec fold best
= function
1792 let d = cy - (l.pagedispy
+ l.pagevh/2)
1793 and dbest
= cy - (best
.pagedispy
+ best
.pagevh/2) in
1794 if abs
d < abs dbest
1801 state.mode
<- Birdseye
(
1802 { conf with zoom = conf.zoom }, state.x, birdseyepageno, -1, getanchor ()
1805 conf.presentation <- false;
1806 conf.interpagespace <- 10;
1807 conf.hlinks
<- false;
1809 state.mstate
<- Mnone
;
1810 conf.maxwait
<- None
;
1811 Glut.setCursor
Glut.CURSOR_INHERIT
;
1814 state.text <- Printf.sprintf
"birds eye mode on (zoom %3.1f%%)"
1819 reshape conf.winw
conf.winh
;
1822 let leavebirdseye (c, leftx
, pageno, _, anchor) goback
=
1824 conf.zoom <- c.zoom;
1825 conf.presentation <- c.presentation;
1826 conf.interpagespace <- c.interpagespace;
1827 conf.maxwait
<- c.maxwait
;
1828 conf.hlinks
<- c.hlinks
;
1832 state.text <- Printf.sprintf
"birds eye mode off (zoom %3.1f%%)"
1835 reshape conf.winw
conf.winh
;
1836 state.anchor <- if goback
then anchor else (pageno, 0.0);
1839 let togglebirdseye () =
1840 match state.mode
with
1841 | Birdseye vals
-> leavebirdseye vals
true
1842 | View
-> enterbirdseye ()
1846 let upbirdseye (conf, leftx
, pageno, hooverpageno
, anchor) =
1847 let pageno = max
0 (pageno - 1) in
1848 let rec loop = function
1849 | [] -> gotopage1 pageno 0
1850 | l :: _ when l.pageno = pageno ->
1851 if l.pagedispy
>= 0 && l.pagey = 0
1852 then G.postRedisplay "upbirdseye"
1853 else gotopage1 pageno 0
1854 | _ :: rest
-> loop rest
1857 state.mode
<- Birdseye
(conf, leftx
, pageno, hooverpageno
, anchor)
1860 let downbirdseye (conf, leftx
, pageno, hooverpageno
, anchor) =
1861 let pageno = min
(state.pagecount
- 1) (pageno + 1) in
1862 state.mode
<- Birdseye
(conf, leftx
, pageno, hooverpageno
, anchor);
1863 let rec loop = function
1865 let y, h = getpageyh pageno in
1866 let dy = (y - state.y) - (conf.winh
- h - conf.interpagespace) in
1868 | l :: _ when l.pageno = pageno ->
1869 if l.pagevh != l.pageh
1870 then gotoy (clamp (l.pageh
- l.pagevh + conf.interpagespace))
1871 else G.postRedisplay "downbirdseye"
1872 | _ :: rest
-> loop rest
1877 let optentry mode
_ key =
1878 let btos b = if b then "on" else "off" in
1879 let c = Char.unsafe_chr
key in
1883 try conf.scrollstep
<- int_of_string
s with exc
->
1884 state.text <- Printf.sprintf
"bad integer `%s': %s"
1885 s (Printexc.to_string exc
)
1887 TEswitch
("scroll step: ", "", None
, intentry, ondone)
1892 conf.autoscrollstep
<- int_of_string
s;
1893 if state.autoscroll
<> None
1894 then state.autoscroll
<- Some
conf.autoscrollstep
1896 state.text <- Printf.sprintf
"bad integer `%s': %s"
1897 s (Printexc.to_string exc
)
1899 TEswitch
("auto scroll step: ", "", None
, intentry, ondone)
1904 let zoom = float (int_of_string
s) /. 100.0 in
1907 state.text <- Printf.sprintf
"bad integer `%s': %s"
1908 s (Printexc.to_string exc
)
1910 TEswitch
("zoom: ", "", None
, intentry, ondone)
1915 conf.thumbw
<- bound (int_of_string
s) 2 4096;
1917 Printf.sprintf
"thumbnail width is set to %d" conf.thumbw
;
1918 begin match mode
with
1920 leavebirdseye beye
false;
1925 state.text <- Printf.sprintf
"bad integer `%s': %s"
1926 s (Printexc.to_string exc
)
1928 TEswitch
("thumbnail width: ", "", None
, intentry, ondone)
1933 Some
(int_of_string
s)
1935 state.text <- Printf.sprintf
"bad integer `%s': %s"
1936 s (Printexc.to_string exc
);
1939 | Some angle
-> reqlayout angle
conf.proportional
1942 TEswitch
("rotation: ", "", None
, intentry, ondone)
1945 conf.icase
<- not
conf.icase
;
1946 TEdone
("case insensitive search " ^
(btos conf.icase
))
1949 conf.preload <- not
conf.preload;
1951 TEdone
("preload " ^
(btos conf.preload))
1954 conf.verbose
<- not
conf.verbose
;
1955 TEdone
("verbose " ^
(btos conf.verbose
))
1958 conf.debug
<- not
conf.debug
;
1959 TEdone
("debug " ^
(btos conf.debug
))
1962 conf.maxhfit
<- not
conf.maxhfit
;
1963 state.maxy <- state.maxy + (if conf.maxhfit
then -conf.winh
else conf.winh
);
1964 TEdone
("maxhfit " ^
(btos conf.maxhfit
))
1967 conf.crophack
<- not
conf.crophack
;
1968 TEdone
("crophack " ^
btos conf.crophack
)
1972 match conf.maxwait
with
1974 conf.maxwait
<- Some infinity
;
1975 "always wait for page to complete"
1977 conf.maxwait
<- None
;
1978 "show placeholder if page is not ready"
1983 conf.underinfo
<- not
conf.underinfo
;
1984 TEdone
("underinfo " ^
btos conf.underinfo
)
1987 conf.savebmarks
<- not
conf.savebmarks
;
1988 TEdone
("persistent bookmarks " ^
btos conf.savebmarks
)
1994 match state.layout with
1999 conf.interpagespace <- int_of_string
s;
2000 state.maxy <- calcheight ();
2001 let y = getpagey pageno in
2004 state.text <- Printf.sprintf
"bad integer `%s': %s"
2005 s (Printexc.to_string exc
)
2007 TEswitch
("vertical margin: ", "", None
, intentry, ondone)
2010 reqlayout conf.angle
(not
conf.proportional
);
2011 TEdone
("proportional display " ^
btos conf.proportional
)
2014 settrim (not
conf.trimmargins
) conf.trimfuzz
;
2015 TEdone
("trim margins " ^
btos conf.trimmargins
)
2018 conf.invert
<- not
conf.invert
;
2019 TEdone
("invert colors " ^
btos conf.invert
)
2022 state.text <- Printf.sprintf
"bad option %d `%c'" key c;
2026 let maxoutlinerows () = (conf.winh
- !uifontsize - 1) / (!uifontsize + 1);;
2028 class type lvsource
= object
2029 method getitemcount
: int
2030 method getitem
: int -> (string * int)
2031 method hasaction
: int -> bool
2040 method getactive
: int
2041 method getfirst
: int
2042 method getqsearch
: string
2043 method setqsearch
: string -> unit
2047 class virtual lvsourcebase
= object
2048 val mutable m_active
= 0
2049 val mutable m_first
= 0
2050 val mutable m_qsearch
= ""
2051 val mutable m_pan
= 0
2052 method getactive
= m_active
2053 method getfirst
= m_first
2054 method getqsearch
= m_qsearch
2055 method getpan
= m_pan
2056 method setqsearch
s = m_qsearch
<- s
2059 let textentryspecial key = function
2060 | ((c, _, (Some
(action, _) as onhist), onkey
, ondone), mode
) ->
2063 | Glut.KEY_UP
-> action HCprev
2064 | Glut.KEY_DOWN
-> action HCnext
2065 | Glut.KEY_HOME
-> action HCfirst
2066 | Glut.KEY_END
-> action HClast
2069 state.mode
<- Textentry
((c, s, onhist, onkey
, ondone), mode
);
2070 G.postRedisplay "special textentry";
2074 let textentrykeyboard key ((c, text, opthist
, onkey
, ondone), onleave
) =
2076 state.mode
<- Textentry
(te
, onleave
);
2079 G.postRedisplay "textentrykeyboard enttext";
2081 match Char.unsafe_chr
key with
2082 | '
\008'
-> (* backspace *)
2083 let len = String.length
text in
2087 G.postRedisplay "textentrykeyboard after cancel";
2090 let s = String.sub
text 0 (len - 1) in
2091 enttext (c, s, opthist
, onkey
, ondone)
2097 G.postRedisplay "textentrykeyboard after confirm"
2099 | '
\007'
(* ctrl-g *)
2100 | '
\027'
-> (* escape *)
2101 if String.length
text = 0
2103 begin match opthist
with
2105 | Some
(_, onhistcancel
) -> onhistcancel
()
2109 G.postRedisplay "textentrykeyboard after cancel2"
2112 enttext (c, "", opthist
, onkey
, ondone)
2115 | '
\127'
-> () (* delete *)
2118 begin match onkey
text key with
2122 G.postRedisplay "textentrykeyboard after confirm2";
2125 enttext (c, text, opthist
, onkey
, ondone);
2130 G.postRedisplay "textentrykeyboard after cancel3"
2133 state.mode
<- Textentry
(te
, onleave
);
2134 G.postRedisplay "textentrykeyboard switch";
2138 let firstof first active
=
2139 let maxrows = maxoutlinerows () in
2140 if first
> active
|| abs
(first
- active
) > maxrows - 1
2141 then max
0 (active
- (maxrows/2))
2145 class listview ~
(source
:lvsource
) ~trusted
=
2146 let coe s = (s :> uioh
) in
2148 val m_pan
= source#getpan
2149 val m_first
= source#getfirst
2150 val m_active
= source#getactive
2151 val m_qsearch
= source#getqsearch
2152 val m_prev_uioh
= state.uioh
2154 method private elemunder
y =
2155 let n = y / (!uifontsize+1) in
2156 if m_first
+ n < source#getitemcount
2158 if source#hasaction
(m_first
+ n)
2159 then Some
(m_first
+ n)
2166 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
2167 GlDraw.color
(0., 0., 0.) ~alpha
:0.85;
2168 GlDraw.rect (0., 0.) (float conf.winw
, float conf.winh
);
2169 GlDraw.color
(1., 1., 1.);
2170 Gl.enable `texture_2d
;
2171 let fs = !uifontsize in
2174 let tabw = 30.0*.ww in
2176 if (row - m_first
) * nfs > conf.winh
2179 if row >= 0 && row < source#getitemcount
2181 let (s, level
) = source#getitem
row in
2182 let y = (row - m_first
) * nfs in
2183 let x = 5.0 +. float (level
+ m_pan
) *. ww in
2186 Gl.disable `texture_2d
;
2187 GlDraw.polygon_mode `both `line
;
2188 GlDraw.color
(1., 1., 1.) ~alpha
:0.9;
2189 GlDraw.rect (1., float (y + 1))
2190 (float (conf.winw
- 1), float (y + fs + 3));
2191 GlDraw.polygon_mode `both `fill
;
2192 GlDraw.color
(1., 1., 1.);
2193 Gl.enable `texture_2d
;
2196 let drawtabularstring s =
2197 let drawstr x s = drawstring1 fs (truncate
x) (y+nfs) s in
2200 let tabpos = try String.index
s '
\t'
with Not_found
-> -1 in
2203 let len = String.length
s - tabpos - 1 in
2204 let s1 = String.sub
s 0 tabpos
2205 and s2
= String.sub
s (tabpos + 1) len in
2206 let nx = drawstr x s1 in
2208 let x = x +. (max
tabw sw) in
2215 let _ = drawtabularstring s in
2222 Gl.disable `texture_2d
;
2224 method private key1
key =
2225 let set active first qsearch
=
2226 coe {< m_active
= active
; m_first
= first
; m_qsearch
= qsearch
>}
2228 let search active pattern incr
=
2231 if n >= 0 && n < source#getitemcount
2233 let s, _ = source#getitem
n in
2235 (try ignore
(Str.search_forward
re s 0); true
2236 with Not_found
-> false)
2238 else loop (n + incr
)
2245 let re = Str.regexp_case_fold pattern
in
2252 | 18 | 19 -> (* ctrl-r/ctlr-s *)
2253 let incr = if key = 18 then -1 else 1 in
2255 match search (m_active
+ incr) m_qsearch
incr with
2257 state.text <- m_qsearch ^
" [not found]";
2260 state.text <- m_qsearch
;
2261 active, firstof m_first
active
2263 G.postRedisplay "listview ctrl-r/s";
2264 set active first m_qsearch
;
2266 | 8 -> (* backspace *)
2267 let len = String.length m_qsearch
in
2274 G.postRedisplay "listview empty qsearch";
2275 set m_active m_first
"";
2278 let qsearch = String.sub m_qsearch
0 (len - 1) in
2280 match search m_active
qsearch ~
-1 with
2282 state.text <- qsearch ^
" [not found]";
2285 state.text <- qsearch;
2286 active, firstof m_first
active
2288 G.postRedisplay "listview backspace qsearch";
2289 set active first
qsearch
2292 | _ when key >= 32 && key < 127 ->
2293 let pattern = addchar m_qsearch
(Char.chr
key) in
2295 match search m_active
pattern 1 with
2297 state.text <- pattern ^
" [not found]";
2300 state.text <- pattern;
2301 active, firstof m_first
active
2303 G.postRedisplay "listview qsearch add";
2304 set active first
pattern;
2306 | 27 -> (* escape *)
2308 if String.length m_qsearch
= 0
2310 G.postRedisplay "list view escape";
2313 source#exit
(coe self
) true m_active m_first m_pan m_qsearch
2315 | None
-> m_prev_uioh
2320 G.postRedisplay "list view kill qsearch";
2321 source#setqsearch
"";
2322 coe {< m_qsearch
= "" >}
2327 let self = {< m_qsearch
= "" >} in
2328 source#setqsearch
"";
2330 G.postRedisplay "listview enter";
2331 if m_active
>= 0 && m_active
< source#getitemcount
2333 source#exit
(coe self) false m_active m_first m_pan
"";
2336 source#exit
(coe self) true m_active m_first m_pan
"";
2339 begin match opt with
2340 | None
-> m_prev_uioh
2344 | 127 -> (* delete *)
2347 | _ -> dolog "unknown key %d" key; coe self
2349 method private special1
key =
2350 let maxrows = maxoutlinerows () in
2351 let itemcount = source#getitemcount
in
2352 let find start
incr =
2354 if i
= -1 || i
= itemcount
2357 if source#hasaction i
2359 else find (i
+ incr)
2364 let set active first
=
2365 let first = bound first 0 (itemcount - maxrows) in
2367 coe {< m_active
= active; m_first
= first >}
2370 let isvisible first n = n >= first && n - first <= maxrows in
2372 let incr1 = if incr > 0 then 1 else -1 in
2373 if isvisible m_first m_active
2376 let next = m_active
+ incr in
2378 if next < 0 || next >= itemcount
2380 else find next incr1
2382 if next = -1 || abs
(m_active
- next) > maxrows
2388 let first = m_first
+ incr in
2389 let first = bound first 0 (itemcount - 1) in
2391 let next = m_active
+ incr in
2392 let next = bound next 0 (itemcount - 1) in
2395 let active = if next = -1 then m_active
else next in
2398 let first = min
next m_first
in
2401 let first = m_first
+ incr in
2402 let first = bound first 0 (itemcount - 1) in
2404 let next = m_active
+ incr in
2405 let next = bound next 0 (itemcount - 1) in
2406 let next = find next incr1 in
2407 if next = -1 || abs
(m_active
- first) > maxrows
2413 G.postRedisplay "listview navigate";
2416 begin match key with
2417 | Glut.KEY_UP
-> navigate ~
-1
2418 | Glut.KEY_DOWN
-> navigate 1
2419 | Glut.KEY_PAGE_UP
-> navigate ~
-maxrows
2420 | Glut.KEY_PAGE_DOWN
-> navigate maxrows
2424 G.postRedisplay "listview right";
2425 coe {< m_pan
= m_pan
- 1 >}
2429 G.postRedisplay "listview left";
2430 coe {< m_pan
= m_pan
+ 1 >}
2433 let active = find 0 1 in
2434 G.postRedisplay "listview home";
2438 let first = max
0 (itemcount - maxrows) in
2439 let active = find (itemcount - 1) ~
-1 in
2440 G.postRedisplay "listview end";
2447 match state.mode
with
2448 | Textentry te
-> textentrykeyboard key te
; coe self
2449 | _ -> self#key1
key
2451 method special
key =
2452 match state.mode
with
2453 | Textentry te
-> textentryspecial key te
; coe self
2454 | _ -> self#special1
key
2456 method button button bstate
_ y =
2459 | Glut.LEFT_BUTTON
when bstate
= Glut.UP
->
2460 begin match self#elemunder
y with
2462 G.postRedisplay "listview click";
2463 source#exit
(coe {< m_active
= n >}) false n m_first m_pan m_qsearch
2467 | Glut.OTHER_BUTTON
n when (n == 3 || n == 4) && bstate
= Glut.UP
->
2468 let len = source#getitemcount
in
2470 if m_first
+ maxoutlinerows () >= len
2474 let first = m_first
+ (if n == 3 then -1 else 1) in
2475 bound first 0 (len - 1)
2477 G.postRedisplay "listview wheel";
2478 Some
(coe {< m_first
= first >})
2483 | None
-> m_prev_uioh
2486 method motion
_ _ = coe self
2488 method pmotion
_ y =
2490 match self#elemunder
y with
2491 | None
-> Glut.setCursor
Glut.CURSOR_INHERIT
; m_active
2492 | Some
n -> Glut.setCursor
Glut.CURSOR_INFO
; n
2496 then (G.postRedisplay "listview pmotion"; {< m_active
= n >})
2501 method infochanged
_ = ()
2504 class outlinelistview ~source
: uioh
=
2505 let coe o = (o :> uioh
) in
2507 inherit listview ~source
:(source
:> lvsource
) ~trusted
:false as super
2511 | 14 -> (* ctrl-n *)
2512 source#narrow m_qsearch
;
2513 G.postRedisplay "outline ctrl-n";
2514 coe {< m_first
= 0; m_active
= 0 >}
2516 | 21 -> (* ctrl-u *)
2518 G.postRedisplay "outline ctrl-u";
2519 coe {< m_first
= 0; m_active
= 0 >}
2521 | 12 -> (* ctrl-l *)
2522 let first = m_active
- (maxoutlinerows () / 2) in
2523 G.postRedisplay "outline ctrl-l";
2524 coe {< m_first
= first >}
2526 | 127 -> (* delete *)
2527 source#remove m_active
;
2528 G.postRedisplay "outline delete";
2529 let active = max
0 (m_active
-1) in
2530 coe {< m_first
= firstof m_first
active; m_active
= active >}
2532 | key -> super#
key key
2534 method special
key =
2535 let maxrows = maxoutlinerows () in
2536 let calcfirst first active =
2539 let rows = active - first in
2540 if rows > maxrows then active - maxrows else first
2544 let active = m_active
+ incr in
2545 let active = bound active 0 (source#getitemcount
- 1) in
2546 let first = calcfirst m_first
active in
2547 G.postRedisplay "special outline navigate";
2548 coe {< m_active
= active; m_first
= first >}
2550 let updownlevel incr =
2551 let len = source#getitemcount
in
2552 let _, curlevel
= source#getitem m_active
in
2554 if i
= len then i
-1 else if i
= -1 then 0 else
2555 let _, l = source#getitem i
in
2556 if l != curlevel
then i
else flow (i
+incr)
2558 let active = flow m_active
in
2559 let first = calcfirst m_first
active in
2560 G.postRedisplay "special outline updownlevel";
2561 {< m_active
= active; m_first
= first >}
2564 | Glut.KEY_UP
-> navigate ~
-1
2565 | Glut.KEY_DOWN
-> navigate 1
2566 | Glut.KEY_PAGE_UP
-> navigate ~
-maxrows
2567 | Glut.KEY_PAGE_DOWN
-> navigate maxrows
2571 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
2573 G.postRedisplay "special outline right";
2574 {< m_pan
= m_pan
+ 1 >}
2582 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
2584 G.postRedisplay "special outline left";
2585 {< m_pan
= m_pan
- 1 >}
2587 else updownlevel ~
-1
2592 G.postRedisplay "special outline home";
2593 coe {< m_first
= 0; m_active
= 0 >}
2596 let active = source#getitemcount
- 1 in
2597 let first = max
0 (active - maxrows) in
2598 G.postRedisplay "special outline end";
2599 coe {< m_active
= active; m_first
= first >}
2601 | _ -> super#special
key
2604 let outlinesource usebookmarks
=
2607 inherit lvsourcebase
2608 val mutable m_items
= empty
2609 val mutable m_orig_items
= empty
2610 val mutable m_prev_items
= empty
2611 val mutable m_narrow_pattern
= ""
2612 val mutable m_hadremovals
= false
2614 method getitemcount
= Array.length m_items
+ (if m_hadremovals
then 1 else 0)
2617 if n == Array.length m_items
&& m_hadremovals
2619 ("[Confirm removal]", 0)
2621 let s, n, _ = m_items
.(n) in
2624 method exit ~uioh ~cancel ~
active ~
first ~pan ~
qsearch =
2625 ignore
(uioh
, first, pan
, qsearch);
2626 let confrimremoval = m_hadremovals
&& active = Array.length m_items
in
2628 if String.length m_narrow_pattern
= 0
2634 if not
confrimremoval
2636 let _, _, anchor = m_items
.(active) in
2641 state.bookmarks
<- Array.to_list m_items
;
2642 m_orig_items
<- m_items
;
2645 else m_items
<- items;
2648 method hasaction
_ = true
2651 if Array.length m_items
!= Array.length m_orig_items
2652 then "Narrowed to " ^ m_narrow_pattern ^
" (ctrl-u to restore)"
2655 method narrow
pattern =
2656 let reopt = try Some
(Str.regexp_case_fold
pattern) with _ -> None
in
2660 let rec loop accu n =
2663 m_narrow_pattern
<- pattern;
2664 m_items
<- Array.of_list
accu
2667 let (s, _, _) as o = m_items
.(n) in
2669 if (try ignore
(Str.search_forward
re s 0); true
2670 with Not_found
-> false)
2676 loop [] (Array.length m_items
- 1)
2681 then Array.of_list
state.bookmarks
2684 m_items
<- m_orig_items
2689 if m
>= 0 && m
< Array.length m_items
2691 m_hadremovals
<- true;
2692 m_items
<- Array.init
(Array.length m_items
- 1) (fun n ->
2693 let n = if n >= m
then n+1 else n in
2698 method reset
pageno items =
2699 m_hadremovals
<- false;
2700 if m_orig_items
== empty || m_prev_items
!= items
2702 m_orig_items
<- items;
2703 if String.length m_narrow_pattern
= 0
2704 then m_items
<- items;
2706 m_prev_items
<- items;
2708 let rec loop n best bestd
=
2709 if n = Array.length m_items
2712 let (_, _, (outlinepageno
, _)) = m_items
.(n) in
2713 let d = abs
(outlinepageno
- pageno) in
2716 else loop (n+1) best bestd
2721 m_first
<- firstof m_first
active
2725 let enterselector usebookmarks
=
2726 let source = outlinesource usebookmarks
in
2730 then Array.of_list
state.bookmarks
2733 if Array.length
outlines = 0
2735 showtext ' ' errmsg
;
2738 state.text <- source#greetmsg
;
2739 Glut.setCursor
Glut.CURSOR_INHERIT
;
2741 match state.layout with
2743 | {pageno=pageno} :: _ -> pageno
2745 source#reset
pageno outlines;
2746 state.uioh
<- new outlinelistview ~
source;
2747 G.postRedisplay "enter selector";
2751 let enteroutlinemode =
2752 let f = enterselector false in
2753 fun ()-> f "Document has no outline";
2756 let enterbookmarkmode =
2757 let f = enterselector true in
2758 fun () -> f "Document has no bookmarks (yet)";
2761 let color_of_string s =
2762 Scanf.sscanf
s "%d/%d/%d" (fun r g
b ->
2763 (float r /. 256.0, float g
/. 256.0, float b /. 256.0)
2767 let color_to_string (r, g
, b) =
2768 let r = truncate
(r *. 256.0)
2769 and g
= truncate
(g
*. 256.0)
2770 and b = truncate
(b *. 256.0) in
2771 Printf.sprintf
"%d/%d/%d" r g
b
2774 let irect_of_string s =
2775 Scanf.sscanf
s "%d/%d/%d/%d" (fun x0 y0 x1 y1
-> (x0,y0
,x1
,y1
))
2778 let irect_to_string (x0,y0
,x1
,y1
) =
2779 Printf.sprintf
"%d/%d/%d/%d" x0 y0 x1 y1
2782 let makecheckers () =
2783 (* Appropriated from lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
2785 converted by Issac Trotts. July 25, 2002 *)
2786 let image_height = 64
2787 and image_width
= 64 in
2791 GlPix.create `ubyte ~format
:`rgb ~width
:image_width ~height
:image_height in
2792 for i
= 0 to image_width
- 1 do
2793 for j
= 0 to image_height - 1 do
2794 Raw.sets
(GlPix.to_raw
image) ~pos
:(3*(i
*image_height+j
))
2795 (if (i
land 8 ) lxor (j
land 8) = 0
2796 then [|255;255;255|] else [|200;200;200|])
2801 let image = make_image () in
2802 let id = GlTex.gen_texture
() in
2803 GlTex.bind_texture `texture_2d
id;
2804 GlPix.store
(`unpack_alignment
1);
2805 GlTex.image2d
image;
2806 List.iter
(GlTex.parameter ~target
:`texture_2d
)
2809 `mag_filter `nearest
;
2810 `min_filter `nearest
];
2814 let setcheckers enabled
=
2815 match state.texid
with
2817 if enabled
then state.texid
<- Some
(makecheckers ())
2822 GlTex.delete_texture texid
;
2823 state.texid
<- None
;
2827 let int_of_string_with_suffix s =
2828 let l = String.length
s in
2832 let suffix = Char.lowercase
s.[l-1] in
2834 | 'k'
-> String.sub
s 0 (l-1), 10
2835 | 'm'
-> String.sub
s 0 (l-1), 20
2836 | 'g'
-> String.sub
s 0 (l-1), 30
2840 let n = int_of_string
s1 in
2841 let m = n lsl shift
in
2843 then raise
(Failure
"value too large")
2847 let string_with_suffix_of_int n =
2855 if n land ((1 lsl 20) - 1) = 0
2858 if n land ((1 lsl 10) - 1) = 0
2865 let h = n mod 1000 in
2868 then string_of_int
h ^
s
2870 let s = Printf.sprintf
"_%03d%s" h s in
2877 let describe_location () =
2879 if fn
= -1 then l.pageno, l.pageno else fn
, l.pageno
2881 let fn, ln
= List.fold_left
f (-1, -1) state.layout in
2882 let maxy = state.maxy - (if conf.maxhfit
then conf.winh
else 0) in
2886 else (100. *. (float state.y /. float maxy))
2890 Printf.sprintf
"page %d of %d [%.2f%%]"
2891 (fn+1) state.pagecount
percent
2894 "pages %d-%d of %d [%.2f%%]"
2895 (fn+1) (ln
+1) state.pagecount
percent
2899 let btos b = if b then "\xe2\x88\x9a" else "" in
2900 let showextended = ref false in
2901 let leave mode
= function
2902 | Confirm
-> state.mode
<- mode
2903 | Cancel
-> state.mode
<- mode
in
2906 val mutable m_first_time
= true
2907 val mutable m_l
= []
2908 val mutable m_a
= [||]
2909 val mutable m_prev_uioh
= nouioh
2910 val mutable m_prev_mode
= View
2912 inherit lvsourcebase
2914 method reset prev_mode prev_uioh
=
2915 m_a
<- Array.of_list
(List.rev m_l
);
2917 m_prev_mode
<- prev_mode
;
2918 m_prev_uioh
<- prev_uioh
;
2922 if n >= Array.length m_a
2926 | _, _, _, Action
_ -> m_active
<- n
2930 m_first_time
<- false;
2933 method int name get
set =
2935 (name
, `
int get
, 1, Action
(
2938 try set (int_of_string
s)
2940 state.text <- Printf.sprintf
"bad integer `%s': %s"
2941 s (Printexc.to_string exn
)
2944 let te = name ^
": ", "", None
, intentry, ondone in
2945 state.mode
<- Textentry
(te, leave m_prev_mode
);
2949 method int_with_suffix name get
set =
2951 (name
, `intws get
, 1, Action
(
2954 try set (int_of_string_with_suffix s)
2956 state.text <- Printf.sprintf
"bad integer `%s': %s"
2957 s (Printexc.to_string exn
)
2961 name ^
": ", "", None
, intentry_with_suffix, ondone
2963 state.mode
<- Textentry
(te, leave m_prev_mode
);
2967 method bool ?
(offset
=1) ?
(btos=btos) name get
set =
2969 (name
, `
bool (btos, get
), offset
, Action
(
2976 method color name get
set =
2978 (name
, `color get
, 1, Action
(
2980 let invalid = (nan
, nan
, nan
) in
2983 try color_of_string s
2985 state.text <- Printf.sprintf
"bad color `%s': %s"
2986 s (Printexc.to_string exn
);
2992 let te = name ^
": ", "", None
, textentry, ondone in
2993 state.text <- color_to_string (get
());
2994 state.mode
<- Textentry
(te, leave m_prev_mode
);
2998 method string name get
set =
3000 (name
, `
string get
, 1, Action
(
3002 let ondone s = set s in
3003 let te = name ^
": ", "", None
, textentry, ondone in
3004 state.mode
<- Textentry
(te, leave m_prev_mode
);
3008 method colorspace name get
set =
3010 (name
, `
string get
, 1, Action
(
3013 let vals = [| "rgb"; "bgr"; "gray" |] in
3015 inherit lvsourcebase
3018 m_active
<- int_of_colorspace conf.colorspace
;
3021 method getitemcount
= Array.length
vals
3022 method getitem
n = (vals.(n), 0)
3023 method exit ~uioh ~cancel ~
active ~
first ~pan ~
qsearch =
3024 ignore
(uioh
, first, pan
, qsearch);
3025 if not cancel
then set active;
3027 method hasaction
_ = true
3031 new listview ~
source ~trusted
:true
3034 method caption
s offset
=
3035 m_l
<- (s, `
empty, offset
, Noaction
) :: m_l
3037 method caption2
s f offset
=
3038 m_l
<- (s, `
string f, offset
, Noaction
) :: m_l
3040 method getitemcount
= Array.length m_a
3043 let tostr = function
3044 | `
int f -> string_of_int
(f ())
3045 | `intws
f -> string_with_suffix_of_int (f ())
3047 | `color
f -> color_to_string (f ())
3048 | `
bool (btos, f) -> btos (f ())
3051 let name, t
, offset
, _ = m_a
.(n) in
3052 ((let s = tostr t
in
3053 if String.length
s > 0
3054 then Printf.sprintf
"%s\t%s" name s
3058 method exit ~uioh ~cancel ~
active ~
first ~pan ~
qsearch =
3062 m_qsearch
<- qsearch;
3064 match m_a
.(active) with
3065 | _, _, _, Action
f -> f uioh
3077 method hasaction
n =
3079 | _, _, _, Action
_ -> true
3083 let rec fillsrc prevmode prevuioh
=
3084 let sep () = src#caption
"" 0 in
3085 let colorp name get
set =
3087 (fun () -> color_to_string (get
()))
3090 let c = color_of_string v in
3093 state.text <- Printf.sprintf
"bad color `%s': %s"
3094 v (Printexc.to_string exn
);
3097 let oldmode = state.mode
in
3098 let birdseye = isbirdseye state.mode
in
3100 src#caption
(if birdseye then "Setup (Bird's eye)" else "Setup") 0;
3102 src#
bool "presentation mode"
3103 (fun () -> conf.presentation)
3105 conf.presentation <- v;
3106 state.anchor <- getanchor ();
3109 src#
bool "ignore case in searches"
3110 (fun () -> conf.icase
)
3111 (fun v -> conf.icase
<- v);
3114 (fun () -> conf.preload)
3115 (fun v -> conf.preload <- v);
3117 src#
bool "highlight links"
3118 (fun () -> conf.hlinks
)
3119 (fun v -> conf.hlinks
<- v);
3121 src#
bool "under info"
3122 (fun () -> conf.underinfo
)
3123 (fun v -> conf.underinfo
<- v);
3125 src#
bool "persistent bookmarks"
3126 (fun () -> conf.savebmarks
)
3127 (fun v -> conf.savebmarks
<- v);
3129 src#
bool "proportional display"
3130 (fun () -> conf.proportional
)
3131 (fun v -> reqlayout conf.angle
v);
3133 src#
bool "trim margins"
3134 (fun () -> conf.trimmargins
)
3135 (fun v -> settrim v conf.trimfuzz
; fillsrc prevmode prevuioh
);
3137 src#
bool "persistent location"
3138 (fun () -> conf.jumpback
)
3139 (fun v -> conf.jumpback
<- v);
3142 src#
int "vertical margin"
3143 (fun () -> conf.interpagespace)
3145 conf.interpagespace <- n;
3147 match state.layout with
3152 state.maxy <- calcheight ();
3153 let y = getpagey pageno in
3158 (fun () -> conf.pagebias
)
3159 (fun v -> conf.pagebias
<- v);
3161 src#
int "scroll step"
3162 (fun () -> conf.scrollstep
)
3163 (fun n -> conf.scrollstep
<- n);
3165 src#
int "auto scroll step"
3167 match state.autoscroll
with
3169 | _ -> conf.autoscrollstep
)
3171 if state.autoscroll
<> None
3172 then state.autoscroll
<- Some
n;
3173 conf.autoscrollstep
<- n);
3176 (fun () -> truncate
(conf.zoom *. 100.))
3177 (fun v -> setzoom ((float v) /. 100.));
3180 (fun () -> conf.angle
)
3181 (fun v -> reqlayout v conf.proportional
);
3183 src#
int "scroll bar width"
3184 (fun () -> state.scrollw
)
3188 reshape conf.winw
conf.winh
;
3191 src#
int "scroll handle height"
3192 (fun () -> conf.scrollh
)
3193 (fun v -> conf.scrollh
<- v;);
3195 src#
int "thumbnail width"
3196 (fun () -> conf.thumbw
)
3198 conf.thumbw
<- min
4096 v;
3201 leavebirdseye beye
false;
3207 src#caption
"Presentation mode" 0;
3208 src#
bool "scrollbar visible"
3209 (fun () -> conf.scrollbarinpm
)
3211 if v != conf.scrollbarinpm
3213 conf.scrollbarinpm
<- v;
3214 if conf.presentation
3216 state.scrollw
<- if v then conf.scrollbw
else 0;
3217 reshape conf.winw
conf.winh
;
3223 src#caption
"Pixmap cache" 0;
3224 src#int_with_suffix
"size (advisory)"
3225 (fun () -> conf.memlimit
)
3226 (fun v -> conf.memlimit
<- v);
3229 (fun () -> Printf.sprintf
"%s bytes, %d tiles"
3230 (string_with_suffix_of_int state.memused
)
3231 (Hashtbl.length
state.tilemap
)) 1;
3234 src#caption
"Layout" 0;
3235 src#caption2
"Dimension"
3237 Printf.sprintf
"%dx%d (virtual %dx%d)"
3243 src#caption2
"Position" (fun () ->
3244 Printf.sprintf
"%dx%d" state.x state.y
3247 src#caption2
"Visible" (fun () -> describe_location ()) 1
3251 src#
bool ~offset
:0 ~
btos:(fun v -> if v then "(on)" else "(off)")
3252 "Save these parameters as global defaults at exit"
3253 (fun () -> conf.bedefault
)
3254 (fun v -> conf.bedefault
<- v)
3258 let btos b = if b then "\xc2\xab" else "\xc2\xbb" in
3259 src#
bool ~offset
:0 ~
btos "Extended parameters"
3260 (fun () -> !showextended)
3261 (fun v -> showextended := v; fillsrc prevmode prevuioh
);
3265 (fun () -> conf.checkers
)
3266 (fun v -> conf.checkers
<- v; setcheckers v);
3268 (fun () -> conf.verbose
)
3269 (fun v -> conf.verbose
<- v);
3270 src#
bool "invert colors"
3271 (fun () -> conf.invert
)
3272 (fun v -> conf.invert
<- v);
3274 (fun () -> conf.maxhfit
)
3275 (fun v -> conf.maxhfit
<- v);
3276 src#
string "uri launcher"
3277 (fun () -> conf.urilauncher
)
3278 (fun v -> conf.urilauncher
<- v);
3279 src#
string "tile size"
3280 (fun () -> Printf.sprintf
"%dx%d" conf.tilew
conf.tileh
)
3283 let w, h = Scanf.sscanf
v "%dx%d" (fun w h -> w, h) in
3284 conf.tileh
<- max
64 w;
3285 conf.tilew
<- max
64 h;
3288 state.text <- Printf.sprintf
"bad tile size `%s': %s"
3289 v (Printexc.to_string exn
));
3290 src#
int "anti-aliasing level"
3291 (fun () -> conf.aalevel
)
3293 conf.aalevel
<- bound v 0 8;
3294 state.anchor <- getanchor ();
3295 opendoc state.path
state.password
;
3297 src#
int "ui font size"
3298 (fun () -> !uifontsize)
3300 uifontsize := bound v 5 100;
3301 wwidth := measurestr
!uifontsize "w";
3303 colorp "background color"
3304 (fun () -> conf.bgcolor
)
3305 (fun v -> conf.bgcolor
<- v);
3306 src#
bool "crop hack"
3307 (fun () -> conf.crophack
)
3308 (fun v -> conf.crophack
<- v);
3309 src#
string "trim fuzz"
3310 (fun () -> irect_to_string conf.trimfuzz
)
3313 conf.trimfuzz
<- irect_of_string v;
3315 then settrim true conf.trimfuzz
;
3317 state.text <- Printf.sprintf
"bad irect `%s': %s"
3318 v (Printexc.to_string exn
)
3320 src#
string "throttle"
3322 match conf.maxwait
with
3323 | None
-> "show place holder if page is not ready"
3326 then "wait for page to fully render"
3328 "wait " ^ string_of_float time
3329 ^
" seconds before showing placeholder"
3333 let f = float_of_string
v in
3335 then conf.maxwait
<- None
3336 else conf.maxwait
<- Some
f
3338 state.text <- Printf.sprintf
"bad time `%s': %s"
3339 v (Printexc.to_string exn
)
3341 src#colorspace
"color space"
3342 (fun () -> colorspace_to_string conf.colorspace
)
3344 conf.colorspace
<- colorspace_of_int v;
3351 src#caption
"Document" 0;
3352 List.iter
(fun (_, s) -> src#caption
s 1) state.docinfo
;
3356 src#caption
"Trimmed margins" 0;
3357 src#caption2
"Dimensions"
3358 (fun () -> string_of_int
(List.length
state.pdims
)) 1;
3361 src#reset prevmode prevuioh
;
3365 let prevmode = state.mode
3366 and prevuioh
= state.uioh in
3367 fillsrc prevmode prevuioh
;
3368 let source = (src :> lvsource
) in
3369 state.uioh <- object
3370 inherit listview ~
source ~trusted
:true
3371 val mutable m_prevmemused
= 0
3372 method infochanged
= function
3374 if m_prevmemused
!= state.memused
3376 m_prevmemused
<- state.memused
;
3377 G.postRedisplay "memusedchanged";
3379 | Pdim
-> G.postRedisplay "pdimchanged"
3380 | Docinfo
-> fillsrc prevmode prevuioh
3382 G.postRedisplay "info";
3388 inherit lvsourcebase
3389 method getitemcount
= Array.length
state.help
3391 let s, n, _ = state.help
.(n) in
3394 method exit ~
uioh ~cancel ~
active ~
first ~pan ~
qsearch =
3398 m_qsearch
<- qsearch;
3399 match state.help
.(active) with
3400 | _, _, Action
f -> Some
(f uioh)
3410 method hasaction
n =
3411 match state.help
.(n) with
3412 | _, _, Action
_ -> true
3419 state.uioh <- new listview ~
source ~trusted
:true;
3420 G.postRedisplay "help";
3423 let quickbookmark ?title
() =
3424 match state.layout with
3430 let sec = Unix.gettimeofday
() in
3431 let tm = Unix.localtime
sec in
3432 Printf.sprintf
"Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
3436 (tm.Unix.tm_year
+ 1900)
3439 | Some
title -> title
3442 (title, 0, (l.pageno, float l.pagey /. float l.pageh
))
3447 state.fullscreen
<- None
;
3448 Glut.reshapeWindow
w h;
3451 let viewkeyboard key =
3453 let mode = state.mode in
3454 state.mode <- Textentry
(te, fun _ -> state.mode <- mode);
3457 G.postRedisplay "view:enttext"
3459 let c = Char.chr
key in
3461 | '
\027'
| 'q'
-> (* escape *)
3462 begin match state.mstate
with
3464 state.mstate
<- Mnone
;
3465 Glut.setCursor
Glut.CURSOR_INHERIT
;
3466 G.postRedisplay "kill zoom rect";
3471 | '
\008'
-> (* backspace *)
3472 let y = getnav ~
-1 in
3473 gotoy_and_clear_text y
3481 G.postRedisplay "dehighlight";
3484 let ondone isforw
s =
3485 cbput state.hists
.pat
s;
3486 state.searchpattern
<- s;
3489 let s = String.create
1 in
3491 enttext (s, "", Some
(onhist state.hists
.pat
),
3492 textentry, ondone (c ='
/'
))
3494 | '
+'
when Glut.getModifiers
() land Glut.active_ctrl
!= 0 ->
3495 let incr = if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
3496 setzoom (conf.zoom +. incr)
3501 try int_of_string
s with exc
->
3502 state.text <- Printf.sprintf
"bad integer `%s': %s"
3503 s (Printexc.to_string exc
);
3509 state.text <- "page bias is now " ^ string_of_int
n;
3512 enttext ("page bias: ", "", None
, intentry, ondone)
3514 | '
-'
when Glut.getModifiers
() land Glut.active_ctrl
!= 0 ->
3515 let decr = if conf.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
3516 setzoom (max
0.01 (conf.zoom -. decr))
3519 let ondone msg
= state.text <- msg
in
3521 "option [acfhilpstvAPRSZTI]: ", "", None
,
3522 optentry state.mode, ondone
3525 | '
0'
when (Glut.getModifiers
() land Glut.active_ctrl
!= 0) ->
3528 | '
1'
when (Glut.getModifiers
() land Glut.active_ctrl
!= 0) ->
3529 let zoom = zoomforh
conf.winw
conf.winh
state.scrollw
in
3533 | '
9'
when (Glut.getModifiers
() land Glut.active_ctrl
!= 0) ->
3539 try int_of_string
s with exc
->
3540 state.text <- Printf.sprintf
"bad integer `%s': %s"
3541 s (Printexc.to_string exc
);
3547 cbput state.hists
.pag
(string_of_int
n);
3548 gotoy_and_clear_text (getpagey (n + conf.pagebias
- 1))
3551 let pageentry text key =
3552 match Char.unsafe_chr
key with
3553 | 'g'
-> TEdone
text
3554 | _ -> intentry text key
3556 let text = "x" in text.[0] <- c;
3557 enttext (":", text, Some
(onhist state.hists
.pag
), pageentry, ondone)
3560 state.scrollw
<- if state.scrollw
> 0 then 0 else conf.scrollbw
;
3561 reshape conf.winw
conf.winh
;
3564 conf.hlinks
<- not
conf.hlinks
;
3565 state.text <- "highlightlinks " ^
if conf.hlinks
then "on" else "off";
3566 G.postRedisplay "toggle highlightlinks";
3569 begin match state.autoscroll
with
3571 conf.autoscrollstep
<- step
;
3572 state.autoscroll
<- None
3574 if conf.autoscrollstep
= 0
3575 then state.autoscroll
<- Some
1
3576 else state.autoscroll
<- Some
conf.autoscrollstep
3580 conf.presentation <- not
conf.presentation;
3581 if conf.presentation
3583 if not
conf.scrollbarinpm
3584 then state.scrollw
<- 0;
3587 state.scrollw
<- conf.scrollbw
;
3589 showtext ' '
("presentation mode " ^
3590 if conf.presentation then "on" else "off");
3591 state.anchor <- getanchor ();
3595 begin match state.fullscreen
with
3597 state.fullscreen
<- Some
(conf.winw
, conf.winh
);
3600 state.fullscreen
<- None
;
3605 gotoy_and_clear_text 0
3608 gotopage1 (state.pagecount
- 1) 0
3611 search state.searchpattern
true
3614 search state.searchpattern
false
3617 begin match state.layout with
3620 gotoy_and_clear_text (getpagey l.pageno)
3624 begin match List.rev
state.layout with
3627 let pageno = min
(l.pageno+1) (state.pagecount
-1) in
3628 gotoy_and_clear_text (getpagey pageno)
3631 | '
\127'
-> (* del *)
3632 begin match state.layout with
3635 let pageno = max
0 (l.pageno-1) in
3636 gotoy_and_clear_text (getpagey pageno)
3640 showtext ' '
(describe_location ());
3643 begin match state.layout with
3646 doreshape (l.pagew
+ state.scrollw
) l.pageh
;
3651 enterbookmarkmode ()
3661 match state.layout with
3664 (s, 0, (l.pageno, float l.pagey /. float l.pageh
))
3668 enttext ("bookmark: ", "", None
, textentry, ondone)
3672 showtext ' '
"Quick bookmark added";
3675 begin match state.layout with
3677 let rect = getpdimrect
l.pagedimno
in
3681 (truncate
(1.8 *. (rect.(1) -. rect.(0))),
3682 truncate
(1.2 *. (rect.(3) -. rect.(0))))
3684 (truncate
(rect.(1) -. rect.(0)),
3685 truncate
(rect.(3) -. rect.(0)))
3687 let w = truncate
((float w)*.conf.zoom)
3688 and h = truncate
((float h)*.conf.zoom) in
3691 state.anchor <- getanchor ();
3692 doreshape (w + state.scrollw
) (h + conf.interpagespace)
3694 G.postRedisplay "z";
3699 | '
\000'
-> (* ctrl-2 *)
3700 let maxw = getmaxw
() in
3702 then setzoom (maxw /. float conf.winw
)
3705 reqlayout (conf.angle
+ (if c = '
>'
then 30 else -30)) conf.proportional
3709 bound (state.colorscale
+. (if c = '
]'
then 0.1 else -0.1)) 0.0 1.0
3711 G.postRedisplay "brightness";
3714 begin match state.mode with
3715 | Birdseye beye
-> upbirdseye beye
3716 | _ -> gotoy (clamp (-conf.scrollstep
))
3720 begin match state.mode with
3721 | Birdseye beye
-> downbirdseye beye
3722 | _ -> gotoy (clamp conf.scrollstep
)
3726 state.anchor <- getanchor ();
3727 opendoc state.path
state.password
3729 | '
v'
when conf.debug
->
3732 match getopaque l.pageno with
3735 let x0, y0
, x1
, y1
= pagebbox opaque
in
3736 let a,b = float x0, float y0
in
3737 let c,d = float x1
, float y0
in
3738 let e,f = float x1
, float y1
in
3739 let h,j
= float x0, float y1
in
3740 let rect = (a,b,c,d,e,f,h,j
) in
3742 state.rects
<- (l.pageno, l.pageno mod 3, rect) :: state.rects
;
3744 G.postRedisplay "v";
3747 vlog "huh? %d %c" key (Char.chr
key);
3750 let birdseyekeyboard key ((_, _, pageno, _, _) as beye
) =
3752 | 27 -> (* escape *)
3753 leavebirdseye beye
true
3755 | 12 -> (* ctrl-l *)
3756 let y, h = getpageyh pageno in
3757 let top = (conf.winh
- h) / 2 in
3758 gotoy (max
0 (y - top))
3761 leavebirdseye beye
false
3767 let keyboard ~
key ~
x ~
y =
3770 if key = 7 && not
(istextentry state.mode) (* ctrl-g *)
3771 then wcmd "interrupt" []
3772 else state.uioh <- state.uioh#
key key
3775 let birdseyespecial key ((conf, leftx
, _, hooverpageno
, anchor) as beye
) =
3777 | Glut.KEY_UP
-> upbirdseye beye
3778 | Glut.KEY_DOWN
-> downbirdseye beye
3780 | Glut.KEY_PAGE_UP
->
3781 begin match state.layout with
3785 state.mode <- Birdseye
(
3786 conf, leftx
, l.pageno, hooverpageno
, anchor
3788 gotopage1 l.pageno 0;
3791 let layout = layout (state.y-conf.winh
) conf.winh
in
3793 | [] -> gotoy (clamp (-conf.winh
))
3795 state.mode <- Birdseye
(
3796 conf, leftx
, l.pageno, hooverpageno
, anchor
3798 gotopage1 l.pageno 0
3801 | [] -> gotoy (clamp (-conf.winh
))
3804 | Glut.KEY_PAGE_DOWN
->
3805 begin match List.rev
state.layout with
3807 let layout = layout (state.y + conf.winh
) conf.winh
in
3808 begin match layout with
3810 let incr = l.pageh
- l.pagevh in
3815 conf, leftx
, state.pagecount
- 1, hooverpageno
, anchor
3817 G.postRedisplay "birdseye pagedown";
3819 else gotoy (clamp (incr + conf.interpagespace*2));
3823 Birdseye
(conf, leftx
, l.pageno, hooverpageno
, anchor);
3824 gotopage1 l.pageno 0;
3827 | [] -> gotoy (clamp conf.winh
)
3831 state.mode <- Birdseye
(conf, leftx
, 0, hooverpageno
, anchor);
3835 let pageno = state.pagecount
- 1 in
3836 state.mode <- Birdseye
(conf, leftx
, pageno, hooverpageno
, anchor);
3837 if not
(pagevisible state.layout pageno)
3840 match List.rev
state.pdims
with
3842 | (_, _, h, _) :: _ -> h
3844 gotoy (max
0 (getpagey pageno - (conf.winh
- h - conf.interpagespace)))
3845 else G.postRedisplay "birdseye end";
3849 let setautoscrollspeed step goingdown
=
3850 let incr = max
1 ((abs step
) / 2) in
3851 let incr = if goingdown
then incr else -incr in
3852 let astep = step
+ incr in
3853 state.autoscroll
<- Some
astep;
3856 let special ~
key ~
x ~
y =
3859 state.uioh <- state.uioh#
special key
3864 match state.mode with
3865 | Textentry
_ -> scalecolor 0.4
3866 | View
-> scalecolor 1.0
3867 | Birdseye
(_, _, pageno, hooverpageno
, _) ->
3868 if l.pageno = hooverpageno
3871 if l.pageno = pageno
3877 begin match getopaque l.pageno with
3879 if tileready l l.pagex l.pagey
3881 let x = l.pagedispx
- l.pagex
3882 and y = l.pagedispy
- l.pagey in
3883 postprocess opaque
conf.hlinks
x y;
3890 let maxy = state.maxy - (if conf.maxhfit
then conf.winh
else 0) in
3891 let sh = (float (maxy + conf.winh
) /. float conf.winh
) in
3892 let sh = float conf.winh
/. sh in
3893 let sh = max
sh (float conf.scrollh
) in
3898 else float y /. float maxy
3900 let position = (float conf.winh
-. sh) *. percent in
3903 if position +. sh > float conf.winh
3904 then float conf.winh
-. sh
3911 let winw = conf.winw - state.scrollw
- 1 in
3912 let fwinw = float winw in
3914 let sw = fwinw /. float state.w in
3915 let sw = fwinw *. sw in
3916 max
sw (float conf.scrollh
)
3919 let f = state.w+winw in
3920 let r = float (winw-x) /. float f in
3921 let p = fwinw *. r in
3925 if position +. sw > fwinw
3926 then fwinw -. position
3932 let scrollindicator () =
3933 GlDraw.color (0.64 , 0.64, 0.64);
3935 (float (conf.winw - state.scrollw
), 0.)
3936 (float conf.winw, float conf.winh
)
3939 (0., float (conf.winh
- state.hscrollh))
3940 (float (conf.winw - state.scrollw
- 1), float conf.winh
)
3942 GlDraw.color (0.0, 0.0, 0.0);
3944 let position, sh = scrollph state.y in
3946 (float (conf.winw - state.scrollw
), position)
3947 (float conf.winw, position +. sh)
3949 let position, sw = scrollpw state.x in
3951 (position, float (conf.winh
- state.hscrollh))
3952 (position +. sw, float conf.winh
)
3956 let pagetranslatepoint l x y =
3957 let dy = y - l.pagedispy
in
3958 let y = dy + l.pagey in
3959 let dx = x - l.pagedispx
in
3960 let x = dx + l.pagex in
3965 match state.mstate
with
3966 | Mnone
| Mscrolly
| Mscrollx
| Mpan
_ | Mzoom
_ | Mzoomrect
_ ->
3969 | Msel
((x0, y0
), (x1
, y1
)) ->
3970 let rec loop = function
3972 if (y0
>= l.pagedispy
&& y0
<= (l.pagedispy
+ l.pagevh))
3973 || ((y1
>= l.pagedispy
&& y1
<= (l.pagedispy
+ l.pagevh)))
3975 match getopaque l.pageno with
3977 let dx, dy = pagetranslatepoint l 0 0 in
3982 GlMat.mode `modelview
;
3984 GlMat.translate ~
x:(float ~
-dx) ~
y:(float ~
-dy) ();
3985 seltext opaque
(x0, y0
, x1
, y1
);
3996 GlDraw.color (0.0, 0.0, 1.0) ~alpha
:0.5;
3997 GlDraw.polygon_mode `both `fill
;
3998 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
4000 (fun (pageno, c, (x0, y0
, x1
, y1
, x2
, y2
, x3
, y3
)) ->
4002 if l.pageno = pageno
4004 let dx = float (l.pagedispx
- l.pagex) in
4005 let dy = float (l.pagedispy
- l.pagey) in
4006 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~alpha
:0.5;
4007 GlDraw.begins `quads
;
4009 GlDraw.vertex2
(x0+.dx, y0
+.dy);
4010 GlDraw.vertex2
(x1
+.dx, y1
+.dy);
4011 GlDraw.vertex2
(x2
+.dx, y2
+.dy);
4012 GlDraw.vertex2
(x3
+.dx, y3
+.dy);
4023 GlClear.color (scalecolor2 conf.bgcolor
);
4024 GlClear.clear
[`
color];
4025 List.iter
drawpage state.layout;
4030 begin match state.mstate
with
4031 | Mzoomrect
((x0, y0
), (x1
, y1
)) ->
4033 GlDraw.color (0.3, 0.3, 0.3) ~alpha
:0.5;
4034 GlDraw.polygon_mode `both `fill
;
4035 GlFunc.blend_func `src_alpha `one_minus_src_alpha
;
4036 GlDraw.rect (float x0, float y0
)
4037 (float x1
, float y1
);
4042 Glut.swapBuffers
();
4046 let rec f = function
4048 begin match getopaque l.pageno with
4050 let x0 = l.pagedispx
in
4051 let x1 = x0 + l.pagevw in
4052 let y0 = l.pagedispy
in
4053 let y1 = y0 + l.pagevh in
4054 if y >= y0 && y <= y1 && x >= x0 && x <= x1
4056 let px, py = pagetranslatepoint l x y in
4057 match whatsunder opaque
px py with
4069 let zoomrect x y x1 y1 =
4072 and y0 = min
y y1 in
4073 gotoy (state.y + y0);
4074 state.anchor <- getanchor ();
4075 let zoom = (float conf.winw *. conf.zoom) /. float (x1 - x0) in
4076 state.x <- state.x - x0;
4078 Glut.setCursor
Glut.CURSOR_INHERIT
;
4079 state.mstate
<- Mnone
;
4083 let winw = conf.winw - state.scrollw
- 1 in
4084 let s = float x /. float winw in
4085 let destx = truncate
(float (state.w + winw) *. s) in
4086 state.x <- winw - destx;
4087 gotoy_and_clear_text state.y;
4088 state.mstate
<- Mscrollx
;
4092 let s = float y /. float conf.winh
in
4093 let desty = truncate
(float (state.maxy - conf.winh
) *. s) in
4094 gotoy_and_clear_text desty;
4095 state.mstate
<- Mscrolly
;
4098 let viewmouse button bstate
x y =
4100 | Glut.OTHER_BUTTON
n when (n == 3 || n == 4) && bstate
= Glut.UP
->
4101 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4103 match state.mstate
with
4104 | Mzoom
(oldn
, i
) ->
4112 if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01
4114 if conf.zoom -. 0.1 < 0.1 then -0.01 else -0.1
4116 let zoom = conf.zoom -. incr in
4118 state.mstate
<- Mzoom
(n, 0);
4120 state.mstate
<- Mzoom
(n, i
+1);
4122 else state.mstate
<- Mzoom
(n, 0)
4124 | _ -> state.mstate
<- Mzoom
(n, 0)
4127 match state.autoscroll
with
4128 | Some step
-> setautoscrollspeed step
(n=4)
4132 then -conf.scrollstep
4133 else conf.scrollstep
4135 let incr = incr * 2 in
4136 let y = clamp incr in
4137 gotoy_and_clear_text y
4140 | Glut.LEFT_BUTTON
when Glut.getModifiers
() land Glut.active_ctrl
!= 0 ->
4141 if bstate
= Glut.DOWN
4143 Glut.setCursor
Glut.CURSOR_CROSSHAIR
;
4144 state.mstate
<- Mpan
(x, y)
4147 state.mstate
<- Mnone
4149 | Glut.RIGHT_BUTTON
->
4150 if bstate
= Glut.DOWN
4152 Glut.setCursor
Glut.CURSOR_CYCLE
;
4154 state.mstate
<- Mzoomrect
(p, p)
4157 match state.mstate
with
4158 | Mzoomrect
((x0, y0), _) -> zoomrect x0 y0 x y
4160 Glut.setCursor
Glut.CURSOR_INHERIT
;
4161 state.mstate
<- Mnone
4164 | Glut.LEFT_BUTTON
when x > conf.winw - state.scrollw
->
4165 if bstate
= Glut.DOWN
4167 let position, sh = scrollph state.y in
4168 if y > truncate
position && y < truncate
(position +. sh)
4169 then state.mstate
<- Mscrolly
4172 state.mstate
<- Mnone
4174 | Glut.LEFT_BUTTON
when y > conf.winh
- state.hscrollh ->
4175 if bstate
= Glut.DOWN
4177 let position, sw = scrollpw state.x in
4178 if x > truncate
position && x < truncate
(position +. sw)
4179 then state.mstate
<- Mscrollx
4182 state.mstate
<- Mnone
4184 | Glut.LEFT_BUTTON
->
4185 let dest = if bstate
= Glut.DOWN
then getunder x y else Unone
in
4186 begin match dest with
4187 | Ulinkgoto
(pageno, top) ->
4191 gotopage1 pageno top;
4197 | Unone
when bstate
= Glut.DOWN
->
4198 Glut.setCursor
Glut.CURSOR_CROSSHAIR
;
4199 state.mstate
<- Mpan
(x, y);
4201 | Unone
| Utext
_ ->
4202 if bstate
= Glut.DOWN
4204 if conf.angle
mod 360 = 0
4206 state.mstate
<- Msel
((x, y), (x, y));
4207 G.postRedisplay "mouse select";
4211 match state.mstate
with
4214 | Mzoom
_ | Mscrollx
| Mscrolly
->
4215 state.mstate
<- Mnone
4217 | Mzoomrect
((x0, y0), _) ->
4221 Glut.setCursor
Glut.CURSOR_INHERIT
;
4222 state.mstate
<- Mnone
4224 | Msel
((_, y0), (_, y1)) ->
4226 if (y0 >= l.pagedispy
&& y0 <= (l.pagedispy
+ l.pagevh))
4227 || ((y1 >= l.pagedispy
&& y1 <= (l.pagedispy
+ l.pagevh)))
4229 match getopaque l.pageno with
4234 List.iter
f state.layout;
4235 copysel
""; (* ugly *)
4236 Glut.setCursor
Glut.CURSOR_INHERIT
;
4237 state.mstate
<- Mnone
;
4244 let birdseyemouse button bstate
x y
4245 (conf, leftx
, _, hooverpageno
, anchor) =
4247 | Glut.LEFT_BUTTON
when bstate
= Glut.UP
->
4248 let margin = (conf.winw - (state.w + state.scrollw
)) / 2 in
4249 let rec loop = function
4252 if y > l.pagedispy
&& y < l.pagedispy
+ l.pagevh
4253 && x > margin && x < margin + l.pagew
4255 leavebirdseye (conf, leftx
, l.pageno, hooverpageno
, anchor) false;
4260 | Glut.OTHER_BUTTON
_ -> viewmouse button bstate
x y
4264 let mouse bstate button
x y =
4265 state.uioh <- state.uioh#button button bstate
x y;
4268 let mouse ~button ~
state ~
x ~
y = mouse state button
x y;;
4271 state.uioh <- state.uioh#
motion x y
4275 state.uioh <- state.uioh#
pmotion x y;
4282 begin match state.mode with
4283 | Textentry
textentry -> textentrykeyboard key textentry
4284 | Birdseye
birdseye -> birdseyekeyboard key birdseye
4285 | View
-> viewkeyboard key
4289 method special key =
4290 begin match state.mode with
4291 | View
| (Birdseye
_) when key = Glut.KEY_F9
->
4295 birdseyespecial key vals
4297 | View
when key = Glut.KEY_F1
->
4301 begin match state.autoscroll
with
4302 | Some step
when key = Glut.KEY_DOWN
|| key = Glut.KEY_UP
->
4303 setautoscrollspeed step
(key = Glut.KEY_DOWN
)
4308 | Glut.KEY_F3
-> search state.searchpattern
true; state.y
4310 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4312 if Glut.getModifiers
() land Glut.active_shift
!= 0
4313 then (setzoom state.prevzoom
; state.y)
4314 else clamp (-conf.winh
/2)
4315 else clamp (-conf.scrollstep
)
4317 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4319 if Glut.getModifiers
() land Glut.active_shift
!= 0
4320 then (setzoom state.prevzoom
; state.y)
4321 else clamp (conf.winh
/2)
4322 else clamp (conf.scrollstep
)
4323 | Glut.KEY_PAGE_UP
->
4324 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4326 match state.layout with
4328 | l :: _ -> state.y - l.pagey
4331 | Glut.KEY_PAGE_DOWN
->
4332 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4334 match List.rev
state.layout with
4336 | l :: _ -> getpagey l.pageno
4344 state.maxy - (if conf.maxhfit
then conf.winh
else 0)
4346 | (Glut.KEY_RIGHT
| Glut.KEY_LEFT
) when
4347 Glut.getModifiers
() land Glut.active_alt
!= 0 ->
4348 getnav (if key = Glut.KEY_LEFT
then 1 else -1)
4350 | Glut.KEY_RIGHT
when conf.zoom > 1.0 ->
4352 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4353 then (conf.winw / 2)
4356 state.x <- state.x - dx;
4358 | Glut.KEY_LEFT
when conf.zoom > 1.0 ->
4360 if Glut.getModifiers
() land Glut.active_ctrl
!= 0
4361 then (conf.winw / 2)
4364 state.x <- state.x + dx;
4369 gotoy_and_clear_text y
4372 | Textentry
te -> textentryspecial key te
4376 method button button bstate
x y =
4377 begin match state.mode with
4378 | View
-> viewmouse button bstate
x y
4379 | Birdseye beye
-> birdseyemouse button bstate
x y beye
4385 begin match state.mode with
4387 | View
| Birdseye
_ ->
4388 match state.mstate
with
4389 | Mzoom
_ | Mnone
-> ()
4394 state.mstate
<- Mpan
(x, y);
4395 if conf.zoom > 1.0 then state.x <- state.x + dx;
4397 gotoy_and_clear_text y
4400 state.mstate
<- Msel
(a, (x, y));
4401 G.postRedisplay "motion select";
4404 let y = min
conf.winh
(max
0 y) in
4408 let x = min
conf.winw (max
0 x) in
4411 | Mzoomrect
(p0
, _) ->
4412 state.mstate
<- Mzoomrect
(p0
, (x, y));
4413 G.postRedisplay "motion zoomrect";
4417 method pmotion x y =
4418 begin match state.mode with
4419 | Birdseye
(conf, leftx
, pageno, hooverpageno
, anchor) ->
4420 let margin = (conf.winw - (state.w + state.scrollw
)) / 2 in
4421 let rec loop = function
4423 if hooverpageno
!= -1
4425 state.mode <- Birdseye
(conf, leftx
, pageno, -1, anchor);
4426 G.postRedisplay "pmotion birdseye no hoover";
4429 if y > l.pagedispy
&& y < l.pagedispy
+ l.pagevh
4430 && x > margin && x < margin + l.pagew
4432 state.mode <- Birdseye
(conf, leftx
, pageno, l.pageno, anchor);
4433 G.postRedisplay "pmotion birdseye hoover";
4442 match state.mstate
with
4444 begin match getunder x y with
4445 | Unone
-> Glut.setCursor
Glut.CURSOR_INHERIT
4447 if conf.underinfo
then showtext 'u'
("ri: " ^
uri);
4448 Glut.setCursor
Glut.CURSOR_INFO
4449 | Ulinkgoto
(page
, _) ->
4451 then showtext '
p'
("age: " ^ string_of_int
(page
+1));
4452 Glut.setCursor
Glut.CURSOR_INFO
4454 if conf.underinfo
then showtext '
f'
("ont: " ^
s);
4455 Glut.setCursor
Glut.CURSOR_TEXT
4458 | Mpan
_ | Msel
_ | Mzoom
_ | Mscrolly
| Mscrollx
| Mzoomrect
_ ->
4463 method infochanged
_ = ()
4470 let fontpath = ref "";;
4471 let wmclasshack = ref false;;
4474 let l = String.length
s in
4475 let b = Buffer.create
l in
4483 | Pwindows
| Pmingw
-> Sys.getenv
"HOMEPATH"
4484 | _ -> Sys.getenv
"HOME"
4487 ("Can not determine home directory location: " ^
4488 Printexc.to_string exn
);
4492 let config_of c attrs
=
4496 | "scroll-bar-width" -> { c with scrollbw
= max
0 (int_of_string
v) }
4497 | "scroll-handle-height" -> { c with scrollh
= max
0 (int_of_string
v) }
4498 | "case-insensitive-search" -> { c with icase
= bool_of_string
v }
4499 | "preload" -> { c with preload = bool_of_string
v }
4500 | "page-bias" -> { c with pagebias
= int_of_string
v }
4501 | "scroll-step" -> { c with scrollstep
= max
1 (int_of_string
v) }
4502 | "auto-scroll-step" ->
4503 { c with autoscrollstep
= max
0 (int_of_string
v) }
4504 | "max-height-fit" -> { c with maxhfit
= bool_of_string
v }
4505 | "crop-hack" -> { c with crophack
= bool_of_string
v }
4508 match String.lowercase
v with
4509 | "true" -> Some infinity
4511 | f -> Some
(float_of_string
f)
4513 { c with maxwait
= mw}
4514 | "highlight-links" -> { c with hlinks
= bool_of_string
v }
4515 | "under-cursor-info" -> { c with underinfo
= bool_of_string
v }
4516 | "vertical-margin" ->
4517 { c with interpagespace = max
0 (int_of_string
v) }
4519 let zoom = float_of_string
v /. 100. in
4520 let zoom = max
zoom 0.0 in
4521 { c with zoom = zoom }
4522 | "presentation" -> { c with presentation = bool_of_string
v }
4523 | "rotation-angle" -> { c with angle
= int_of_string
v }
4524 | "width" -> { c with winw = max
20 (int_of_string
v) }
4525 | "height" -> { c with winh
= max
20 (int_of_string
v) }
4526 | "persistent-bookmarks" -> { c with savebmarks
= bool_of_string
v }
4527 | "proportional-display" -> { c with proportional
= bool_of_string
v }
4528 | "pixmap-cache-size" ->
4529 { c with memlimit
= max
2 (int_of_string_with_suffix v) }
4530 | "tex-count" -> { c with texcount
= max
1 (int_of_string
v) }
4531 | "slice-height" -> { c with sliceheight
= max
2 (int_of_string
v) }
4532 | "thumbnail-width" -> { c with thumbw
= max
2 (int_of_string
v) }
4533 | "persistent-location" -> { c with jumpback
= bool_of_string
v }
4534 | "background-color" -> { c with bgcolor
= color_of_string v }
4535 | "scrollbar-in-presentation" ->
4536 { c with scrollbarinpm
= bool_of_string
v }
4537 | "tile-width" -> { c with tilew
= max
2 (int_of_string
v) }
4538 | "tile-height" -> { c with tileh
= max
2 (int_of_string
v) }
4540 { c with mumemlimit
= max
1024 (int_of_string_with_suffix v) }
4541 | "checkers" -> { c with checkers
= bool_of_string
v }
4542 | "aalevel" -> { c with aalevel
= max
0 (int_of_string
v) }
4543 | "trim-margins" -> { c with trimmargins
= bool_of_string
v }
4544 | "trim-fuzz" -> { c with trimfuzz
= irect_of_string v }
4545 | "wmclass-hack" -> wmclasshack := bool_of_string
v; c
4546 | "uri-launcher" -> { c with urilauncher
= unent v }
4547 | "color-space" -> { c with colorspace
= colorspace_of_string v }
4548 | "invert-colors" -> { c with invert
= bool_of_string
v }
4551 prerr_endline
("Error processing attribute (`" ^
4552 k ^
"'=`" ^
v ^
"'): " ^
Printexc.to_string exn
);
4555 let rec fold c = function
4558 let c = apply c k
v in
4564 let fromstring f pos
n v d =
4567 dolog "Error processing attribute (%S=%S) at %d\n%s"
4568 n v pos
(Printexc.to_string exn
)
4573 let bookmark_of attrs
=
4574 let rec fold title page rely
= function
4575 | ("title", v) :: rest
-> fold v page rely rest
4576 | ("page", v) :: rest
-> fold title v rely rest
4577 | ("rely", v) :: rest
-> fold title page
v rest
4578 | _ :: rest
-> fold title page rely rest
4579 | [] -> title, page
, rely
4581 fold "invalid" "0" "0" attrs
4585 let rec fold path page rely pan
= function
4586 | ("path", v) :: rest
-> fold v page rely pan rest
4587 | ("page", v) :: rest
-> fold path
v rely pan rest
4588 | ("rely", v) :: rest
-> fold path page
v pan rest
4589 | ("pan", v) :: rest
-> fold path page rely
v rest
4590 | _ :: rest
-> fold path page rely pan rest
4591 | [] -> path
, page
, rely
, pan
4593 fold "" "0" "0" "0" attrs
4596 let setconf dst
src =
4597 dst
.scrollbw
<- src.scrollbw
;
4598 dst
.scrollh
<- src.scrollh
;
4599 dst
.icase
<- src.icase
;
4600 dst
.preload <- src.preload;
4601 dst
.pagebias
<- src.pagebias
;
4602 dst
.verbose
<- src.verbose
;
4603 dst
.scrollstep
<- src.scrollstep
;
4604 dst
.maxhfit
<- src.maxhfit
;
4605 dst
.crophack
<- src.crophack
;
4606 dst
.autoscrollstep
<- src.autoscrollstep
;
4607 dst
.maxwait
<- src.maxwait
;
4608 dst
.hlinks
<- src.hlinks
;
4609 dst
.underinfo
<- src.underinfo
;
4610 dst
.interpagespace <- src.interpagespace;
4611 dst
.zoom <- src.zoom;
4612 dst
.presentation <- src.presentation;
4613 dst
.angle
<- src.angle
;
4614 dst
.winw <- src.winw;
4615 dst
.winh
<- src.winh
;
4616 dst
.savebmarks
<- src.savebmarks
;
4617 dst
.memlimit
<- src.memlimit
;
4618 dst
.proportional
<- src.proportional
;
4619 dst
.texcount
<- src.texcount
;
4620 dst
.sliceheight
<- src.sliceheight
;
4621 dst
.thumbw
<- src.thumbw
;
4622 dst
.jumpback
<- src.jumpback
;
4623 dst
.bgcolor
<- src.bgcolor
;
4624 dst
.scrollbarinpm
<- src.scrollbarinpm
;
4625 dst
.tilew
<- src.tilew
;
4626 dst
.tileh
<- src.tileh
;
4627 dst
.mumemlimit
<- src.mumemlimit
;
4628 dst
.checkers
<- src.checkers
;
4629 dst
.aalevel
<- src.aalevel
;
4630 dst
.trimmargins
<- src.trimmargins
;
4631 dst
.trimfuzz
<- src.trimfuzz
;
4632 dst
.urilauncher
<- src.urilauncher
;
4633 dst
.colorspace
<- src.colorspace
;
4634 dst
.invert
<- src.invert
;
4638 let h = Hashtbl.create
10 in
4639 let dc = { defconf with angle
= defconf.angle
} in
4640 let rec toplevel v t spos
_ =
4642 | Vdata
| Vcdata
| Vend
-> v
4643 | Vopen
("llppconfig", _, closed
) ->
4646 else { v with f = llppconfig
}
4648 error
"unexpected subelement at top level" s spos
4649 | Vclose
_ -> error
"unexpected close at top level" s spos
4651 and llppconfig
v t spos
_ =
4653 | Vdata
| Vcdata
-> v
4654 | Vend
-> error
"unexpected end of input in llppconfig" s spos
4655 | Vopen
("defaults", attrs
, closed
) ->
4656 let c = config_of dc attrs
in
4660 else { v with f = skip
"defaults" (fun () -> v) }
4662 | Vopen
("ui-font", attrs
, closed
) ->
4663 let rec getsize size
= function
4665 | ("size", v) :: rest
->
4667 fromstring int_of_string spos
"size" v !uifontsize in
4669 | l -> getsize size l
4671 uifontsize := getsize !uifontsize attrs
;
4674 else { v with f = uifont
(Buffer.create
10) }
4676 | Vopen
("doc", attrs
, closed
) ->
4677 let pathent, spage
, srely
, span
= doc_of attrs
in
4678 let path = unent pathent
4679 and pageno = fromstring int_of_string spos
"page" spage
0
4680 and rely
= fromstring float_of_string spos
"rely" srely
0.0
4681 and pan
= fromstring int_of_string spos
"pan" span
0 in
4682 let c = config_of dc attrs
in
4683 let anchor = (pageno, rely
) in
4685 then (Hashtbl.add
h path (c, [], pan
, anchor); v)
4686 else { v with f = doc
path pan
anchor c [] }
4689 error
"unexpected subelement in llppconfig" s spos
4691 | Vclose
"llppconfig" -> { v with f = toplevel }
4692 | Vclose
_ -> error
"unexpected close in llppconfig" s spos
4694 and uifont
b v t spos epos
=
4697 Buffer.add_substring
b s spos
(epos
- spos
);
4699 | Vopen
(_, _, _) ->
4700 error
"unexpected subelement in ui-font" s spos
4701 | Vclose
"ui-font" ->
4702 if String.length
!fontpath = 0
4703 then fontpath := Buffer.contents
b;
4704 { v with f = llppconfig
}
4705 | Vclose
_ -> error
"unexpected close in ui-font" s spos
4706 | Vend
-> error
"unexpected end of input in ui-font" s spos
4708 and doc
path pan
anchor c bookmarks
v t spos
_ =
4710 | Vdata
| Vcdata
-> v
4711 | Vend
-> error
"unexpected end of input in doc" s spos
4712 | Vopen
("bookmarks", _, closed
) ->
4715 else { v with f = pbookmarks
path pan
anchor c bookmarks
}
4717 | Vopen
(_, _, _) ->
4718 error
"unexpected subelement in doc" s spos
4721 Hashtbl.add
h path (c, List.rev bookmarks
, pan
, anchor);
4722 { v with f = llppconfig
}
4724 | Vclose
_ -> error
"unexpected close in doc" s spos
4726 and pbookmarks
path pan
anchor c bookmarks
v t spos
_ =
4728 | Vdata
| Vcdata
-> v
4729 | Vend
-> error
"unexpected end of input in bookmarks" s spos
4730 | Vopen
("item", attrs
, closed
) ->
4731 let titleent, spage
, srely
= bookmark_of attrs
in
4732 let page = fromstring int_of_string spos
"page" spage
0
4733 and rely
= fromstring float_of_string spos
"rely" srely
0.0 in
4734 let bookmarks = (unent titleent, 0, (page, rely
)) :: bookmarks in
4736 then { v with f = pbookmarks
path pan
anchor c bookmarks }
4739 { v with f = skip
"item" f }
4742 error
"unexpected subelement in bookmarks" s spos
4744 | Vclose
"bookmarks" ->
4745 { v with f = doc
path pan
anchor c bookmarks }
4747 | Vclose
_ -> error
"unexpected close in bookmarks" s spos
4749 and skip tag
f v t spos
_ =
4751 | Vdata
| Vcdata
-> v
4753 error
("unexpected end of input in skipped " ^ tag
) s spos
4754 | Vopen
(tag'
, _, closed
) ->
4758 let f'
() = { v with f = skip tag
f } in
4759 { v with f = skip tag'
f'
}
4763 else error
("unexpected close in skipped " ^ tag
) s spos
4766 parse
{ f = toplevel; accu = () } s;
4772 let len = in_channel_length ic
in
4773 let s = String.create
len in
4774 really_input ic
s 0 len;
4777 | Parse_error
(msg
, s, pos
) ->
4778 let subs = subs s pos
in
4779 let s = Printf.sprintf
"%s: at %d [..%s..]" msg pos
subs in
4780 failwith
("parse error: " ^
s)
4783 failwith
("config load error: " ^
Printexc.to_string exn
)
4789 let dir = Filename.concat
home ".config" in
4790 if Sys.is_directory
dir then dir else home
4793 Filename.concat
dir "llpp.conf"
4796 let confpath = ref defconfpath;;
4799 if Sys.file_exists
!confpath
4802 (try Some
(open_in_bin
!confpath)
4805 ("Error opening configuation file `" ^
!confpath ^
"': " ^
4806 Printexc.to_string exn
);
4815 ("Error loading configuation from `" ^
!confpath ^
"': " ^
4816 Printexc.to_string exn
);
4822 f (Hashtbl.create
0, defconf)
4827 let pc, pb
, px, pa
=
4829 Hashtbl.find h (Filename.basename
state.path)
4830 with Not_found
-> dc, [], 0, (0, 0.0)
4834 state.bookmarks <- pb
;
4836 state.scrollw
<- conf.scrollbw
;
4838 then state.anchor <- pa
;
4839 cbput state.hists
.nav pa
;
4844 let add_attrs bb always
dc c =
4847 then Printf.bprintf bb
"\n %s='%b'" s a
4850 then Printf.bprintf bb
"\n %s='%d'" s a
4853 then Printf.bprintf bb
"\n %s='%s'" s (string_with_suffix_of_int a)
4856 then Printf.bprintf bb
"\n %s='%d'" s (truncate
(a*.100.))
4860 Printf.bprintf bb
"\n %s='%s'" s (color_to_string a)
4864 Printf.bprintf bb
"\n %s='%s'" s (colorspace_to_string a)
4868 Printf.bprintf bb
"\n %s='%s'" s (irect_to_string a)
4872 Printf.bprintf bb
"\n %s='%s'" s (enent
a 0 (String.length
a))
4882 else string_of_float
f
4884 Printf.bprintf bb
"\n %s='%s'" s v
4888 then dc.winw, dc.winh
4890 match state.fullscreen
with
4892 | None
-> c.winw, c.winh
4894 let zoom, presentation, interpagespace, maxwait
=
4896 then dc.zoom, dc.presentation, dc.interpagespace, dc.maxwait
4898 match state.mode with
4899 | Birdseye
(bc
, _, _, _, _) ->
4900 bc
.zoom, bc
.presentation, bc
.interpagespace, bc
.maxwait
4901 | _ -> c.zoom, c.presentation, c.interpagespace, c.maxwait
4903 oi
"width" w dc.winw;
4904 oi
"height" h dc.winh
;
4905 oi
"scroll-bar-width" c.scrollbw
dc.scrollbw
;
4906 oi
"scroll-handle-height" c.scrollh
dc.scrollh
;
4907 ob "case-insensitive-search" c.icase
dc.icase
;
4908 ob "preload" c.preload dc.preload;
4909 oi
"page-bias" c.pagebias
dc.pagebias
;
4910 oi
"scroll-step" c.scrollstep
dc.scrollstep
;
4911 oi
"auto-scroll-step" c.autoscrollstep
dc.autoscrollstep
;
4912 ob "max-height-fit" c.maxhfit
dc.maxhfit
;
4913 ob "crop-hack" c.crophack
dc.crophack
;
4914 oW
"throttle" maxwait
dc.maxwait
;
4915 ob "highlight-links" c.hlinks
dc.hlinks
;
4916 ob "under-cursor-info" c.underinfo
dc.underinfo
;
4917 oi
"vertical-margin" interpagespace dc.interpagespace;
4918 oz
"zoom" zoom dc.zoom;
4919 ob "presentation" presentation dc.presentation;
4920 oi
"rotation-angle" c.angle
dc.angle
;
4921 ob "persistent-bookmarks" c.savebmarks
dc.savebmarks
;
4922 ob "proportional-display" c.proportional
dc.proportional
;
4923 oI
"pixmap-cache-size" c.memlimit
dc.memlimit
;
4924 oi
"tex-count" c.texcount
dc.texcount
;
4925 oi
"slice-height" c.sliceheight
dc.sliceheight
;
4926 oi
"thumbnail-width" c.thumbw
dc.thumbw
;
4927 ob "persistent-location" c.jumpback
dc.jumpback
;
4928 oc
"background-color" c.bgcolor
dc.bgcolor
;
4929 ob "scrollbar-in-presentation" c.scrollbarinpm
dc.scrollbarinpm
;
4930 oi
"tile-width" c.tilew
dc.tilew
;
4931 oi
"tile-height" c.tileh
dc.tileh
;
4932 oI
"mupdf-memlimit" c.mumemlimit
dc.mumemlimit
;
4933 ob "checkers" c.checkers
dc.checkers
;
4934 oi
"aalevel" c.aalevel
dc.aalevel
;
4935 ob "trim-margins" c.trimmargins
dc.trimmargins
;
4936 oR
"trim-fuzz" c.trimfuzz
dc.trimfuzz
;
4937 os
"uri-launcher" c.urilauncher
dc.urilauncher
;
4938 oC
"color-space" c.colorspace
dc.colorspace
;
4939 ob "invert-colors" c.invert
dc.invert
;
4941 then ob "wmclass-hack" !wmclasshack false;
4945 let uifontsize = !uifontsize in
4946 let bb = Buffer.create
32768 in
4948 let dc = if conf.bedefault
then conf else dc in
4949 Buffer.add_string
bb "<llppconfig>\n";
4951 if String.length
!fontpath > 0
4953 Printf.bprintf
bb "<ui-font size='%d'><![CDATA[%s]]></ui-font>\n"
4959 Printf.bprintf
bb "<ui-font size='%d'/>\n" uifontsize
4962 Buffer.add_string
bb "<defaults ";
4963 add_attrs bb true dc dc;
4964 Buffer.add_string
bb "/>\n";
4966 let adddoc path pan
anchor c bookmarks =
4967 if bookmarks == [] && c = dc && anchor = emptyanchor
4970 Printf.bprintf
bb "<doc path='%s'"
4971 (enent
path 0 (String.length
path));
4973 if anchor <> emptyanchor
4975 let n, y = anchor in
4976 Printf.bprintf
bb " page='%d'" n;
4979 Printf.bprintf
bb " rely='%f'" y
4984 then Printf.bprintf
bb " pan='%d'" pan
;
4986 add_attrs bb false dc c;
4988 begin match bookmarks with
4989 | [] -> Buffer.add_string
bb "/>\n"
4991 Buffer.add_string
bb ">\n<bookmarks>\n";
4992 List.iter
(fun (title, _level
, (page, rely
)) ->
4994 "<item title='%s' page='%d'"
4995 (enent
title 0 (String.length
title))
5000 Printf.bprintf
bb " rely='%f'" rely
5002 Buffer.add_string
bb "/>\n";
5004 Buffer.add_string
bb "</bookmarks>\n</doc>\n";
5010 match state.mode with
5011 | Birdseye
(_, pan, _, _, _) -> pan
5014 let basename = Filename.basename state.path in
5015 adddoc basename pan (getanchor ())
5018 match state.autoscroll
with
5020 | None
-> conf.autoscrollstep
}
5021 (if conf.savebmarks
then state.bookmarks else []);
5023 Hashtbl.iter
(fun path (c, bookmarks, x, y) ->
5025 then adddoc path x y c bookmarks
5027 Buffer.add_string
bb "</llppconfig>";
5030 if Buffer.length
bb > 0
5033 let tmp = !confpath ^
".tmp" in
5034 let oc = open_out_bin
tmp in
5035 Buffer.output_buffer
oc bb;
5037 Unix.rename
tmp !confpath;
5040 ("error while saving configuration: " ^
Printexc.to_string exn
)
5047 [("-p", Arg.String
(fun s -> state.password
<- s) ,
5048 "<password> Set password");
5050 ("-f", Arg.String
(fun s -> Config.fontpath := s),
5051 "<path> Set path to the user interface font");
5053 ("-c", Arg.String
(fun s -> Config.confpath := s),
5054 "<path> Set path to the configuration file");
5056 ("-v", Arg.Unit
(fun () ->
5058 "%s\nconfiguration path: %s\n"
5062 exit
0), " Print version and exit");
5065 (fun s -> state.path <- s)
5066 ("Usage: " ^
Sys.argv
.(0) ^
" [options] some.pdf\nOptions:")
5068 if String.length
state.path = 0
5069 then (prerr_endline
"file name missing"; exit
1);
5073 let _ = Glut.init
Sys.argv
in
5074 let () = Glut.initDisplayMode ~depth
:false ~double_buffer
:true () in
5075 let () = Glut.initWindowSize
conf.winw conf.winh
in
5076 let _ = Glut.createWindow
("llpp " ^
Filename.basename state.path) in
5078 if not
(Glut.extensionSupported
"GL_ARB_texture_rectangle"
5079 || Glut.extensionSupported
"GL_EXT_texture_rectangle")
5080 then (prerr_endline
"OpenGL does not suppport rectangular textures"; exit
1);
5085 Unix.socketpair
Unix.PF_UNIX
Unix.SOCK_STREAM
0
5087 let addr = Unix.ADDR_INET
(Unix.inet_addr_loopback
, 1337) in
5088 let sock = Unix.socket
Unix.PF_INET
Unix.SOCK_STREAM
0 in
5089 Unix.setsockopt
sock Unix.SO_REUSEADDR
true;
5090 Unix.bind
sock addr;
5092 let csock = Unix.socket
Unix.PF_INET
Unix.SOCK_STREAM
0 in
5093 Unix.connect
csock addr;
5094 let ssock, _ = Unix.accept
sock in
5097 Unix.setsockopt
sock Unix.TCP_NODELAY
true;
5098 Unix.setsockopt_optint
sock Unix.SO_LINGER None
;
5105 let () = Glut.displayFunc
display in
5106 let () = Glut.reshapeFunc
reshape in
5107 let () = Glut.keyboardFunc
keyboard in
5108 let () = Glut.specialFunc
special in
5109 let () = Glut.idleFunc
(Some
idle) in
5110 let () = Glut.mouseFunc
mouse in
5111 let () = Glut.motionFunc
motion in
5112 let () = Glut.passiveMotionFunc
pmotion in
5114 setcheckers conf.checkers
;
5116 conf.angle
, conf.proportional
, (conf.trimmargins
, conf.trimfuzz
),
5117 conf.texcount
, conf.sliceheight
, conf.mumemlimit
, conf.colorspace
,
5118 !Config.wmclasshack, !Config.fontpath
5120 wwidth := measurestr
!uifontsize "w";
5121 state.csock <- csock;
5122 state.ssock <- ssock;
5123 state.text <- "Opening " ^
state.path;
5124 setaalevel
conf.aalevel
;
5125 writeopen state.path state.password
;
5132 | Glut.BadEnum
"key in special_of_int" ->
5133 showtext '
!'
" LablGlut bug: special key not recognized";