More intuitive Ctrl-left/right behavior in outline/info mode
[llpp.git] / main.ml
bloba2356f3f38f00847b0acc715d14524ab07492004
1 type under =
2 | Unone
3 | Ulinkuri of string
4 | Ulinkgoto of (int * int)
5 | Utext of facename
6 and facename = string;;
8 let dolog fmt = Printf.kprintf prerr_endline fmt;;
10 type params = angle * proportional * texcount * sliceheight
11 and pageno = int
12 and width = int
13 and height = int
14 and leftx = int
15 and opaque = string
16 and recttype = int
17 and pixmapsize = int
18 and angle = int
19 and proportional = bool
20 and interpagespace = int
21 and texcount = int
22 and sliceheight = int
23 and gen = int
24 and top = float
27 external init : Unix.file_descr -> params -> unit = "ml_init";;
28 external draw : (int * int * int * int * bool) -> string -> unit = "ml_draw";;
29 external seltext : string -> (int * int * int * int) -> int -> unit =
30 "ml_seltext";;
31 external copysel : string -> unit = "ml_copysel";;
32 external getpdimrect : int -> float array = "ml_getpdimrect";;
33 external whatsunder : string -> int -> int -> under = "ml_whatsunder";;
34 external zoomforh : int -> int -> int -> float = "ml_zoom_for_height";;
36 type mpos = int * int
37 and mstate =
38 | Msel of (mpos * mpos)
39 | Mpan of mpos
40 | Mscroll
41 | Mzoom of (int * int)
42 | Mnone
45 type textentry = string * string * onhist * onkey * ondone
46 and onkey = string -> int -> te
47 and ondone = string -> unit
48 and histcancel = unit -> unit
49 and onhist = ((histcmd -> string) * histcancel) option
50 and histcmd = HCnext | HCprev | HCfirst | HClast
51 and te =
52 | TEstop
53 | TEdone of string
54 | TEcont of string
55 | TEswitch of textentry
58 type 'a circbuf =
59 { store : 'a array
60 ; mutable rc : int
61 ; mutable wc : int
62 ; mutable len : int
66 let cbnew n v =
67 { store = Array.create n v
68 ; rc = 0
69 ; wc = 0
70 ; len = 0
74 let cbcap b = Array.length b.store;;
76 let cbput b v =
77 let cap = cbcap b in
78 b.store.(b.wc) <- v;
79 b.wc <- (b.wc + 1) mod cap;
80 b.rc <- b.wc;
81 b.len <- min (b.len + 1) cap;
84 let cbempty b = b.len = 0;;
86 let cbgetg b circular dir =
87 if cbempty b
88 then b.store.(0)
89 else
90 let rc = b.rc + dir in
91 let rc =
92 if circular
93 then (
94 if rc = -1
95 then b.len-1
96 else (
97 if rc = b.len
98 then 0
99 else rc
102 else max 0 (min rc (b.len-1))
104 b.rc <- rc;
105 b.store.(rc);
108 let cbget b = cbgetg b false;;
109 let cbgetc b = cbgetg b true;;
111 let cbpeek b =
112 let rc = b.wc - b.len in
113 let rc = if rc < 0 then cbcap b + rc else rc in
114 b.store.(rc);
117 let cbdecr b = b.len <- b.len - 1;;
119 type layout =
120 { pageno : int
121 ; pagedimno : int
122 ; pagew : int
123 ; pageh : int
124 ; pagedispy : int
125 ; pagey : int
126 ; pagevh : int
127 ; pagex : int
131 type conf =
132 { mutable scrollw : int
133 ; mutable scrollh : int
134 ; mutable icase : bool
135 ; mutable preload : bool
136 ; mutable pagebias : int
137 ; mutable verbose : bool
138 ; mutable scrollstep : int
139 ; mutable maxhfit : bool
140 ; mutable crophack : bool
141 ; mutable autoscrollstep : int
142 ; mutable showall : bool
143 ; mutable hlinks : bool
144 ; mutable underinfo : bool
145 ; mutable interpagespace : interpagespace
146 ; mutable zoom : float
147 ; mutable presentation : bool
148 ; mutable angle : angle
149 ; mutable winw : int
150 ; mutable winh : int
151 ; mutable savebmarks : bool
152 ; mutable proportional : proportional
153 ; mutable memlimit : int
154 ; mutable texcount : texcount
155 ; mutable sliceheight : sliceheight
156 ; mutable thumbw : width
157 ; mutable jumpback : bool
158 ; mutable bgcolor : float * float * float
162 type outline = string * int * int * float;;
163 type outlines =
164 | Oarray of outline array
165 | Olist of outline list
166 | Onarrow of string * outline array * outline array
169 type rect = float * float * float * float * float * float * float * float;;
171 type pagemapkey = pageno * width * angle * proportional * gen;;
173 type anchor = pageno * top;;
175 let emptyanchor = (0, 0.0);;
176 let initialanchor = (-1, nan);;
178 type mode =
179 | Birdseye of (conf * leftx * pageno * pageno * anchor)
180 | Outline of (bool * int * int * outline array * string * int * mode)
181 | Items of (int * int * item array * string * int * mode)
182 | Textentry of (textentry * onleave)
183 | View
184 and onleave = leavetextentrystatus -> unit
185 and leavetextentrystatus = | Cancel | Confirm
186 and item = string * int * action
187 and action =
188 | Noaction
189 | Action of (int -> int -> string -> int -> mode)
192 let isbirdseye = function Birdseye _ -> true | _ -> false;;
193 let istextentry = function Textentry _ -> true | _ -> false;;
195 type state =
196 { mutable csock : Unix.file_descr
197 ; mutable ssock : Unix.file_descr
198 ; mutable w : int
199 ; mutable x : int
200 ; mutable y : int
201 ; mutable anchor : anchor
202 ; mutable maxy : int
203 ; mutable layout : layout list
204 ; pagemap : (pagemapkey, (opaque * pixmapsize)) Hashtbl.t
205 ; mutable pdims : (pageno * width * height * leftx) list
206 ; mutable pagecount : int
207 ; pagecache : string circbuf
208 ; mutable rendering : bool
209 ; mutable mstate : mstate
210 ; mutable searchpattern : string
211 ; mutable rects : (pageno * recttype * rect) list
212 ; mutable rects1 : (pageno * recttype * rect) list
213 ; mutable text : string
214 ; mutable fullscreen : (width * height) option
215 ; mutable mode : mode
216 ; mutable outlines : outlines
217 ; mutable bookmarks : outline list
218 ; mutable path : string
219 ; mutable password : string
220 ; mutable invalidated : int
221 ; mutable colorscale : float
222 ; mutable memused : int
223 ; mutable gen : gen
224 ; mutable throttle : layout list option
225 ; mutable ascrollstep : int
226 ; mutable help : item array
227 ; mutable docinfo : (int * string) list
228 ; hists : hists
230 and hists =
231 { pat : string circbuf
232 ; pag : string circbuf
233 ; nav : anchor circbuf
237 let defconf =
238 { scrollw = 7
239 ; scrollh = 12
240 ; icase = true
241 ; preload = true
242 ; pagebias = 0
243 ; verbose = false
244 ; scrollstep = 24
245 ; maxhfit = true
246 ; crophack = false
247 ; autoscrollstep = 24
248 ; showall = false
249 ; hlinks = false
250 ; underinfo = false
251 ; interpagespace = 2
252 ; zoom = 1.0
253 ; presentation = false
254 ; angle = 0
255 ; winw = 900
256 ; winh = 900
257 ; savebmarks = true
258 ; proportional = true
259 ; memlimit = 32*1024*1024
260 ; texcount = 256
261 ; sliceheight = 24
262 ; thumbw = 76
263 ; jumpback = false
264 ; bgcolor = (0.5, 0.5, 0.5)
268 let conf = { defconf with angle = defconf.angle };;
270 let makehelp () =
271 let strings = ("llpp version " ^ Help.version) :: "" :: Help.keys in
272 Array.of_list (List.map (fun s -> s, 0, Noaction) strings);
275 let state =
276 { csock = Unix.stdin
277 ; ssock = Unix.stdin
278 ; x = 0
279 ; y = 0
280 ; anchor = initialanchor
281 ; w = 0
282 ; layout = []
283 ; maxy = max_int
284 ; pagemap = Hashtbl.create 10
285 ; pagecache = cbnew 100 ""
286 ; pdims = []
287 ; pagecount = 0
288 ; rendering = false
289 ; mstate = Mnone
290 ; rects = []
291 ; rects1 = []
292 ; text = ""
293 ; mode = View
294 ; fullscreen = None
295 ; searchpattern = ""
296 ; outlines = Olist []
297 ; bookmarks = []
298 ; path = ""
299 ; password = ""
300 ; invalidated = 0
301 ; hists =
302 { nav = cbnew 100 (0, 0.0)
303 ; pat = cbnew 20 ""
304 ; pag = cbnew 10 ""
306 ; colorscale = 1.0
307 ; memused = 0
308 ; gen = 0
309 ; throttle = None
310 ; ascrollstep = 0
311 ; help = makehelp ()
312 ; docinfo = []
316 let vlog fmt =
317 if conf.verbose
318 then
319 Printf.kprintf prerr_endline fmt
320 else
321 Printf.kprintf ignore fmt
324 let writecmd fd s =
325 let len = String.length s in
326 let n = 4 + len in
327 let b = Buffer.create n in
328 Buffer.add_char b (Char.chr ((len lsr 24) land 0xff));
329 Buffer.add_char b (Char.chr ((len lsr 16) land 0xff));
330 Buffer.add_char b (Char.chr ((len lsr 8) land 0xff));
331 Buffer.add_char b (Char.chr ((len lsr 0) land 0xff));
332 Buffer.add_string b s;
333 let s' = Buffer.contents b in
334 let n' = Unix.write fd s' 0 n in
335 if n' != n then failwith "write failed";
338 let readcmd fd =
339 let s = "xxxx" in
340 let n = Unix.read fd s 0 4 in
341 if n != 4 then failwith "incomplete read(len)";
342 let len = 0
343 lor (Char.code s.[0] lsl 24)
344 lor (Char.code s.[1] lsl 16)
345 lor (Char.code s.[2] lsl 8)
346 lor (Char.code s.[3] lsl 0)
348 let s = String.create len in
349 let n = Unix.read fd s 0 len in
350 if n != len then failwith "incomplete read(data)";
354 let makecmd s l =
355 let b = Buffer.create 10 in
356 Buffer.add_string b s;
357 let rec combine = function
358 | [] -> b
359 | x :: xs ->
360 Buffer.add_char b ' ';
361 let s =
362 match x with
363 | `b b -> if b then "1" else "0"
364 | `s s -> s
365 | `i i -> string_of_int i
366 | `f f -> string_of_float f
367 | `I f -> string_of_int (truncate f)
369 Buffer.add_string b s;
370 combine xs;
372 combine l;
375 let wcmd s l =
376 let cmd = Buffer.contents (makecmd s l) in
377 writecmd state.csock cmd;
380 let calcips h =
381 if conf.presentation
382 then
383 let d = conf.winh - h in
384 max 0 ((d + 1) / 2)
385 else
386 conf.interpagespace
389 let calcheight () =
390 let rec f pn ph pi fh l =
391 match l with
392 | (n, _, h, _) :: rest ->
393 let ips = calcips h in
394 let fh =
395 if conf.presentation
396 then fh+ips
397 else (
398 if isbirdseye state.mode && pn = 0
399 then fh + ips
400 else fh
403 let fh = fh + ((n - pn) * (ph + pi)) in
404 f n h ips fh rest;
406 | [] ->
407 let inc =
408 if conf.presentation || (isbirdseye state.mode && pn = 0)
409 then 0
410 else -pi
412 let fh = fh + ((state.pagecount - pn) * (ph + pi)) + inc in
413 max 0 fh
415 let fh = f 0 0 0 0 state.pdims in
419 let getpageyh pageno =
420 let rec f pn ph pi y l =
421 match l with
422 | (n, _, h, _) :: rest ->
423 let ips = calcips h in
424 if n >= pageno
425 then
426 let h = if n = pageno then h else ph in
427 if conf.presentation && n = pageno
428 then
429 y + (pageno - pn) * (ph + pi) + pi, h
430 else
431 y + (pageno - pn) * (ph + pi), h
432 else
433 let y = y + (if conf.presentation then pi else 0) in
434 let y = y + (n - pn) * (ph + pi) in
435 f n h ips y rest
437 | [] ->
438 y + (pageno - pn) * (ph + pi), ph
440 f 0 0 0 0 state.pdims
443 let getpagey pageno = fst (getpageyh pageno);;
445 let layout y sh =
446 let rec f ~pageno ~pdimno ~prev ~py ~dy ~pdims ~cacheleft ~accu =
447 let ((w, h, ips, x) as curr), rest, pdimno, yinc =
448 match pdims with
449 | (pageno', w, h, x) :: rest when pageno' = pageno ->
450 let ips = calcips h in
451 let yinc =
452 if conf.presentation || (isbirdseye state.mode && pageno = 0)
453 then ips
454 else 0
456 (w, h, ips, x), rest, pdimno + 1, yinc
457 | _ ->
458 prev, pdims, pdimno, 0
460 let dy = dy + yinc in
461 let py = py + yinc in
462 if pageno = state.pagecount || cacheleft = 0 || dy >= sh
463 then
464 accu
465 else
466 let vy = y + dy in
467 if py + h <= vy - yinc
468 then
469 let py = py + h + ips in
470 let dy = max 0 (py - y) in
471 f ~pageno:(pageno+1)
472 ~pdimno
473 ~prev:curr
476 ~pdims:rest
477 ~cacheleft
478 ~accu
479 else
480 let pagey = vy - py in
481 let pagevh = h - pagey in
482 let pagevh = min (sh - dy) pagevh in
483 let off = if yinc > 0 then py - vy else 0 in
484 let py = py + h + ips in
485 let e =
486 { pageno = pageno
487 ; pagedimno = pdimno
488 ; pagew = w
489 ; pageh = h
490 ; pagedispy = dy + off
491 ; pagey = pagey + off
492 ; pagevh = pagevh - off
493 ; pagex = x
496 let accu = e :: accu in
497 f ~pageno:(pageno+1)
498 ~pdimno
499 ~prev:curr
501 ~dy:(dy+pagevh+ips)
502 ~pdims:rest
503 ~cacheleft:(cacheleft-1)
504 ~accu
506 if state.invalidated = 0
507 then (
508 let accu =
510 ~pageno:0
511 ~pdimno:~-1
512 ~prev:(0,0,0,0)
513 ~py:0
514 ~dy:0
515 ~pdims:state.pdims
516 ~cacheleft:(cbcap state.pagecache)
517 ~accu:[]
519 List.rev accu
521 else
525 let clamp incr =
526 let y = state.y + incr in
527 let y = max 0 y in
528 let y = min y (state.maxy - (if conf.maxhfit then conf.winh else 0)) in
532 let getopaque pageno =
533 try Some (Hashtbl.find state.pagemap
534 (pageno, state.w, conf.angle, conf.proportional, state.gen))
535 with Not_found -> None
538 let cache pageno opaque =
539 Hashtbl.replace state.pagemap
540 (pageno, state.w, conf.angle, conf.proportional, state.gen) opaque
543 let validopaque opaque = String.length opaque > 0;;
545 let render l =
546 match getopaque l.pageno with
547 | None when not state.rendering ->
548 state.rendering <- true;
549 cache l.pageno ("", -1);
550 wcmd "render" [`i (l.pageno + 1)
551 ;`i l.pagedimno
552 ;`i l.pagew
553 ;`i l.pageh];
554 | _ -> ()
557 let loadlayout layout =
558 let rec f all = function
559 | l :: ls ->
560 begin match getopaque l.pageno with
561 | None -> render l; f false ls
562 | Some (opaque, _) -> f (all && validopaque opaque) ls
564 | [] -> all
566 f (layout <> []) layout;
569 let findpageforopaque opaque =
570 Hashtbl.fold
571 (fun k (v, s) a -> if v = opaque then Some (k, s) else a)
572 state.pagemap None
575 let pagevisible layout n = List.exists (fun l -> l.pageno = n) layout;;
577 let preload () =
578 let oktopreload =
579 if conf.preload
580 then
581 let memleft = conf.memlimit - state.memused in
582 if memleft < 0
583 then
584 let opaque = cbpeek state.pagecache in
585 match findpageforopaque opaque with
586 | Some ((n, _, _, _, _), size) ->
587 memleft + size >= 0 && not (pagevisible state.layout n)
588 | None -> false
589 else true
590 else false
592 if oktopreload
593 then
594 let presentation = conf.presentation in
595 let interpagespace = conf.interpagespace in
596 let maxy = state.maxy in
597 conf.presentation <- false;
598 conf.interpagespace <- 0;
599 state.maxy <- calcheight ();
600 let y =
601 match state.layout with
602 | [] -> 0
603 | l :: _ -> getpagey l.pageno + l.pagey
605 let y = if y < conf.winh then 0 else y - conf.winh in
606 let pages = layout y (conf.winh*3) in
607 List.iter render pages;
608 conf.presentation <- presentation;
609 conf.interpagespace <- interpagespace;
610 state.maxy <- maxy;
613 let gotoy y =
614 let y = max 0 y in
615 let y = min state.maxy y in
616 let pages = layout y conf.winh in
617 let ready = loadlayout pages in
618 if conf.showall
619 then (
620 if ready
621 then (
622 state.y <- y;
623 state.layout <- pages;
624 state.throttle <- None;
625 Glut.postRedisplay ();
627 else (
628 state.throttle <- Some pages;
631 else (
632 state.y <- y;
633 state.layout <- pages;
634 state.throttle <- None;
635 Glut.postRedisplay ();
637 begin match state.mode with
638 | Birdseye (conf, leftx, pageno, hooverpageno, anchor) ->
639 if not (pagevisible pages pageno)
640 then (
641 match state.layout with
642 | [] -> ()
643 | l :: _ ->
644 state.mode <- Birdseye (conf, leftx, l.pageno, hooverpageno, anchor)
646 | _ -> ()
647 end;
648 preload ();
651 let gotoy_and_clear_text y =
652 gotoy y;
653 if not conf.verbose then state.text <- "";
656 let getanchor () =
657 match state.layout with
658 | [] -> emptyanchor
659 | l :: _ -> (l.pageno, float l.pagey /. float l.pageh)
662 let getanchory (n, top) =
663 let y, h = getpageyh n in
664 y + (truncate (top *. float h));
667 let gotoanchor anchor =
668 gotoy (getanchory anchor);
671 let addnav () =
672 cbput state.hists.nav (getanchor ());
675 let getnav () =
676 let anchor = cbgetc state.hists.nav ~-1 in
677 getanchory anchor;
680 let gotopage n top =
681 let y, h = getpageyh n in
682 gotoy_and_clear_text (y + (truncate (top *. float h)));
685 let gotopage1 n top =
686 let y = getpagey n in
687 gotoy_and_clear_text (y + top);
690 let invalidate () =
691 state.layout <- [];
692 state.pdims <- [];
693 state.rects <- [];
694 state.rects1 <- [];
695 state.invalidated <- state.invalidated + 1;
698 let scalecolor c =
699 let c = c *. state.colorscale in
700 (c, c, c);
703 let scalecolor2 (r, g, b) =
704 (r *. state.colorscale, g *. state.colorscale, b *. state.colorscale);
707 let represent () =
708 state.maxy <- calcheight ();
709 match state.mode with
710 | Birdseye (_, _, pageno, _, _) ->
711 let y, h = getpageyh pageno in
712 let top = (conf.winh - h) / 2 in
713 gotoy (max 0 (y - top))
714 | _ -> gotoanchor state.anchor
717 let pagematrix () =
718 GlMat.mode `projection;
719 GlMat.load_identity ();
720 GlMat.rotate ~x:1.0 ~angle:180.0 ();
721 GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
722 GlMat.scale3 (2.0 /. float state.w, 2.0 /. float conf.winh, 1.0);
723 if state.x != 0
724 then (
725 GlMat.translate ~x:(float state.x) ();
729 let winmatrix () =
730 GlMat.mode `projection;
731 GlMat.load_identity ();
732 GlMat.rotate ~x:1.0 ~angle:180.0 ();
733 GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
734 GlMat.scale3 (2.0 /. float conf.winw, 2.0 /. float conf.winh, 1.0);
737 let reshape ~w ~h =
738 if state.invalidated = 0 && state.anchor == initialanchor
739 then state.anchor <- getanchor ();
741 conf.winw <- w;
742 let w = truncate (float w *. conf.zoom) - conf.scrollw in
743 let w = max w 2 in
744 state.w <- w;
745 conf.winh <- h;
746 GlMat.mode `modelview;
747 GlMat.load_identity ();
748 GlClear.color (scalecolor 1.0);
749 GlClear.clear [`color];
751 invalidate ();
752 wcmd "geometry" [`i w; `i h];
755 let showtext c s =
756 GlDraw.color (0.0, 0.0, 0.0);
757 GlDraw.rect
758 (0.0, float (conf.winh - 18))
759 (float (conf.winw - conf.scrollw - 1), float conf.winh)
761 let font = Glut.BITMAP_8_BY_13 in
762 GlDraw.color (1.0, 1.0, 1.0);
763 GlPix.raster_pos ~x:0.0 ~y:(float (conf.winh - 5)) ();
764 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s;
767 let enttext () =
768 let len = String.length state.text in
769 match state.mode with
770 | Textentry ((prefix, text, _, _, _), _) ->
771 let s =
772 match String.length prefix with
773 | 0 | 1 ->
774 if len > 0
775 then
776 Printf.sprintf "%s%s^ [%s]" prefix text state.text
777 else
778 Printf.sprintf "%s%s^" prefix text
780 | _ ->
781 if len > 0
782 then
783 Printf.sprintf "%s: %s^ [%s]" prefix text state.text
784 else
785 Printf.sprintf "%s: %s^" prefix text
787 showtext ' ' s;
789 | _ ->
790 if len > 0 then showtext ' ' state.text
793 let showtext c s =
794 state.text <- Printf.sprintf "%c%s" c s;
795 Glut.postRedisplay ();
798 let act cmd =
799 match cmd.[0] with
800 | 'c' ->
801 state.pdims <- [];
803 | 'D' ->
804 state.rects <- state.rects1;
805 Glut.postRedisplay ()
807 | 'C' ->
808 let n = Scanf.sscanf cmd "C %u" (fun n -> n) in
809 state.pagecount <- n;
810 state.invalidated <- state.invalidated - 1;
811 if state.invalidated = 0
812 then represent ()
814 | 't' ->
815 let s = Scanf.sscanf cmd "t %n"
816 (fun n -> String.sub cmd n (String.length cmd - n))
818 Glut.setWindowTitle s
820 | 'T' ->
821 let s = Scanf.sscanf cmd "T %n"
822 (fun n -> String.sub cmd n (String.length cmd - n))
824 if istextentry state.mode
825 then (
826 state.text <- s;
827 showtext ' ' s;
829 else (
830 state.text <- s;
831 Glut.postRedisplay ();
834 | 'V' ->
835 if conf.verbose
836 then
837 let s = Scanf.sscanf cmd "V %n"
838 (fun n -> String.sub cmd n (String.length cmd - n))
840 state.text <- s;
841 showtext ' ' s;
843 | 'F' ->
844 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
845 Scanf.sscanf cmd "F %u %d %f %f %f %f %f %f %f %f"
846 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
847 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
849 let y = (getpagey pageno) + truncate y0 in
850 addnav ();
851 gotoy y;
852 state.rects1 <- [pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)]
854 | 'R' ->
855 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
856 Scanf.sscanf cmd "R %u %d %f %f %f %f %f %f %f %f"
857 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
858 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
860 state.rects1 <-
861 (pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)) :: state.rects1
863 | 'r' ->
864 let n, w, h, r, l, s, p =
865 Scanf.sscanf cmd "r %u %u %u %d %d %u %s"
866 (fun n w h r l s p ->
867 (n-1, w, h, r, l != 0, s, p))
870 Hashtbl.replace state.pagemap (n, w, r, l, state.gen) (p, s);
871 state.memused <- state.memused + s;
873 let layout =
874 match state.throttle with
875 | None -> state.layout
876 | Some layout -> layout
879 let rec gc () =
880 if (state.memused <= conf.memlimit) || cbempty state.pagecache
881 then ()
882 else (
883 let evictedopaque = cbpeek state.pagecache in
884 match findpageforopaque evictedopaque with
885 | None -> failwith "bug in gc"
886 | Some ((evictedn, _, _, _, gen) as k, evictedsize) ->
887 if state.gen != gen || not (pagevisible layout evictedn)
888 then (
889 wcmd "free" [`s evictedopaque];
890 state.memused <- state.memused - evictedsize;
891 Hashtbl.remove state.pagemap k;
892 cbdecr state.pagecache;
893 gc ();
897 gc ();
899 cbput state.pagecache p;
900 state.rendering <- false;
902 begin match state.throttle with
903 | None ->
904 if pagevisible state.layout n
905 then gotoy state.y
906 else (
907 let allvisible = loadlayout state.layout in
908 if allvisible then preload ();
911 | Some layout ->
912 match layout with
913 | [] -> ()
914 | l :: _ ->
915 let y = getpagey l.pageno + l.pagey in
916 gotoy y
919 | 'l' ->
920 let (n, w, h, x) as pdim =
921 Scanf.sscanf cmd "l %u %u %u %u" (fun n w h x -> n, w, h, x)
923 state.pdims <- pdim :: state.pdims
925 | 'o' ->
926 let (l, n, t, h, pos) =
927 Scanf.sscanf cmd "o %u %u %d %u %n" (fun l n t h pos -> l, n, t, h, pos)
929 let s = String.sub cmd pos (String.length cmd - pos) in
930 let s =
931 let l = String.length s in
932 let b = Buffer.create (String.length s) in
933 let rec loop pc2 i =
934 if i = l
935 then ()
936 else
937 let pc2 =
938 match s.[i] with
939 | '\xa0' when pc2 -> Buffer.add_char b ' '; false
940 | '\xc2' -> true
941 | c ->
942 let c = if Char.code c land 0x80 = 0 then c else '?' in
943 Buffer.add_char b c;
944 false
946 loop pc2 (i+1)
948 loop false 0;
949 Buffer.contents b
951 let outline = (s, l, n, float t /. float h) in
952 let outlines =
953 match state.outlines with
954 | Olist outlines -> Olist (outline :: outlines)
955 | Oarray _ -> Olist [outline]
956 | Onarrow _ -> Olist [outline]
958 state.outlines <- outlines
961 | 'i' ->
962 let s = Scanf.sscanf cmd "i %n"
963 (fun n -> String.sub cmd n (String.length cmd - n))
965 let len = String.length s in
966 let rec fold accu pos =
967 let eolpos =
968 try String.index_from s pos '\n' with Not_found -> len
970 if eolpos = len
971 then List.rev accu
972 else
973 let line = String.sub s pos (eolpos - pos) in
974 fold ((1, line)::accu) (eolpos+1)
976 state.docinfo <- fold state.docinfo 0
978 | _ ->
979 dolog "unknown cmd `%S'" cmd
982 let now = Unix.gettimeofday;;
984 let idle () =
985 let rec loop delay =
986 let r, _, _ = Unix.select [state.csock] [] [] delay in
987 begin match r with
988 | [] ->
989 if state.ascrollstep > 0
990 then begin
991 let y = state.y + state.ascrollstep in
992 let y = if y >= state.maxy then 0 else y in
993 gotoy y;
994 state.text <- "";
995 end;
997 | _ ->
998 let cmd = readcmd state.csock in
999 act cmd;
1000 loop 0.0
1001 end;
1002 in loop 0.001
1005 let onhist cb =
1006 let rc = cb.rc in
1007 let action = function
1008 | HCprev -> cbget cb ~-1
1009 | HCnext -> cbget cb 1
1010 | HCfirst -> cbget cb ~-(cb.rc)
1011 | HClast -> cbget cb (cb.len - 1 - cb.rc)
1012 and cancel () = cb.rc <- rc
1013 in (action, cancel)
1016 let search pattern forward =
1017 if String.length pattern > 0
1018 then
1019 let pn, py =
1020 match state.layout with
1021 | [] -> 0, 0
1022 | l :: _ ->
1023 l.pageno, (l.pagey + if forward then 0 else 0*l.pagevh)
1025 let cmd =
1026 let b = makecmd "search"
1027 [`b conf.icase; `i pn; `i py; `i (if forward then 1 else 0)]
1029 Buffer.add_char b ',';
1030 Buffer.add_string b pattern;
1031 Buffer.add_char b '\000';
1032 Buffer.contents b;
1034 writecmd state.csock cmd;
1037 let intentry text key =
1038 let c = Char.unsafe_chr key in
1039 match c with
1040 | '0' .. '9' ->
1041 let s = "x" in s.[0] <- c;
1042 let text = text ^ s in
1043 TEcont text
1045 | _ ->
1046 state.text <- Printf.sprintf "invalid char (%d, `%c')" key c;
1047 TEcont text
1050 let addchar s c =
1051 let b = Buffer.create (String.length s + 1) in
1052 Buffer.add_string b s;
1053 Buffer.add_char b c;
1054 Buffer.contents b;
1057 let textentry text key =
1058 let c = Char.unsafe_chr key in
1059 match c with
1060 | _ when key >= 32 && key < 127 ->
1061 let text = addchar text c in
1062 TEcont text
1064 | _ ->
1065 dolog "unhandled key %d char `%c'" key (Char.unsafe_chr key);
1066 TEcont text
1069 let reinit angle proportional =
1070 conf.angle <- angle;
1071 conf.proportional <- proportional;
1072 invalidate ();
1073 wcmd "reinit" [`i angle; `b proportional];
1076 let setzoom zoom =
1077 let zoom = max 0.01 (min 2.2 zoom) in
1078 if zoom <> conf.zoom
1079 then (
1080 if zoom <= 1.0
1081 then state.x <- 0;
1082 conf.zoom <- zoom;
1083 reshape conf.winw conf.winh;
1084 state.text <- Printf.sprintf "zoom is now %-5.1f" (zoom *. 100.0);
1088 let enterbirdseye () =
1089 let zoom = float conf.thumbw /. float conf.winw in
1090 let birdseyepageno =
1091 let rec fold candidate = function
1092 | [] -> candidate
1093 | l :: _ when l.pagey = 0 -> l.pageno
1094 | l :: rest -> fold l.pageno rest
1096 fold 0 state.layout
1098 state.mode <- Birdseye (
1099 { conf with zoom = conf.zoom }, state.x, birdseyepageno, -1, getanchor ()
1101 conf.zoom <- zoom;
1102 conf.presentation <- false;
1103 conf.interpagespace <- 10;
1104 conf.hlinks <- false;
1105 state.x <- 0;
1106 state.mstate <- Mnone;
1107 conf.showall <- false;
1108 Glut.setCursor Glut.CURSOR_INHERIT;
1109 if conf.verbose
1110 then
1111 state.text <- Printf.sprintf "birds eye mode on (zoom %3.1f%%)"
1112 (100.0*.zoom)
1113 else
1114 state.text <- ""
1116 reshape conf.winw conf.winh;
1119 let leavebirdseye (c, leftx, pageno, _, anchor) goback =
1120 state.mode <- View;
1121 conf.zoom <- c.zoom;
1122 conf.presentation <- c.presentation;
1123 conf.interpagespace <- c.interpagespace;
1124 conf.showall <- c.showall;
1125 conf.hlinks <- c.hlinks;
1126 state.x <- leftx;
1127 if conf.verbose
1128 then
1129 state.text <- Printf.sprintf "birds eye mode off (zoom %3.1f%%)"
1130 (100.0*.conf.zoom)
1132 reshape conf.winw conf.winh;
1133 state.anchor <- if goback then anchor else (pageno, 0.0);
1136 let togglebirdseye () =
1137 match state.mode with
1138 | Birdseye vals -> leavebirdseye vals true
1139 | View | Outline _ -> enterbirdseye ()
1140 | _ -> ()
1143 let upbirdseye (conf, leftx, pageno, hooverpageno, anchor) =
1144 let pageno = max 0 (pageno - 1) in
1145 let rec loop = function
1146 | [] -> gotopage1 pageno 0
1147 | l :: _ when l.pageno = pageno ->
1148 if l.pagedispy >= 0 && l.pagey = 0
1149 then Glut.postRedisplay ()
1150 else gotopage1 pageno 0
1151 | _ :: rest -> loop rest
1153 loop state.layout;
1154 state.mode <- Birdseye (conf, leftx, pageno, hooverpageno, anchor)
1157 let downbirdseye (conf, leftx, pageno, hooverpageno, anchor) =
1158 let pageno = min (state.pagecount - 1) (pageno + 1) in
1159 state.mode <- Birdseye (conf, leftx, pageno, hooverpageno, anchor);
1160 let rec loop = function
1161 | [] ->
1162 let y, h = getpageyh pageno in
1163 let dy = (y - state.y) - (conf.winh - h - conf.interpagespace) in
1164 gotoy (clamp dy)
1165 | l :: rest when l.pageno = pageno ->
1166 if l.pagevh != l.pageh
1167 then gotoy (clamp (l.pageh - l.pagevh + conf.interpagespace))
1168 else Glut.postRedisplay ()
1169 | l :: rest -> loop rest
1171 loop state.layout
1174 let optentry mode text key =
1175 let btos b = if b then "on" else "off" in
1176 let c = Char.unsafe_chr key in
1177 match c with
1178 | 's' ->
1179 let ondone s =
1180 try conf.scrollstep <- int_of_string s with exc ->
1181 state.text <- Printf.sprintf "bad integer `%s': %s"
1182 s (Printexc.to_string exc)
1184 TEswitch ("scroll step", "", None, intentry, ondone)
1186 | 'A' ->
1187 let ondone s =
1189 conf.autoscrollstep <- int_of_string s;
1190 if state.ascrollstep > 0
1191 then state.ascrollstep <- conf.autoscrollstep;
1192 with exc ->
1193 state.text <- Printf.sprintf "bad integer `%s': %s"
1194 s (Printexc.to_string exc)
1196 TEswitch ("auto scroll step", "", None, intentry, ondone)
1198 | 'Z' ->
1199 let ondone s =
1201 let zoom = float (int_of_string s) /. 100.0 in
1202 setzoom zoom
1203 with exc ->
1204 state.text <- Printf.sprintf "bad integer `%s': %s"
1205 s (Printexc.to_string exc)
1207 TEswitch ("zoom", "", None, intentry, ondone)
1209 | 't' ->
1210 let ondone s =
1212 conf.thumbw <- max 2 (min 1920 (int_of_string s));
1213 state.text <-
1214 Printf.sprintf "thumbnail width is set to %d" conf.thumbw;
1215 begin match mode with
1216 | Birdseye beye ->
1217 leavebirdseye beye false;
1218 enterbirdseye ();
1219 | _ -> ();
1221 with exc ->
1222 state.text <- Printf.sprintf "bad integer `%s': %s"
1223 s (Printexc.to_string exc)
1225 TEswitch ("thumbnail width", "", None, intentry, ondone)
1227 | 'R' ->
1228 let ondone s =
1229 match try
1230 Some (int_of_string s)
1231 with exc ->
1232 state.text <- Printf.sprintf "bad integer `%s': %s"
1233 s (Printexc.to_string exc);
1234 None
1235 with
1236 | Some angle -> reinit angle conf.proportional
1237 | None -> ()
1239 TEswitch ("rotation", "", None, intentry, ondone)
1241 | 'i' ->
1242 conf.icase <- not conf.icase;
1243 TEdone ("case insensitive search " ^ (btos conf.icase))
1245 | 'p' ->
1246 conf.preload <- not conf.preload;
1247 gotoy state.y;
1248 TEdone ("preload " ^ (btos conf.preload))
1250 | 'v' ->
1251 conf.verbose <- not conf.verbose;
1252 TEdone ("verbose " ^ (btos conf.verbose))
1254 | 'h' ->
1255 conf.maxhfit <- not conf.maxhfit;
1256 state.maxy <- state.maxy + (if conf.maxhfit then -conf.winh else conf.winh);
1257 TEdone ("maxhfit " ^ (btos conf.maxhfit))
1259 | 'c' ->
1260 conf.crophack <- not conf.crophack;
1261 TEdone ("crophack " ^ btos conf.crophack)
1263 | 'a' ->
1264 conf.showall <- not conf.showall;
1265 TEdone ("showall " ^ btos conf.showall)
1267 | 'f' ->
1268 conf.underinfo <- not conf.underinfo;
1269 TEdone ("underinfo " ^ btos conf.underinfo)
1271 | 'P' ->
1272 conf.savebmarks <- not conf.savebmarks;
1273 TEdone ("persistent bookmarks " ^ btos conf.savebmarks)
1275 | 'S' ->
1276 let ondone s =
1278 let pageno, py =
1279 match state.layout with
1280 | [] -> 0, 0
1281 | l :: _ ->
1282 l.pageno, l.pagey
1284 conf.interpagespace <- int_of_string s;
1285 state.maxy <- calcheight ();
1286 let y = getpagey pageno in
1287 gotoy (y + py)
1288 with exc ->
1289 state.text <- Printf.sprintf "bad integer `%s': %s"
1290 s (Printexc.to_string exc)
1292 TEswitch ("vertical margin", "", None, intentry, ondone)
1294 | 'l' ->
1295 reinit conf.angle (not conf.proportional);
1296 TEdone ("proprortional display " ^ btos conf.proportional)
1298 | _ ->
1299 state.text <- Printf.sprintf "bad option %d `%c'" key c;
1300 TEstop
1303 let maxoutlinerows () = (conf.winh - 31) / 16;;
1305 let enterselector allowdel outlines errmsg msg =
1306 if Array.length outlines = 0
1307 then (
1308 showtext ' ' errmsg;
1310 else (
1311 state.text <- msg;
1312 Glut.setCursor Glut.CURSOR_INHERIT;
1313 let pageno =
1314 match state.layout with
1315 | [] -> -1
1316 | {pageno=pageno} :: rest -> pageno
1318 let active =
1319 let rec loop n =
1320 if n = Array.length outlines
1321 then 0
1322 else
1323 let (_, _, outlinepageno, _) = outlines.(n) in
1324 if outlinepageno >= pageno then n else loop (n+1)
1326 loop 0
1328 state.mode <- Outline
1329 (allowdel, active, max 0 (active - maxoutlinerows () / 2), outlines, "", 0,
1330 state.mode);
1331 Glut.postRedisplay ();
1335 let enteroutlinemode () =
1336 let outlines, msg =
1337 match state.outlines with
1338 | Oarray a -> a, ""
1339 | Olist l ->
1340 let a = Array.of_list (List.rev l) in
1341 state.outlines <- Oarray a;
1342 a, ""
1343 | Onarrow (pat, a, b) ->
1344 a, "Outline was narrowed to `" ^ pat ^ "' (Ctrl-u to restore)"
1346 enterselector false outlines "Document has no outline" msg;
1349 let enterbookmarkmode () =
1350 let bookmarks = Array.of_list state.bookmarks in
1351 enterselector true bookmarks "Document has no bookmarks (yet)" "";
1354 let mode_to_string mode =
1355 let b = Buffer.create 10 in
1356 let rec f = function
1357 | Textentry (_, _) -> Buffer.add_string b "Textentry ";
1358 | View -> Buffer.add_string b "View"
1359 | Birdseye _ -> Buffer.add_string b "Birdseye"
1360 | Items _ -> Buffer.add_string b "Items"
1361 | Outline _ -> Buffer.add_string b "Outline"
1363 f mode;
1364 Buffer.contents b;
1367 let enterinfomode () =
1368 let btos = function true -> "on" | _ -> "off" in
1369 let mode = state.mode in
1370 let rec makeitems () =
1371 let intp name get set =
1372 Printf.sprintf "%-24s %d" name (get ()), 1, Action (
1373 fun active first qsearch pan ->
1374 let ondone s =
1375 let n =
1376 try int_of_string s
1377 with exn ->
1378 state.text <- Printf.sprintf "bad integer `%s': %s"
1379 s (Printexc.to_string exn);
1380 max_int;
1382 if n != max_int then set n;
1384 let te = name, "", None, intentry, ondone in
1385 state.text <- "";
1386 Textentry (
1388 fun _ ->
1389 state.mode <- Items (active, first, makeitems (), "", 0, mode)
1392 and boolp name get set =
1393 Printf.sprintf "%-24s %s" name (btos (get ())), 1, Action (
1394 fun active first qsearch pan ->
1395 let v = get () in
1396 set (not v);
1397 Items (active, first, makeitems (), qsearch, pan, mode);
1401 let items = [
1402 "Setup", 0, Noaction;
1404 boolp "presentation"
1405 (fun () -> conf.presentation)
1406 (fun v ->
1407 conf.presentation <- v;
1408 state.anchor <- getanchor ();
1409 represent ());
1411 boolp "ignore case in searches"
1412 (fun () -> conf.icase)
1413 (fun v -> conf.icase <- v);
1415 boolp "preload"
1416 (fun () -> conf.preload)
1417 (fun v -> conf.preload <- v);
1419 boolp "verbose"
1420 (fun () -> conf.verbose)
1421 (fun v -> conf.verbose <- v);
1423 boolp "max fit"
1424 (fun () -> conf.maxhfit)
1425 (fun v -> conf.maxhfit <- v);
1427 boolp "crop hack"
1428 (fun () -> conf.crophack)
1429 (fun v -> conf.crophack <- v);
1431 boolp "throttle"
1432 (fun () -> conf.showall)
1433 (fun v -> conf.showall <- v);
1435 boolp "highlight links"
1436 (fun () -> conf.hlinks)
1437 (fun v -> conf.hlinks <- v);
1439 boolp "under info"
1440 (fun () -> conf.underinfo)
1441 (fun v -> conf.underinfo <- v);
1442 boolp "persistent bookmarks"
1443 (fun () -> conf.savebmarks)
1444 (fun v -> conf.savebmarks <- v);
1446 boolp "proportional display"
1447 (fun () -> conf.proportional)
1448 (fun v -> reinit conf.angle (not conf.proportional));
1450 boolp "persistent location"
1451 (fun () -> conf.jumpback)
1452 (fun v -> conf.jumpback <- v);
1454 "", 0, Noaction;
1456 intp "vertical margin"
1457 (fun () -> conf.interpagespace)
1458 (fun n ->
1459 conf.interpagespace <- n;
1460 let pageno, py =
1461 match state.layout with
1462 | [] -> 0, 0
1463 | l :: _ ->
1464 l.pageno, l.pagey
1466 state.maxy <- calcheight ();
1467 let y = getpagey pageno in
1468 gotoy (y + py)
1471 intp "page bias"
1472 (fun () -> conf.pagebias)
1473 (fun v -> conf.pagebias <- v);
1475 intp "scroll step"
1476 (fun () -> conf.scrollstep)
1477 (fun n -> conf.scrollstep <- n);
1479 intp "auto scroll step"
1480 (fun () ->
1481 if state.ascrollstep > 0
1482 then state.ascrollstep
1483 else conf.autoscrollstep)
1484 (fun n ->
1485 if state.ascrollstep > 0
1486 then state.ascrollstep <- n
1487 else conf.autoscrollstep <- n);
1489 intp "zoom"
1490 (fun () -> truncate (conf.zoom *. 100.))
1491 (fun v -> setzoom ((float v) /. 100.));
1493 intp "rotation"
1494 (fun () -> conf.angle)
1495 (fun v -> reinit v conf.proportional);
1497 intp "scroll bar width"
1498 (fun () -> conf.scrollw)
1499 (fun v ->
1500 conf.scrollw <- v;
1501 reshape conf.winw conf.winh;
1504 intp "scroll handle height"
1505 (fun () -> conf.scrollh)
1506 (fun v -> conf.scrollh <- v;);
1508 intp "thumbnail width"
1509 (fun () -> conf.thumbw)
1510 (fun v ->
1511 conf.thumbw <- min 1920 v;
1512 match mode with
1513 | Birdseye beye ->
1514 leavebirdseye beye false;
1515 enterbirdseye ()
1516 | _ -> ()
1519 "", 0, Noaction;
1520 "Pixmap Cache", 0, Noaction;
1522 intp "size (advisory)"
1523 (fun () -> conf.memlimit)
1524 (fun v -> conf.memlimit <- v);
1525 Printf.sprintf "%-24s %d" "used" state.memused, 1, Noaction;
1527 "", 0, Noaction;
1528 "Window", 0, Noaction;
1529 Printf.sprintf "dimensions %dx%d" conf.winw conf.winh, 1, Noaction;
1531 "", 0, Noaction;
1532 "Document", 0, Noaction;
1535 Array.of_list
1536 (items @ List.map (fun (_, s) -> (s, 1, Noaction)) state.docinfo);
1538 state.text <- "";
1539 state.mode <- Items (1, 0, makeitems (), "", 0, mode);
1540 Glut.postRedisplay ();
1543 let enterhelpmode () =
1544 state.mode <- Items (0, 0, state.help, "", 0, state.mode);
1545 Glut.postRedisplay ();
1548 let quickbookmark ?title () =
1549 match state.layout with
1550 | [] -> ()
1551 | l :: _ ->
1552 let title =
1553 match title with
1554 | None ->
1555 let sec = Unix.gettimeofday () in
1556 let tm = Unix.localtime sec in
1557 Printf.sprintf "Quick (page %d) (bookmarked at %d/%d/%d %d:%d)"
1558 (l.pageno+1)
1559 tm.Unix.tm_mday
1560 tm.Unix.tm_mon
1561 (tm.Unix.tm_year + 1900)
1562 tm.Unix.tm_hour
1563 tm.Unix.tm_min
1564 | Some title -> title
1566 state.bookmarks <-
1567 (title, 0, l.pageno, float l.pagey /. float l.pageh) :: state.bookmarks
1570 let doreshape w h =
1571 state.fullscreen <- None;
1572 Glut.reshapeWindow w h;
1575 let writeopen path password =
1576 writecmd state.csock ("open " ^ path ^ "\000" ^ state.password ^ "\000");
1577 writecmd state.csock "info";
1580 let opendoc path password =
1581 invalidate ();
1582 state.path <- path;
1583 state.password <- password;
1584 state.gen <- state.gen + 1;
1586 writeopen path password;
1587 Glut.setWindowTitle ("llpp " ^ Filename.basename path);
1588 wcmd "geometry" [`i state.w; `i conf.winh];
1591 let viewkeyboard ~key ~x ~y =
1592 let enttext te =
1593 let mode = state.mode in
1594 state.mode <- Textentry (te, fun _ -> state.mode <- mode);
1595 state.text <- "";
1596 enttext ();
1597 Glut.postRedisplay ()
1599 let c = Char.chr key in
1600 match c with
1601 | '\027' | 'q' ->
1602 exit 0
1604 | '\008' ->
1605 let y = getnav () in
1606 gotoy_and_clear_text y
1608 | 'o' ->
1609 enteroutlinemode ()
1611 | 'u' ->
1612 state.rects <- [];
1613 state.text <- "";
1614 Glut.postRedisplay ()
1616 | '/' | '?' ->
1617 let ondone isforw s =
1618 cbput state.hists.pat s;
1619 state.searchpattern <- s;
1620 search s isforw
1622 let s = String.create 1 in
1623 s.[0] <- c;
1624 enttext (s, "", Some (onhist state.hists.pat),
1625 textentry, ondone (c ='/'))
1627 | '+' when Glut.getModifiers () land Glut.active_ctrl != 0 ->
1628 let incr = if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01 in
1629 setzoom (min 2.2 (conf.zoom +. incr))
1631 | '+' ->
1632 let ondone s =
1633 let n =
1634 try int_of_string s with exc ->
1635 state.text <- Printf.sprintf "bad integer `%s': %s"
1636 s (Printexc.to_string exc);
1637 max_int
1639 if n != max_int
1640 then (
1641 conf.pagebias <- n;
1642 state.text <- "page bias is now " ^ string_of_int n;
1645 enttext ("page bias", "", None, intentry, ondone)
1647 | '-' when Glut.getModifiers () land Glut.active_ctrl != 0 ->
1648 let decr = if conf.zoom -. 0.1 < 0.1 then 0.01 else 0.1 in
1649 setzoom (max 0.01 (conf.zoom -. decr))
1651 | '-' ->
1652 let ondone msg =
1653 state.text <- msg;
1655 enttext ("option", "", None, optentry state.mode, ondone)
1657 | '0' when (Glut.getModifiers () land Glut.active_ctrl != 0) ->
1658 setzoom 1.0
1660 | '1' when (Glut.getModifiers () land Glut.active_ctrl != 0) ->
1661 let zoom = zoomforh conf.winw conf.winh conf.scrollw in
1662 if zoom < 1.0
1663 then setzoom zoom
1665 | '9' when (Glut.getModifiers () land Glut.active_ctrl != 0) ->
1666 togglebirdseye ()
1668 | '0' .. '9' ->
1669 let ondone s =
1670 let n =
1671 try int_of_string s with exc ->
1672 state.text <- Printf.sprintf "bad integer `%s': %s"
1673 s (Printexc.to_string exc);
1676 if n >= 0
1677 then (
1678 addnav ();
1679 cbput state.hists.pag (string_of_int n);
1680 gotoy_and_clear_text (getpagey (n + conf.pagebias - 1))
1683 let pageentry text key =
1684 match Char.unsafe_chr key with
1685 | 'g' -> TEdone text
1686 | _ -> intentry text key
1688 let text = "x" in text.[0] <- c;
1689 enttext (":", text, Some (onhist state.hists.pag), pageentry, ondone)
1691 | 'b' ->
1692 conf.scrollw <- if conf.scrollw > 0 then 0 else defconf.scrollw;
1693 reshape conf.winw conf.winh;
1695 | 'l' ->
1696 conf.hlinks <- not conf.hlinks;
1697 state.text <- "highlightlinks " ^ if conf.hlinks then "on" else "off";
1698 Glut.postRedisplay ()
1700 | 'a' ->
1701 if state.ascrollstep = 0
1702 then state.ascrollstep <- conf.autoscrollstep
1703 else (
1704 conf.autoscrollstep <- state.ascrollstep;
1705 state.ascrollstep <- 0;
1708 | 'P' ->
1709 conf.presentation <- not conf.presentation;
1710 showtext ' ' ("presentation mode " ^
1711 if conf.presentation then "on" else "off");
1712 state.anchor <- getanchor ();
1713 represent ()
1715 | 'f' ->
1716 begin match state.fullscreen with
1717 | None ->
1718 state.fullscreen <- Some (conf.winw, conf.winh);
1719 Glut.fullScreen ()
1720 | Some (w, h) ->
1721 state.fullscreen <- None;
1722 doreshape w h
1725 | 'g' ->
1726 gotoy_and_clear_text 0
1728 | 'n' ->
1729 search state.searchpattern true
1731 | 'p' | 'N' ->
1732 search state.searchpattern false
1734 | 't' ->
1735 begin match state.layout with
1736 | [] -> ()
1737 | l :: _ ->
1738 gotoy_and_clear_text (getpagey l.pageno)
1741 | ' ' ->
1742 begin match List.rev state.layout with
1743 | [] -> ()
1744 | l :: _ ->
1745 let pageno = min (l.pageno+1) (state.pagecount-1) in
1746 gotoy_and_clear_text (getpagey pageno)
1749 | '\127' ->
1750 begin match state.layout with
1751 | [] -> ()
1752 | l :: _ ->
1753 let pageno = max 0 (l.pageno-1) in
1754 gotoy_and_clear_text (getpagey pageno)
1757 | '=' ->
1758 let f (fn, ln) l =
1759 if fn = -1 then l.pageno, l.pageno else fn, l.pageno
1761 let fn, ln = List.fold_left f (-1, -1) state.layout in
1762 let s =
1763 let maxy = state.maxy - (if conf.maxhfit then conf.winh else 0) in
1764 let percent =
1765 if maxy <= 0
1766 then 100.
1767 else (100. *. (float state.y /. float maxy)) in
1768 if fn = ln
1769 then
1770 Printf.sprintf "Page %d of %d %.2f%%"
1771 (fn+1) state.pagecount percent
1772 else
1773 Printf.sprintf
1774 "Pages %d-%d of %d %.2f%%"
1775 (fn+1) (ln+1) state.pagecount percent
1777 showtext ' ' s;
1779 | 'w' ->
1780 begin match state.layout with
1781 | [] -> ()
1782 | l :: _ ->
1783 doreshape (l.pagew + conf.scrollw) l.pageh;
1784 Glut.postRedisplay ();
1787 | '\'' ->
1788 enterbookmarkmode ()
1790 | 'h' ->
1791 enterhelpmode ()
1793 | 'i' ->
1794 enterinfomode ()
1796 | 'm' ->
1797 let ondone s =
1798 match state.layout with
1799 | l :: _ ->
1800 state.bookmarks <-
1801 (s, 0, l.pageno, float l.pagey /. float l.pageh)
1802 :: state.bookmarks
1803 | _ -> ()
1805 enttext ("bookmark", "", None, textentry, ondone)
1807 | '~' ->
1808 quickbookmark ();
1809 showtext ' ' "Quick bookmark added";
1811 | 'z' ->
1812 begin match state.layout with
1813 | l :: _ ->
1814 let rect = getpdimrect l.pagedimno in
1815 let w, h =
1816 if conf.crophack
1817 then
1818 (truncate (1.8 *. (rect.(1) -. rect.(0))),
1819 truncate (1.2 *. (rect.(3) -. rect.(0))))
1820 else
1821 (truncate (rect.(1) -. rect.(0)),
1822 truncate (rect.(3) -. rect.(0)))
1824 if w != 0 && h != 0
1825 then
1826 doreshape (w + conf.scrollw) (h + conf.interpagespace)
1828 Glut.postRedisplay ();
1830 | [] -> ()
1833 | '<' | '>' ->
1834 reinit (conf.angle + (if c = '>' then 30 else -30)) conf.proportional
1836 | '[' | ']' ->
1837 state.colorscale <-
1838 max 0.0
1839 (min (state.colorscale +. (if c = ']' then 0.1 else -0.1)) 1.0);
1840 Glut.postRedisplay ()
1842 | 'k' ->
1843 begin match state.mode with
1844 | Birdseye beye -> upbirdseye beye
1845 | _ -> gotoy (clamp (-conf.scrollstep))
1848 | 'j' ->
1849 begin match state.mode with
1850 | Birdseye beye -> downbirdseye beye
1851 | _ -> gotoy (clamp conf.scrollstep)
1854 | 'r' -> opendoc state.path state.password
1856 | _ ->
1857 vlog "huh? %d %c" key (Char.chr key);
1860 let textentrykeyboard ~key ~x ~y ((c, text, opthist, onkey, ondone), onleave) =
1861 let enttext te =
1862 state.mode <- Textentry (te, onleave);
1863 state.text <- "";
1864 enttext ();
1865 Glut.postRedisplay ()
1867 match Char.unsafe_chr key with
1868 | '\008' ->
1869 let len = String.length text in
1870 if len = 0
1871 then (
1872 onleave Cancel;
1873 Glut.postRedisplay ();
1875 else (
1876 let s = String.sub text 0 (len - 1) in
1877 enttext (c, s, opthist, onkey, ondone)
1880 | '\r' | '\n' ->
1881 ondone text;
1882 onleave Confirm;
1883 Glut.postRedisplay ()
1885 | '\027' ->
1886 begin match opthist with
1887 | None -> ()
1888 | Some (_, onhistcancel) -> onhistcancel ()
1889 end;
1890 onleave Cancel;
1891 Glut.postRedisplay ()
1893 | _ ->
1894 begin match onkey text key with
1895 | TEdone text ->
1896 onleave Confirm;
1897 ondone text;
1898 Glut.postRedisplay ()
1900 | TEcont text ->
1901 enttext (c, text, opthist, onkey, ondone);
1903 | TEstop ->
1904 onleave Cancel;
1905 Glut.postRedisplay ()
1907 | TEswitch te ->
1908 state.mode <- Textentry (te, onleave);
1909 Glut.postRedisplay ()
1910 end;
1913 let birdseyekeyboard ~key ~x ~y ((_, _, pageno, _, anchor) as beye) =
1914 match key with
1915 | 27 ->
1916 leavebirdseye beye true
1918 | 12 ->
1919 let y, h = getpageyh pageno in
1920 let top = (conf.winh - h) / 2 in
1921 gotoy (max 0 (y - top))
1923 | 13 ->
1924 leavebirdseye beye false
1926 | _ ->
1927 viewkeyboard ~key ~x ~y
1930 let itemskeyboard ~key ~x ~y (active, first, items, qsearch, pan, oldmode) =
1931 let set active first qsearch =
1932 state.mode <- Items (active, first, items, qsearch, pan, oldmode)
1934 let search active pattern incr =
1935 let dosearch re =
1936 let rec loop n =
1937 if n = Array.length items || n = -1
1938 then None
1939 else
1940 let (s, _, _) = items.(n) in
1942 (try ignore (Str.search_forward re s 0); true
1943 with Not_found -> false)
1944 then Some n
1945 else loop (n + incr)
1947 loop active
1950 let re = Str.regexp_case_fold pattern in
1951 dosearch re
1952 with Failure s ->
1953 state.text <- s;
1954 None
1956 let firstof active = max 0 (active - maxoutlinerows () / 2) in
1957 match key with
1958 | 18 | 19 ->
1959 let incr = if key = 18 then -1 else 1 in
1960 let active, first =
1961 match search (active + incr) qsearch incr with
1962 | None ->
1963 state.text <- qsearch ^ " [not found]";
1964 active, first
1965 | Some active ->
1966 state.text <- qsearch;
1967 active, firstof active
1969 set active first qsearch;
1970 Glut.postRedisplay ();
1972 | 8 ->
1973 let len = String.length qsearch in
1974 if len = 0
1975 then ()
1976 else (
1977 if len = 1
1978 then (
1979 state.text <- "";
1980 set active first "";
1982 else
1983 let qsearch = String.sub qsearch 0 (len - 1) in
1984 let active, first =
1985 match search active qsearch ~-1 with
1986 | None ->
1987 state.text <- qsearch ^ " [not found]";
1988 active, first
1989 | Some active ->
1990 state.text <- qsearch;
1991 active, firstof active
1993 set active first qsearch
1995 Glut.postRedisplay ()
1997 | _ when key >= 32 && key < 127 ->
1998 let pattern = addchar qsearch (Char.chr key) in
1999 let active, first =
2000 match search active pattern 1 with
2001 | None ->
2002 state.text <- pattern ^ " [not found]";
2003 active, first
2004 | Some active ->
2005 state.text <- pattern;
2006 active, firstof active
2008 set active first pattern;
2009 Glut.postRedisplay ()
2011 | 27 ->
2012 state.text <- "";
2013 state.mode <- oldmode;
2014 Glut.postRedisplay ();
2016 | 13 ->
2017 if active < Array.length items
2018 then (
2019 match items.(active) with
2020 | _, _, Action f ->
2021 state.mode <- f active first qsearch pan
2023 | _, _, Noaction ->
2024 state.text <- "";
2025 state.mode <- oldmode
2027 Glut.postRedisplay ();
2029 | _ -> dolog "unknown key %d" key
2032 let outlinekeyboard ~key ~x ~y
2033 (allowdel, active, first, outlines, qsearch, pan, oldmode) =
2034 let narrow outlines pattern =
2035 let reopt = try Some (Str.regexp_case_fold pattern) with _ -> None in
2036 match reopt with
2037 | None -> None
2038 | Some re ->
2039 let rec fold accu n =
2040 if n = -1
2041 then accu
2042 else
2043 let (s, _, _, _) as o = outlines.(n) in
2044 let accu =
2045 if (try ignore (Str.search_forward re s 0); true
2046 with Not_found -> false)
2047 then (o :: accu)
2048 else accu
2050 fold accu (n-1)
2052 let matched = fold [] (Array.length outlines - 1) in
2053 if matched = [] then None else Some (Array.of_list matched)
2055 let search active pattern incr =
2056 let dosearch re =
2057 let rec loop n =
2058 if n = Array.length outlines || n = -1
2059 then None
2060 else
2061 let (s, _, _, _) = outlines.(n) in
2063 (try ignore (Str.search_forward re s 0); true
2064 with Not_found -> false)
2065 then Some n
2066 else loop (n + incr)
2068 loop active
2071 let re = Str.regexp_case_fold pattern in
2072 dosearch re
2073 with Failure s ->
2074 state.text <- s;
2075 None
2077 let firstof active = max 0 (active - maxoutlinerows () / 2) in
2078 match key with
2079 | 27 ->
2080 if String.length qsearch = 0
2081 then (
2082 state.text <- "";
2083 state.mode <- oldmode;
2084 Glut.postRedisplay ();
2086 else (
2087 state.text <- "";
2088 state.mode <- Outline (
2089 allowdel, active, first, outlines, "", pan, oldmode
2091 Glut.postRedisplay ();
2094 | 18 | 19 ->
2095 let incr = if key = 18 then -1 else 1 in
2096 let active, first =
2097 match search (active + incr) qsearch incr with
2098 | None ->
2099 state.text <- qsearch ^ " [not found]";
2100 active, first
2101 | Some active ->
2102 state.text <- qsearch;
2103 active, firstof active
2105 state.mode <- Outline (
2106 allowdel, active, first, outlines, qsearch, pan, oldmode
2108 Glut.postRedisplay ();
2110 | 8 ->
2111 let len = String.length qsearch in
2112 if len = 0
2113 then ()
2114 else (
2115 if len = 1
2116 then (
2117 state.text <- "";
2118 state.mode <- Outline (
2119 allowdel, active, first, outlines, "", pan, oldmode
2122 else
2123 let qsearch = String.sub qsearch 0 (len - 1) in
2124 let active, first =
2125 match search active qsearch ~-1 with
2126 | None ->
2127 state.text <- qsearch ^ " [not found]";
2128 active, first
2129 | Some active ->
2130 state.text <- qsearch;
2131 active, firstof active
2133 state.mode <- Outline (
2134 allowdel, active, first, outlines, qsearch, pan, oldmode
2137 Glut.postRedisplay ()
2139 | 13 ->
2140 if active < Array.length outlines
2141 then (
2142 let (_, _, n, t) = outlines.(active) in
2143 addnav ();
2144 gotopage n t;
2146 state.text <- "";
2147 if allowdel then state.bookmarks <- Array.to_list outlines;
2148 state.mode <- oldmode;
2149 Glut.postRedisplay ();
2151 | _ when key >= 32 && key < 127 ->
2152 let pattern = addchar qsearch (Char.chr key) in
2153 let active, first =
2154 match search active pattern 1 with
2155 | None ->
2156 state.text <- pattern ^ " [not found]";
2157 active, first
2158 | Some active ->
2159 state.text <- pattern;
2160 active, firstof active
2162 state.mode <- Outline (
2163 allowdel, active, first, outlines, pattern, pan, oldmode
2165 Glut.postRedisplay ()
2167 | 14 when not allowdel -> (* ctrl-n *)
2168 if String.length qsearch > 0
2169 then (
2170 let optoutlines = narrow outlines qsearch in
2171 begin match optoutlines with
2172 | None -> state.text <- "can't narrow"
2173 | Some outlines ->
2174 state.mode <- Outline (
2175 allowdel, 0, 0, outlines, qsearch, pan, oldmode
2177 match state.outlines with
2178 | Olist l -> ()
2179 | Oarray a ->
2180 state.outlines <- Onarrow (qsearch, outlines, a)
2181 | Onarrow (pat, a, b) ->
2182 state.outlines <- Onarrow (qsearch, outlines, b)
2183 end;
2185 Glut.postRedisplay ()
2187 | 21 when not allowdel -> (* ctrl-u *)
2188 let outline =
2189 match state.outlines with
2190 | Oarray a -> a
2191 | Olist l ->
2192 let a = Array.of_list (List.rev l) in
2193 state.outlines <- Oarray a;
2195 | Onarrow (pat, a, b) ->
2196 state.outlines <- Oarray b;
2197 state.text <- "";
2200 state.mode <- Outline (allowdel, 0, 0, outline, qsearch, pan, oldmode);
2201 Glut.postRedisplay ()
2203 | 12 ->
2204 state.mode <- Outline
2205 (allowdel, active, firstof active, outlines, qsearch, pan, oldmode);
2206 Glut.postRedisplay ()
2208 | 127 when allowdel ->
2209 let len = Array.length outlines - 1 in
2210 if len = 0
2211 then (
2212 state.mode <- View;
2213 state.bookmarks <- [];
2215 else (
2216 let bookmarks = Array.init len
2217 (fun i ->
2218 let i = if i >= active then i + 1 else i in
2219 outlines.(i)
2222 state.mode <-
2223 Outline (
2224 allowdel,
2225 min active (len-1),
2226 min first (len-1),
2227 bookmarks, qsearch,
2229 oldmode
2232 Glut.postRedisplay ()
2234 | _ -> dolog "unknown key %d" key
2237 let keyboard ~key ~x ~y =
2238 if key = 7
2239 then
2240 wcmd "interrupt" []
2241 else
2242 match state.mode with
2243 | Outline outline -> outlinekeyboard ~key ~x ~y outline
2244 | Textentry textentry -> textentrykeyboard ~key ~x ~y textentry
2245 | Birdseye birdseye -> birdseyekeyboard ~key ~x ~y birdseye
2246 | View -> viewkeyboard ~key ~x ~y
2247 | Items items -> itemskeyboard ~key ~x ~y items
2250 let birdseyespecial key x y
2251 ((conf, leftx, pageno, hooverpageno, anchor) as beye) =
2252 match key with
2253 | Glut.KEY_UP -> upbirdseye beye
2254 | Glut.KEY_DOWN -> downbirdseye beye
2256 | Glut.KEY_PAGE_UP ->
2257 begin match state.layout with
2258 | l :: _ ->
2259 if l.pagey != 0
2260 then (
2261 state.mode <- Birdseye (
2262 conf, leftx, l.pageno, hooverpageno, anchor
2264 gotopage1 l.pageno 0;
2266 else (
2267 let layout = layout (state.y-conf.winh) conf.winh in
2268 match layout with
2269 | [] -> gotoy (clamp (-conf.winh))
2270 | l :: _ ->
2271 state.mode <- Birdseye (
2272 conf, leftx, l.pageno, hooverpageno, anchor
2274 gotopage1 l.pageno 0
2277 | [] -> gotoy (clamp (-conf.winh))
2278 end;
2280 | Glut.KEY_PAGE_DOWN ->
2281 begin match List.rev state.layout with
2282 | l :: _ ->
2283 let layout = layout (state.y + conf.winh) conf.winh in
2284 begin match layout with
2285 | [] ->
2286 let incr = l.pageh - l.pagevh in
2287 if incr = 0
2288 then (
2289 state.mode <-
2290 Birdseye (
2291 conf, leftx, state.pagecount - 1, hooverpageno, anchor
2293 Glut.postRedisplay ();
2295 else gotoy (clamp (incr + conf.interpagespace*2));
2297 | l :: _ ->
2298 state.mode <-
2299 Birdseye (conf, leftx, l.pageno, hooverpageno, anchor);
2300 gotopage1 l.pageno 0;
2303 | [] -> gotoy (clamp conf.winh)
2304 end;
2306 | Glut.KEY_HOME ->
2307 state.mode <- Birdseye (conf, leftx, 0, hooverpageno, anchor);
2308 gotopage1 0 0
2310 | Glut.KEY_END ->
2311 let pageno = state.pagecount - 1 in
2312 state.mode <- Birdseye (conf, leftx, pageno, hooverpageno, anchor);
2313 if not (pagevisible state.layout pageno)
2314 then
2315 let h =
2316 match List.rev state.pdims with
2317 | [] -> conf.winh
2318 | (_, _, h, _) :: _ -> h
2320 gotoy (max 0 (getpagey pageno - (conf.winh - h - conf.interpagespace)))
2321 else Glut.postRedisplay ();
2322 | _ -> ()
2325 let setautoscrollspeed goingdown =
2326 let incr = max 1 (state.ascrollstep / 2) in
2327 let astep = max 1 (state.ascrollstep + (if goingdown then incr else -incr)) in
2328 state.ascrollstep <- astep;
2331 let special ~key ~x ~y =
2332 match state.mode with
2333 | View | (Birdseye _) when key = Glut.KEY_F9 ->
2334 togglebirdseye ()
2336 | Birdseye vals ->
2337 birdseyespecial key x y vals
2339 | View when key = Glut.KEY_F1 ->
2340 enterhelpmode ()
2342 | View ->
2343 if state.ascrollstep > 0 && (key = Glut.KEY_DOWN || key = Glut.KEY_UP)
2344 then setautoscrollspeed (key = Glut.KEY_DOWN)
2345 else
2346 let y =
2347 match key with
2348 | Glut.KEY_F3 -> search state.searchpattern true; state.y
2349 | Glut.KEY_UP -> clamp (-conf.scrollstep)
2350 | Glut.KEY_DOWN -> clamp conf.scrollstep
2351 | Glut.KEY_PAGE_UP ->
2352 if Glut.getModifiers () land Glut.active_ctrl != 0
2353 then
2354 match state.layout with
2355 | [] -> state.y
2356 | l :: _ -> state.y - l.pagey
2357 else
2358 clamp (-conf.winh)
2359 | Glut.KEY_PAGE_DOWN ->
2360 if Glut.getModifiers () land Glut.active_ctrl != 0
2361 then
2362 match List.rev state.layout with
2363 | [] -> state.y
2364 | l :: _ -> getpagey l.pageno
2365 else
2366 clamp conf.winh
2367 | Glut.KEY_HOME -> addnav (); 0
2368 | Glut.KEY_END ->
2369 addnav ();
2370 state.maxy - (if conf.maxhfit then conf.winh else 0)
2372 | Glut.KEY_RIGHT when conf.zoom > 1.0 ->
2373 state.x <- state.x - 10;
2374 state.y
2375 | Glut.KEY_LEFT when conf.zoom > 1.0 ->
2376 state.x <- state.x + 10;
2377 state.y
2379 | _ -> state.y
2381 gotoy_and_clear_text y
2383 | Textentry
2384 ((c, s, (Some (action, _) as onhist), onkey, ondone), mode) ->
2385 let s =
2386 match key with
2387 | Glut.KEY_UP -> action HCprev
2388 | Glut.KEY_DOWN -> action HCnext
2389 | Glut.KEY_HOME -> action HCfirst
2390 | Glut.KEY_END -> action HClast
2391 | _ -> state.text
2393 state.mode <- Textentry ((c, s, onhist, onkey, ondone), mode);
2394 Glut.postRedisplay ()
2396 | Textentry _ -> ()
2398 | Items (active, first, items, qsearch, pan, oldmode) ->
2399 let maxrows = maxoutlinerows () in
2400 let itemcount = Array.length items in
2401 let hasaction = function
2402 | (_, _, Noaction) -> false
2403 | _ -> true
2405 let find start incr =
2406 let rec find i =
2407 if i = -1 || i = itemcount
2408 then -1
2409 else (
2410 if hasaction items.(i)
2411 then i
2412 else find (i + incr)
2415 find start
2417 let set active first =
2418 let first = max 0 (min first (itemcount - maxrows)) in
2419 state.mode <- Items (active, first, items, qsearch, pan, oldmode)
2421 let navigate incr =
2422 let isvisible first n = n >= first && n - first <= maxrows in
2423 let active, first =
2424 let incr1 = if incr > 0 then 1 else -1 in
2425 if isvisible first active
2426 then
2427 let next =
2428 let next = active + incr in
2429 let next =
2430 if next < 0 || next >= itemcount
2431 then -1
2432 else find next incr1
2434 if next = -1 || abs (active - next) > maxrows
2435 then -1
2436 else next
2438 if next = -1
2439 then
2440 let first = first + incr in
2441 let first = max 0 (min first (itemcount - 1)) in
2442 let next =
2443 let next = active + incr in
2444 let next = max 0 (min next (itemcount - 1)) in
2445 find next ~-incr1
2447 let active = if next = -1 then active else next in
2448 active, first
2449 else
2450 let first = min next first in
2451 next, first
2452 else
2453 let first = first + incr in
2454 let first = max 0 (min first (itemcount - 1)) in
2455 let active =
2456 let next = active + incr in
2457 let next = max 0 (min next (itemcount - 1)) in
2458 let next = find next incr1 in
2459 if next = -1 || abs (active - first) > maxrows
2460 then active
2461 else next
2463 active, first
2465 set active first;
2466 Glut.postRedisplay ()
2468 begin match key with
2469 | Glut.KEY_UP -> navigate ~-1
2470 | Glut.KEY_DOWN -> navigate 1
2471 | Glut.KEY_PAGE_UP -> navigate ~-maxrows
2472 | Glut.KEY_PAGE_DOWN -> navigate maxrows
2474 | Glut.KEY_RIGHT ->
2475 state.mode <- Items (
2476 active, first, items, qsearch, min 0 (pan - 1), oldmode
2478 Glut.postRedisplay ()
2480 | Glut.KEY_LEFT ->
2481 state.mode <- Items (
2482 active, first, items, qsearch, min 0 (pan + 1), oldmode
2484 Glut.postRedisplay ()
2486 | Glut.KEY_HOME ->
2487 let active = find 0 1 in
2488 set active 0;
2489 Glut.postRedisplay ()
2491 | Glut.KEY_END ->
2492 let first = max 0 (itemcount - maxrows) in
2493 let active = find (itemcount - 1) ~-1 in
2494 set active first;
2495 Glut.postRedisplay ()
2497 | _ -> ()
2498 end;
2500 | Outline (allowdel, active, first, outlines, qsearch, pan, oldmode) ->
2501 let maxrows = maxoutlinerows () in
2502 let calcfirst first active =
2503 if active > first
2504 then
2505 let rows = active - first in
2506 if rows > maxrows then active - maxrows else first
2507 else active
2509 let navigate incr =
2510 let active = active + incr in
2511 let active = max 0 (min active (Array.length outlines - 1)) in
2512 let first = calcfirst first active in
2513 state.mode <- Outline (
2514 allowdel, active, first, outlines, qsearch, pan, oldmode
2516 Glut.postRedisplay ()
2518 let updownlevel incr =
2519 let len = Array.length outlines in
2520 let (_, curlevel, _, _) = outlines.(active) in
2521 let rec flow i =
2522 if i = len then i-1 else if i = -1 then 0 else
2523 let (_, l, _, _) = outlines.(i) in
2524 if l != curlevel then i else flow (i+incr)
2526 let active = flow active in
2527 let first = calcfirst first active in
2528 state.mode <- Outline (
2529 allowdel, active, first, outlines, qsearch, pan, oldmode
2531 Glut.postRedisplay ()
2533 match key with
2534 | Glut.KEY_UP -> navigate ~-1
2535 | Glut.KEY_DOWN -> navigate 1
2536 | Glut.KEY_PAGE_UP -> navigate ~-maxrows
2537 | Glut.KEY_PAGE_DOWN -> navigate maxrows
2539 | Glut.KEY_RIGHT ->
2540 if Glut.getModifiers () land Glut.active_ctrl != 0
2541 then (
2542 state.mode <- Outline (
2543 allowdel, active, first, outlines,
2544 qsearch, min 0 (pan - 1), oldmode
2546 Glut.postRedisplay ();
2548 else (
2549 if not allowdel
2550 then updownlevel 1
2553 | Glut.KEY_LEFT ->
2554 if Glut.getModifiers () land Glut.active_ctrl != 0
2555 then (
2556 state.mode <- Outline (
2557 allowdel, active, first, outlines, qsearch, pan + 1, oldmode
2559 Glut.postRedisplay ();
2561 else (
2562 if not allowdel
2563 then updownlevel ~-1
2566 | Glut.KEY_HOME ->
2567 state.mode <- Outline (
2568 allowdel, 0, 0, outlines, qsearch, pan, oldmode
2570 Glut.postRedisplay ()
2572 | Glut.KEY_END ->
2573 let active = Array.length outlines - 1 in
2574 let first = max 0 (active - maxrows) in
2575 state.mode <- Outline (
2576 allowdel, active, first, outlines, qsearch, pan, oldmode
2578 Glut.postRedisplay ()
2580 | _ -> ()
2583 let drawplaceholder l =
2584 let margin = state.x + (conf.winw - (state.w + conf.scrollw)) / 2 in
2585 GlDraw.rect
2586 (float l.pagex, float l.pagedispy)
2587 (float (l.pagew + l.pagex), float (l.pagedispy + l.pagevh))
2589 let x = float (if margin < 0 then -margin else l.pagex)
2590 and y = float (l.pagedispy + 13) in
2591 let font = Glut.BITMAP_8_BY_13 in
2592 GlDraw.color (0.0, 0.0, 0.0);
2593 GlPix.raster_pos ~x ~y ();
2594 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c))
2595 ("Loading " ^ string_of_int (l.pageno + 1));
2598 let now () = Unix.gettimeofday ();;
2600 let drawpage l =
2601 let color =
2602 match state.mode with
2603 | Textentry _ -> scalecolor 0.4
2604 | View | Outline _ | Items _ -> scalecolor 1.0
2605 | Birdseye (_, _, pageno, hooverpageno, _) ->
2606 if l.pageno = hooverpageno
2607 then scalecolor 0.9
2608 else (
2609 if l.pageno = pageno
2610 then scalecolor 1.0
2611 else scalecolor 0.8
2614 GlDraw.color color;
2615 begin match getopaque l.pageno with
2616 | Some (opaque, _) when validopaque opaque ->
2617 let a = now () in
2618 draw (l.pagedispy, l.pagew, l.pagevh, l.pagey, conf.hlinks)
2619 opaque;
2620 let b = now () in
2621 let d = b-.a in
2622 vlog "draw %d %f sec" l.pageno d;
2624 | _ ->
2625 drawplaceholder l;
2626 end;
2629 let scrollph y =
2630 let maxy = state.maxy - (if conf.maxhfit then conf.winh else 0) in
2631 let sh = (float (maxy + conf.winh) /. float conf.winh) in
2632 let sh = float conf.winh /. sh in
2633 let sh = max sh (float conf.scrollh) in
2635 let percent =
2636 if state.y = state.maxy
2637 then 1.0
2638 else float y /. float maxy
2640 let position = (float conf.winh -. sh) *. percent in
2642 let position =
2643 if position +. sh > float conf.winh
2644 then float conf.winh -. sh
2645 else position
2647 position, sh;
2650 let scrollindicator () =
2651 GlDraw.color (0.64 , 0.64, 0.64);
2652 GlDraw.rect
2653 (float (conf.winw - conf.scrollw), 0.)
2654 (float conf.winw, float conf.winh)
2656 GlDraw.color (0.0, 0.0, 0.0);
2658 let position, sh = scrollph state.y in
2659 GlDraw.rect
2660 (float (conf.winw - conf.scrollw), position)
2661 (float conf.winw, position +. sh)
2665 let showsel margin =
2666 match state.mstate with
2667 | Mnone | Mscroll _ | Mpan _ | Mzoom _ ->
2670 | Msel ((x0, y0), (x1, y1)) ->
2671 let rec loop = function
2672 | l :: ls ->
2673 if (y0 >= l.pagedispy && y0 <= (l.pagedispy + l.pagevh))
2674 || ((y1 >= l.pagedispy && y1 <= (l.pagedispy + l.pagevh)))
2675 then
2676 match getopaque l.pageno with
2677 | Some (opaque, _) when validopaque opaque ->
2678 let oy = -l.pagey + l.pagedispy in
2679 seltext opaque
2680 (x0 - margin - state.x, y0,
2681 x1 - margin - state.x, y1) oy;
2683 | _ -> ()
2684 else loop ls
2685 | [] -> ()
2687 loop state.layout
2690 let showrects () =
2691 let panx = float state.x in
2692 Gl.enable `blend;
2693 GlDraw.color (0.0, 0.0, 1.0) ~alpha:0.5;
2694 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
2695 List.iter
2696 (fun (pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)) ->
2697 List.iter (fun l ->
2698 if l.pageno = pageno
2699 then (
2700 let d = float (l.pagedispy - l.pagey) in
2701 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~alpha:0.5;
2702 GlDraw.begins `quads;
2704 GlDraw.vertex2 (x0+.panx, y0+.d);
2705 GlDraw.vertex2 (x1+.panx, y1+.d);
2706 GlDraw.vertex2 (x2+.panx, y2+.d);
2707 GlDraw.vertex2 (x3+.panx, y3+.d);
2709 GlDraw.ends ();
2711 ) state.layout
2712 ) state.rects
2714 Gl.disable `blend;
2717 let showoutline (allowdel, active, first, outlines, qsearch, pan, oldmode) =
2718 Gl.enable `blend;
2719 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
2720 GlDraw.color (0., 0., 0.) ~alpha:0.85;
2721 GlDraw.rect (0., 0.) (float conf.winw, float conf.winh);
2722 Gl.disable `blend;
2724 GlDraw.color (1., 1., 1.);
2725 let font = Glut.BITMAP_9_BY_15 in
2726 let draw_string x y s =
2727 GlPix.raster_pos ~x ~y ();
2728 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
2730 let rec loop row =
2731 if row = Array.length outlines || (row - first) * 16 > conf.winh
2732 then ()
2733 else (
2734 let (s, level, _, _) = outlines.(row) in
2735 let y = (row - first) * 16 in
2736 let x = 5 + 15*(max 0 (level+pan)) in
2737 if row = active
2738 then (
2739 Gl.enable `blend;
2740 GlDraw.polygon_mode `both `line;
2741 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
2742 GlDraw.color (1., 1., 1.) ~alpha:0.9;
2743 GlDraw.rect (0., float (y + 1))
2744 (float (conf.winw - 1), float (y + 18));
2745 GlDraw.polygon_mode `both `fill;
2746 Gl.disable `blend;
2747 GlDraw.color (1., 1., 1.);
2749 let draw_string s =
2750 let l = String.length s in
2751 if pan < 0
2752 then (
2753 let pan = pan * 2 in
2754 let left = l + pan in
2755 if left > 0
2756 then
2757 let s = String.sub s (-pan) left in
2758 draw_string (float x) (float (y + 16)) s
2760 else
2761 draw_string (float (x + pan*15)) (float (y + 16)) s
2763 draw_string s;
2764 loop (row+1)
2767 loop first
2770 let showitems (active, first, items, qsearch, pan, oldmode) =
2771 Gl.enable `blend;
2772 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
2773 GlDraw.color (0., 0., 0.) ~alpha:0.90;
2774 GlDraw.rect (0., 0.) (float conf.winw, float conf.winh);
2775 Gl.disable `blend;
2777 GlDraw.color (1., 1., 1.);
2778 let font = Glut.BITMAP_9_BY_15 in
2779 let draw_string x y s =
2780 GlPix.raster_pos ~x ~y ();
2781 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
2783 let rec loop row =
2784 if row = Array.length items || (row - first) * 16 > conf.winh
2785 then ()
2786 else (
2787 let (s, l, a) = items.(row) in
2788 let y = (row - first) * 16 in
2789 let x = 5 + (max 0 (l+pan))*15 in
2790 if row = active && a <> Noaction
2791 then (
2792 Gl.enable `blend;
2793 GlDraw.polygon_mode `both `line;
2794 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
2795 GlDraw.color (1., 1., 1.) ~alpha:0.9;
2796 GlDraw.rect (0., float (y + 1))
2797 (float (conf.winw - 1), float (y + 18));
2798 GlDraw.polygon_mode `both `fill;
2799 Gl.disable `blend;
2800 GlDraw.color (1., 1., 1.);
2802 let draw_string s =
2803 let l = String.length s in
2804 if pan < 0
2805 then (
2806 let pan = pan * 2 in
2807 let left = l + pan in
2808 if left > 0
2809 then
2810 let s = String.sub s (-pan) left in
2811 draw_string (float x) (float (y + 16)) s
2813 else
2814 draw_string (float (x + pan*15)) (float (y + 16)) s
2816 draw_string s;
2817 loop (row+1)
2820 loop first
2823 let display () =
2824 let margin = (conf.winw - (state.w + conf.scrollw)) / 2 in
2825 GlDraw.viewport margin 0 state.w conf.winh;
2826 pagematrix ();
2827 GlClear.color (scalecolor2 conf.bgcolor);
2828 GlClear.clear [`color];
2829 if conf.zoom > 1.0
2830 then (
2831 Gl.enable `scissor_test;
2832 GlMisc.scissor 0 0 (conf.winw - conf.scrollw) conf.winh;
2834 List.iter drawpage state.layout;
2835 if conf.zoom > 1.0
2836 then
2837 Gl.disable `scissor_test
2839 if state.x != 0
2840 then (
2841 let x = -.float state.x in
2842 GlMat.translate ~x ();
2844 showrects ();
2845 showsel margin;
2846 GlDraw.viewport 0 0 conf.winw conf.winh;
2847 winmatrix ();
2848 scrollindicator ();
2849 begin match state.mode with
2850 | Items items -> showitems items
2851 | Outline outline -> showoutline outline
2852 | _ -> ()
2853 end;
2854 enttext ();
2855 Glut.swapBuffers ();
2858 let getunder x y =
2859 let margin = (conf.winw - (state.w + conf.scrollw)) / 2 in
2860 let x = x - margin - state.x in
2861 let rec f = function
2862 | l :: rest ->
2863 begin match getopaque l.pageno with
2864 | Some (opaque, _) when validopaque opaque ->
2865 let y = y - l.pagedispy in
2866 if y > 0
2867 then
2868 let y = l.pagey + y in
2869 let x = x - l.pagex in
2870 match whatsunder opaque x y with
2871 | Unone -> f rest
2872 | under -> under
2873 else
2874 f rest
2875 | _ ->
2876 f rest
2878 | [] -> Unone
2880 f state.layout
2883 let viewmouse button bstate x y =
2884 match button with
2885 | Glut.OTHER_BUTTON n when (n == 3 || n == 4) && bstate = Glut.UP ->
2886 if Glut.getModifiers () land Glut.active_ctrl != 0
2887 then (
2888 match state.mstate with
2889 | Mzoom (oldn, i) ->
2890 if oldn = n
2891 then (
2892 if i = 2
2893 then
2894 let incr =
2895 match n with
2896 | 4 ->
2897 if conf.zoom +. 0.01 > 0.1 then 0.1 else 0.01
2898 | _ ->
2899 if conf.zoom -. 0.1 < 0.1 then -0.01 else -0.1
2901 let zoom = conf.zoom +. incr in
2902 setzoom zoom;
2903 state.mstate <- Mzoom (n, 0);
2904 else
2905 state.mstate <- Mzoom (n, i+1);
2907 else state.mstate <- Mzoom (n, 0)
2909 | _ -> state.mstate <- Mzoom (n, 0)
2911 else (
2912 if state.ascrollstep > 0
2913 then
2914 setautoscrollspeed (n=4)
2915 else
2916 let incr =
2917 if n = 3
2918 then -conf.scrollstep
2919 else conf.scrollstep
2921 let incr = incr * 2 in
2922 let y = clamp incr in
2923 gotoy_and_clear_text y
2926 | Glut.LEFT_BUTTON when Glut.getModifiers () land Glut.active_ctrl != 0 ->
2927 if bstate = Glut.DOWN
2928 then (
2929 Glut.setCursor Glut.CURSOR_CROSSHAIR;
2930 state.mstate <- Mpan (x, y)
2932 else
2933 state.mstate <- Mnone
2935 | Glut.LEFT_BUTTON when x > conf.winw - conf.scrollw ->
2936 if bstate = Glut.DOWN
2937 then
2938 let position, sh = scrollph state.y in
2939 if y > truncate position && y < truncate (position +. sh)
2940 then
2941 state.mstate <- Mscroll
2942 else
2943 let percent = float y /. float conf.winh in
2944 let desty = truncate (float (state.maxy - conf.winh) *. percent) in
2945 gotoy desty;
2946 state.mstate <- Mscroll
2947 else
2948 state.mstate <- Mnone
2950 | Glut.LEFT_BUTTON ->
2951 let dest = if bstate = Glut.DOWN then getunder x y else Unone in
2952 begin match dest with
2953 | Ulinkgoto (pageno, top) ->
2954 if pageno >= 0
2955 then (
2956 addnav ();
2957 gotopage1 pageno top;
2960 | Ulinkuri s ->
2961 print_endline s
2963 | Unone when bstate = Glut.DOWN ->
2964 Glut.setCursor Glut.CURSOR_CROSSHAIR;
2965 state.mstate <- Mpan (x, y);
2967 | Unone | Utext _ ->
2968 if bstate = Glut.DOWN
2969 then (
2970 if conf.angle mod 360 = 0
2971 then (
2972 state.mstate <- Msel ((x, y), (x, y));
2973 Glut.postRedisplay ()
2976 else (
2977 match state.mstate with
2978 | Mnone -> ()
2980 | Mzoom _ | Mscroll ->
2981 state.mstate <- Mnone
2983 | Mpan _ ->
2984 Glut.setCursor Glut.CURSOR_INHERIT;
2985 state.mstate <- Mnone
2987 | Msel ((x0, y0), (x1, y1)) ->
2988 let f l =
2989 if (y0 >= l.pagedispy && y0 <= (l.pagedispy + l.pagevh))
2990 || ((y1 >= l.pagedispy && y1 <= (l.pagedispy + l.pagevh)))
2991 then
2992 match getopaque l.pageno with
2993 | Some (opaque, _) when validopaque opaque ->
2994 copysel opaque
2995 | _ -> ()
2997 List.iter f state.layout;
2998 copysel ""; (* ugly *)
2999 Glut.setCursor Glut.CURSOR_INHERIT;
3000 state.mstate <- Mnone;
3004 | _ -> ()
3007 let birdseyemouse button bstate x y
3008 (conf, leftx, pageno, hooverpageno, anchor) =
3009 match button with
3010 | Glut.LEFT_BUTTON when bstate = Glut.UP ->
3011 let margin = (conf.winw - (state.w + conf.scrollw)) / 2 in
3012 let rec loop = function
3013 | [] -> ()
3014 | l :: rest ->
3015 if y > l.pagedispy && y < l.pagedispy + l.pagevh
3016 && x > margin && x < margin + l.pagew
3017 then (
3018 leavebirdseye (conf, leftx, l.pageno, hooverpageno, anchor) false;
3020 else loop rest
3022 loop state.layout
3023 | Glut.OTHER_BUTTON _ -> viewmouse button bstate x y
3024 | _ -> ()
3027 let mouse bstate button x y =
3028 match state.mode with
3029 | View -> viewmouse button bstate x y
3030 | Birdseye beye -> birdseyemouse button bstate x y beye
3031 | Textentry _ | Outline _ | Items _ -> ()
3034 let mouse ~button ~state ~x ~y = mouse state button x y;;
3036 let motion ~x ~y =
3037 match state.mode with
3038 | Outline _ -> ()
3039 | _ ->
3040 match state.mstate with
3041 | Mzoom _ | Mnone -> ()
3043 | Mpan (x0, y0) ->
3044 let dx = x - x0
3045 and dy = y0 - y in
3046 state.mstate <- Mpan (x, y);
3047 if conf.zoom > 1.0 then state.x <- state.x + dx;
3048 let y = clamp dy in
3049 gotoy_and_clear_text y
3051 | Msel (a, _) ->
3052 state.mstate <- Msel (a, (x, y));
3053 Glut.postRedisplay ()
3055 | Mscroll ->
3056 let y = min conf.winh (max 0 y) in
3057 let percent = float y /. float conf.winh in
3058 let y = truncate (float (state.maxy - conf.winh) *. percent) in
3059 gotoy_and_clear_text y
3062 let pmotion ~x ~y =
3063 match state.mode with
3064 | Birdseye (conf, leftx, pageno, hooverpageno, anchor) ->
3065 let margin = (conf.winw - (state.w + conf.scrollw)) / 2 in
3066 let rec loop = function
3067 | [] ->
3068 if hooverpageno != -1
3069 then (
3070 state.mode <- Birdseye (conf, leftx, pageno, -1, anchor);
3071 Glut.postRedisplay ();
3073 | l :: rest ->
3074 if y > l.pagedispy && y < l.pagedispy + l.pagevh
3075 && x > margin && x < margin + l.pagew
3076 then (
3077 state.mode <- Birdseye (conf, leftx, pageno, l.pageno, anchor);
3078 Glut.postRedisplay ();
3080 else loop rest
3082 loop state.layout
3084 | Outline _ -> ()
3085 | _ ->
3086 match state.mstate with
3087 | Mnone ->
3088 begin match getunder x y with
3089 | Unone -> Glut.setCursor Glut.CURSOR_INHERIT
3090 | Ulinkuri uri ->
3091 if conf.underinfo then showtext 'u' ("ri: " ^ uri);
3092 Glut.setCursor Glut.CURSOR_INFO
3093 | Ulinkgoto (page, y) ->
3094 if conf.underinfo
3095 then showtext 'p' ("age: " ^ string_of_int page);
3096 Glut.setCursor Glut.CURSOR_INFO
3097 | Utext s ->
3098 if conf.underinfo then showtext 'f' ("ont: " ^ s);
3099 Glut.setCursor Glut.CURSOR_TEXT
3102 | Mpan _ | Msel _ | Mzoom _ | Mscroll ->
3107 module State =
3108 struct
3109 open Parser
3111 let home =
3113 match Sys.os_type with
3114 | "Win32" -> Sys.getenv "HOMEPATH"
3115 | _ -> Sys.getenv "HOME"
3116 with exn ->
3117 prerr_endline
3118 ("Can not determine home directory location: " ^
3119 Printexc.to_string exn);
3123 let color_of_string s =
3124 Scanf.sscanf s "%d/%d/%d" (fun r g b ->
3125 (float r /. 256.0, float g /. 256.0, float b /. 256.0)
3129 let config_of c attrs =
3130 let apply c k v =
3132 match k with
3133 | "scroll-bar-width" -> { c with scrollw = max 0 (int_of_string v) }
3134 | "scroll-handle-height" -> { c with scrollh = max 0 (int_of_string v) }
3135 | "case-insensitive-search" -> { c with icase = bool_of_string v }
3136 | "preload" -> { c with preload = bool_of_string v }
3137 | "page-bias" -> { c with pagebias = int_of_string v }
3138 | "scroll-step" -> { c with scrollstep = max 1 (int_of_string v) }
3139 | "auto-scroll-step" ->
3140 { c with autoscrollstep = max 0 (int_of_string v) }
3141 | "max-height-fit" -> { c with maxhfit = bool_of_string v }
3142 | "crop-hack" -> { c with crophack = bool_of_string v }
3143 | "throttle" -> { c with showall = bool_of_string v }
3144 | "highlight-links" -> { c with hlinks = bool_of_string v }
3145 | "under-cursor-info" -> { c with underinfo = bool_of_string v }
3146 | "vertical-margin" ->
3147 { c with interpagespace = max 0 (int_of_string v) }
3148 | "zoom" ->
3149 let zoom = float_of_string v /. 100. in
3150 let zoom = max 0.01 (min 2.2 zoom) in
3151 { c with zoom = zoom }
3152 | "presentation" -> { c with presentation = bool_of_string v }
3153 | "rotation-angle" -> { c with angle = int_of_string v }
3154 | "width" -> { c with winw = max 20 (int_of_string v) }
3155 | "height" -> { c with winh = max 20 (int_of_string v) }
3156 | "persistent-bookmarks" -> { c with savebmarks = bool_of_string v }
3157 | "proportional-display" -> { c with proportional = bool_of_string v }
3158 | "pixmap-cache-size" -> { c with memlimit = max 2 (int_of_string v) }
3159 | "tex-count" -> { c with texcount = max 1 (int_of_string v) }
3160 | "slice-height" -> { c with sliceheight = max 2 (int_of_string v) }
3161 | "thumbnail-width" -> { c with thumbw = max 2 (int_of_string v) }
3162 | "persistent-location" -> { c with jumpback = bool_of_string v }
3163 | "background-color" -> { c with bgcolor = color_of_string v }
3164 | _ -> c
3165 with exn ->
3166 prerr_endline ("Error processing attribute (`" ^
3167 k ^ "'=`" ^ v ^ "'): " ^ Printexc.to_string exn);
3170 let rec fold c = function
3171 | [] -> c
3172 | (k, v) :: rest ->
3173 let c = apply c k v in
3174 fold c rest
3176 fold c attrs;
3179 let fromstring f pos n v d =
3180 try f v
3181 with exn ->
3182 dolog "Error processing attribute (%S=%S) at %d\n%s"
3183 n v pos (Printexc.to_string exn)
3188 let bookmark_of attrs =
3189 let rec fold title page rely = function
3190 | ("title", v) :: rest -> fold v page rely rest
3191 | ("page", v) :: rest -> fold title v rely rest
3192 | ("rely", v) :: rest -> fold title page v rest
3193 | _ :: rest -> fold title page rely rest
3194 | [] -> title, page, rely
3196 fold "invalid" "0" "0" attrs
3199 let doc_of attrs =
3200 let rec fold path page rely pan = function
3201 | ("path", v) :: rest -> fold v page rely pan rest
3202 | ("page", v) :: rest -> fold path v rely pan rest
3203 | ("rely", v) :: rest -> fold path page v pan rest
3204 | ("pan", v) :: rest -> fold path page rely v rest
3205 | _ :: rest -> fold path page rely pan rest
3206 | [] -> path, page, rely, pan
3208 fold "" "0" "0" "0" attrs
3211 let setconf dst src =
3212 dst.scrollw <- src.scrollw;
3213 dst.scrollh <- src.scrollh;
3214 dst.icase <- src.icase;
3215 dst.preload <- src.preload;
3216 dst.pagebias <- src.pagebias;
3217 dst.verbose <- src.verbose;
3218 dst.scrollstep <- src.scrollstep;
3219 dst.maxhfit <- src.maxhfit;
3220 dst.crophack <- src.crophack;
3221 dst.autoscrollstep <- src.autoscrollstep;
3222 dst.showall <- src.showall;
3223 dst.hlinks <- src.hlinks;
3224 dst.underinfo <- src.underinfo;
3225 dst.interpagespace <- src.interpagespace;
3226 dst.zoom <- src.zoom;
3227 dst.presentation <- src.presentation;
3228 dst.angle <- src.angle;
3229 dst.winw <- src.winw;
3230 dst.winh <- src.winh;
3231 dst.savebmarks <- src.savebmarks;
3232 dst.memlimit <- src.memlimit;
3233 dst.proportional <- src.proportional;
3234 dst.texcount <- src.texcount;
3235 dst.sliceheight <- src.sliceheight;
3236 dst.thumbw <- src.thumbw;
3237 dst.jumpback <- src.jumpback;
3238 dst.bgcolor <- src.bgcolor;
3241 let unent s =
3242 let l = String.length s in
3243 let b = Buffer.create l in
3244 unent b s 0 l;
3245 Buffer.contents b;
3248 let get s =
3249 let h = Hashtbl.create 10 in
3250 let dc = { defconf with angle = defconf.angle } in
3251 let rec toplevel v t spos epos =
3252 match t with
3253 | Vdata | Vcdata | Vend -> v
3254 | Vopen ("llppconfig", attrs, closed) ->
3255 if closed
3256 then v
3257 else { v with f = llppconfig }
3258 | Vopen _ ->
3259 error "unexpected subelement at top level" s spos
3260 | Vclose tag -> error "unexpected close at top level" s spos
3262 and llppconfig v t spos epos =
3263 match t with
3264 | Vdata | Vcdata | Vend -> v
3265 | Vopen ("defaults", attrs, closed) ->
3266 let c = config_of dc attrs in
3267 setconf dc c;
3268 if closed
3269 then v
3270 else { v with f = skip "defaults" (fun () -> v) }
3272 | Vopen ("doc", attrs, closed) ->
3273 let pathent, spage, srely, span = doc_of attrs in
3274 let path = unent pathent
3275 and pageno = fromstring int_of_string spos "page" spage 0
3276 and rely = fromstring float_of_string spos "rely" srely 0.0
3277 and pan = fromstring int_of_string spos "pan" span 0 in
3278 let c = config_of dc attrs in
3279 let anchor = (pageno, rely) in
3280 if closed
3281 then (Hashtbl.add h path (c, [], pan, anchor); v)
3282 else { v with f = doc path pan anchor c [] }
3284 | Vopen (tag, _, closed) ->
3285 error "unexpected subelement in llppconfig" s spos
3287 | Vclose "llppconfig" -> { v with f = toplevel }
3288 | Vclose tag -> error "unexpected close in llppconfig" s spos
3290 and doc path pan anchor c bookmarks v t spos epos =
3291 match t with
3292 | Vdata | Vcdata -> v
3293 | Vend -> error "unexpected end of input in doc" s spos
3294 | Vopen ("bookmarks", attrs, closed) ->
3295 { v with f = pbookmarks path pan anchor c bookmarks }
3297 | Vopen (tag, _, _) ->
3298 error "unexpected subelement in doc" s spos
3300 | Vclose "doc" ->
3301 Hashtbl.add h path (c, List.rev bookmarks, pan, anchor);
3302 { v with f = llppconfig }
3304 | Vclose tag -> error "unexpected close in doc" s spos
3306 and pbookmarks path pan anchor c bookmarks v t spos epos =
3307 match t with
3308 | Vdata | Vcdata -> v
3309 | Vend -> error "unexpected end of input in bookmarks" s spos
3310 | Vopen ("item", attrs, closed) ->
3311 let titleent, spage, srely = bookmark_of attrs in
3312 let page = fromstring int_of_string spos "page" spage 0
3313 and rely = fromstring float_of_string spos "rely" srely 0.0 in
3314 let bookmarks = (unent titleent, 0, page, rely) :: bookmarks in
3315 if closed
3316 then { v with f = pbookmarks path pan anchor c bookmarks }
3317 else
3318 let f () = v in
3319 { v with f = skip "item" f }
3321 | Vopen _ ->
3322 error "unexpected subelement in bookmarks" s spos
3324 | Vclose "bookmarks" ->
3325 { v with f = doc path pan anchor c bookmarks }
3327 | Vclose tag -> error "unexpected close in bookmarks" s spos
3329 and skip tag f v t spos epos =
3330 match t with
3331 | Vdata | Vcdata -> v
3332 | Vend ->
3333 error ("unexpected end of input in skipped " ^ tag) s spos
3334 | Vopen (tag', _, closed) ->
3335 if closed
3336 then v
3337 else
3338 let f' () = { v with f = skip tag f } in
3339 { v with f = skip tag' f' }
3340 | Vclose ctag ->
3341 if tag = ctag
3342 then f ()
3343 else error ("unexpected close in skipped " ^ tag) s spos
3346 parse { f = toplevel; accu = () } s;
3347 h, dc;
3350 let do_load f ic =
3352 let len = in_channel_length ic in
3353 let s = String.create len in
3354 really_input ic s 0 len;
3355 f s;
3356 with
3357 | Parse_error (msg, s, pos) ->
3358 let subs = subs s pos in
3359 let s = Printf.sprintf "%s: at %d [..%s..]" msg pos subs in
3360 failwith ("parse error: " ^ s)
3362 | exn ->
3363 failwith ("config load error: " ^ Printexc.to_string exn)
3366 let path =
3367 let dir =
3369 let dir = Filename.concat home ".config" in
3370 if Sys.is_directory dir then dir else home
3371 with _ -> home
3373 Filename.concat dir "llpp.conf"
3376 let load1 f =
3377 if Sys.file_exists path
3378 then
3379 match
3380 (try Some (open_in_bin path)
3381 with exn ->
3382 prerr_endline
3383 ("Error opening configuation file `" ^ path ^ "': " ^
3384 Printexc.to_string exn);
3385 None
3387 with
3388 | Some ic ->
3389 begin try
3390 f (do_load get ic)
3391 with exn ->
3392 prerr_endline
3393 ("Error loading configuation from `" ^ path ^ "': " ^
3394 Printexc.to_string exn);
3395 end;
3396 close_in ic;
3398 | None -> ()
3399 else
3400 f (Hashtbl.create 0, defconf)
3403 let load () =
3404 let f (h, dc) =
3405 let pc, pb, px, pa =
3407 Hashtbl.find h (Filename.basename state.path)
3408 with Not_found -> dc, [], 0, (0, 0.0)
3410 setconf defconf dc;
3411 setconf conf pc;
3412 state.bookmarks <- pb;
3413 state.x <- px;
3414 if conf.jumpback
3415 then state.anchor <- pa;
3416 cbput state.hists.nav pa;
3418 load1 f
3421 let add_attrs bb always dc c =
3422 let ob s a b =
3423 if always || a != b
3424 then Printf.bprintf bb "\n %s='%b'" s a
3425 and oi s a b =
3426 if always || a != b
3427 then Printf.bprintf bb "\n %s='%d'" s a
3428 and oz s a b =
3429 if always || a <> b
3430 then Printf.bprintf bb "\n %s='%f'" s (a*.100.)
3431 and oc s a b =
3432 if always || a <> b
3433 then
3434 let r, g, b = a in
3435 let r = truncate (r *. 256.0)
3436 and g = truncate (r *. 256.0)
3437 and b = truncate (r *. 256.0) in
3438 Printf.bprintf bb "\n %s='%d/%d/%d'" s r g b
3440 let w, h =
3441 if always
3442 then dc.winw, dc.winh
3443 else
3444 match state.fullscreen with
3445 | Some wh -> wh
3446 | None -> c.winw, c.winh
3448 let zoom, presentation, interpagespace, showall=
3449 if always
3450 then dc.zoom, dc.presentation, dc.interpagespace, dc.showall
3451 else
3452 match state.mode with
3453 | Birdseye (bc, _, _, _, _) ->
3454 bc.zoom, bc.presentation, bc.interpagespace, bc.showall
3455 | _ -> c.zoom, c.presentation, c.interpagespace, c.showall
3457 oi "width" w dc.winw;
3458 oi "height" h dc.winh;
3459 oi "scroll-bar-width" c.scrollw dc.scrollw;
3460 oi "scroll-handle-height" c.scrollh dc.scrollh;
3461 ob "case-insensitive-search" c.icase dc.icase;
3462 ob "preload" c.preload dc.preload;
3463 oi "page-bias" c.pagebias dc.pagebias;
3464 oi "scroll-step" c.scrollstep dc.scrollstep;
3465 oi "auto-scroll-step" c.autoscrollstep dc.autoscrollstep;
3466 ob "max-height-fit" c.maxhfit dc.maxhfit;
3467 ob "crop-hack" c.crophack dc.crophack;
3468 ob "throttle" showall dc.showall;
3469 ob "highlight-links" c.hlinks dc.hlinks;
3470 ob "under-cursor-info" c.underinfo dc.underinfo;
3471 oi "vertical-margin" interpagespace dc.interpagespace;
3472 oz "zoom" zoom dc.zoom;
3473 ob "presentation" presentation dc.presentation;
3474 oi "rotation-angle" c.angle dc.angle;
3475 ob "persistent-bookmarks" c.savebmarks dc.savebmarks;
3476 ob "proportional-display" c.proportional dc.proportional;
3477 oi "pixmap-cache-size" c.memlimit dc.memlimit;
3478 oi "texcount" c.texcount dc.texcount;
3479 oi "slice-height" c.sliceheight dc.sliceheight;
3480 oi "thumbnail-width" c.thumbw dc.thumbw;
3481 ob "persistent-location" c.jumpback dc.jumpback;
3482 oc "background-color" c.bgcolor dc.bgcolor;
3485 let save () =
3486 let bb = Buffer.create 32768 in
3487 let f (h, dc) =
3488 Buffer.add_string bb "<llppconfig>\n<defaults ";
3489 add_attrs bb true dc dc;
3490 Buffer.add_string bb "/>\n";
3492 let adddoc path pan anchor c bookmarks =
3493 if bookmarks == [] && c = dc && anchor = emptyanchor
3494 then ()
3495 else (
3496 Printf.bprintf bb "<doc path='%s'"
3497 (enent path 0 (String.length path));
3499 if anchor <> emptyanchor
3500 then (
3501 let n, y = anchor in
3502 Printf.bprintf bb " page='%d'" n;
3503 if y > 1e-6
3504 then
3505 Printf.bprintf bb " rely='%f'" y
3509 if pan != 0
3510 then Printf.bprintf bb " pan='%d'" pan;
3512 add_attrs bb false dc c;
3514 begin match bookmarks with
3515 | [] -> Buffer.add_string bb "/>\n"
3516 | _ ->
3517 Buffer.add_string bb ">\n<bookmarks>\n";
3518 List.iter (fun (title, _level, page, rely) ->
3519 Printf.bprintf bb
3520 "<item title='%s' page='%d'"
3521 (enent title 0 (String.length title))
3522 page
3524 if rely > 1e-6
3525 then
3526 Printf.bprintf bb " rely='%f'" rely
3528 Buffer.add_string bb "/>\n";
3529 ) bookmarks;
3530 Buffer.add_string bb "</bookmarks>\n</doc>\n";
3531 end;
3535 let pan =
3536 match state.mode with
3537 | Birdseye (_, pan, _, _, _) -> pan
3538 | _ -> state.x
3540 let basename = Filename.basename state.path in
3541 adddoc basename pan (getanchor ())
3542 { conf with
3543 autoscrollstep =
3544 if state.ascrollstep > 0
3545 then state.ascrollstep
3546 else conf.autoscrollstep }
3547 (if conf.savebmarks then state.bookmarks else []);
3549 Hashtbl.iter (fun path (c, bookmarks, x, y) ->
3550 if basename <> path
3551 then adddoc path x y c bookmarks
3552 ) h;
3553 Buffer.add_string bb "</llppconfig>";
3555 load1 f;
3556 if Buffer.length bb > 0
3557 then
3559 let tmp = path ^ ".tmp" in
3560 let oc = open_out_bin tmp in
3561 Buffer.output_buffer oc bb;
3562 close_out oc;
3563 Sys.rename tmp path;
3564 with exn ->
3565 prerr_endline
3566 ("error while saving configuration: " ^ Printexc.to_string exn)
3568 end;;
3570 let () =
3571 Arg.parse
3572 (Arg.align
3573 [("-p", Arg.String (fun s -> state.password <- s) , " Set password")
3574 ;("-v", Arg.Unit (fun () -> print_endline Help.version; exit 0),
3575 " Print version and exit")]
3577 (fun s -> state.path <- s)
3578 ("Usage: " ^ Sys.argv.(0) ^ " [options] some.pdf\nOptions:")
3580 if String.length state.path = 0
3581 then (prerr_endline "file name missing"; exit 1);
3583 State.load ();
3585 let _ = Glut.init Sys.argv in
3586 let () = Glut.initDisplayMode ~depth:false ~double_buffer:true () in
3587 let () = Glut.initWindowSize conf.winw conf.winh in
3588 let _ = Glut.createWindow ("llpp " ^ Filename.basename state.path) in
3590 let csock, ssock =
3591 if Sys.os_type = "Unix"
3592 then
3593 Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
3594 else
3595 let addr = Unix.ADDR_INET (Unix.inet_addr_loopback, 1337) in
3596 let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
3597 Unix.setsockopt sock Unix.SO_REUSEADDR true;
3598 Unix.bind sock addr;
3599 Unix.listen sock 1;
3600 let csock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
3601 Unix.connect csock addr;
3602 let ssock, _ = Unix.accept sock in
3603 Unix.close sock;
3604 let opts sock =
3605 Unix.setsockopt sock Unix.TCP_NODELAY true;
3606 Unix.setsockopt_optint sock Unix.SO_LINGER None;
3608 opts ssock;
3609 opts csock;
3610 at_exit (fun () -> Unix.shutdown ssock Unix.SHUTDOWN_ALL);
3611 ssock, csock
3614 let () = Glut.displayFunc display in
3615 let () = Glut.reshapeFunc reshape in
3616 let () = Glut.keyboardFunc keyboard in
3617 let () = Glut.specialFunc special in
3618 let () = Glut.idleFunc (Some idle) in
3619 let () = Glut.mouseFunc mouse in
3620 let () = Glut.motionFunc motion in
3621 let () = Glut.passiveMotionFunc pmotion in
3623 init ssock (conf.angle, conf.proportional, conf.texcount, conf.sliceheight);
3624 state.csock <- csock;
3625 state.ssock <- ssock;
3626 state.text <- "Opening " ^ state.path;
3627 writeopen state.path state.password;
3629 at_exit State.save;
3631 let rec handlelablglutbug () =
3633 Glut.mainLoop ();
3634 with Glut.BadEnum "key in special_of_int" ->
3635 showtext '!' " LablGlut bug: special key not recognized";
3636 handlelablglutbug ()
3638 handlelablglutbug ();