Feed proper value to strerror after pthread_create failure
[llpp.git] / main.ml
blob816e04ebc1002829d4492437eb31fad803444a72
1 type under =
2 | Unone
3 | Ulinkuri of string
4 | Ulinkgoto of (int * int)
5 | Utext of facename
6 and facename = string;;
8 let log fmt = Printf.kprintf prerr_endline fmt;;
9 let dolog fmt = Printf.kprintf prerr_endline fmt;;
11 external init : Unix.file_descr -> unit = "ml_init";;
12 external draw : (int * int * int * int * bool) -> string -> unit = "ml_draw";;
13 external seltext : string -> (int * int * int * int) -> int -> unit =
14 "ml_seltext";;
15 external copysel : string -> unit = "ml_copysel";;
16 external getpagewh : int -> float array = "ml_getpagewh";;
17 external whatsunder : string -> int -> int -> under = "ml_whatsunder";;
19 type mstate = Msel of ((int * int) * (int * int)) | Mnone;;
21 type 'a circbuf =
22 { store : 'a array
23 ; mutable rc : int
24 ; mutable wc : int
25 ; mutable len : int
29 type textentry = (char * string * onhist option * onkey * ondone)
30 and onkey = string -> int -> te
31 and ondone = string -> unit
32 and onhist = histcmd -> string
33 and histcmd = HCnext | HCprev | HCfirst | HClast
34 and te =
35 | TEstop
36 | TEdone of string
37 | TEcont of string
38 | TEswitch of textentry
41 let cbnew n v =
42 { store = Array.create n v
43 ; rc = 0
44 ; wc = 0
45 ; len = 0
49 let cblen b = Array.length b.store;;
51 let cbput b v =
52 let len = cblen b in
53 b.store.(b.wc) <- v;
54 b.wc <- (b.wc + 1) mod len;
55 b.len <- min (b.len + 1) len;
58 let cbpeekw b = b.store.(b.wc);;
60 let cbget b dir =
61 if b.len = 0
62 then b.store.(0)
63 else
64 let rc = b.rc + dir in
65 let rc = if rc = -1 then b.len - 1 else rc in
66 let rc = if rc = b.len then 0 else rc in
67 b.rc <- rc;
68 b.store.(rc);
71 let cbrfollowlen b =
72 b.rc <- b.len;
75 let cbclear b v =
76 b.len <- 0;
77 Array.fill b.store 0 (Array.length b.store) v;
80 type layout =
81 { pageno : int
82 ; pagedimno : int
83 ; pagew : int
84 ; pageh : int
85 ; pagedispy : int
86 ; pagey : int
87 ; pagevh : int
91 type conf =
92 { mutable scrollw : int
93 ; mutable scrollh : int
94 ; mutable icase : bool
95 ; mutable preload : bool
96 ; mutable pagebias : int
97 ; mutable verbose : bool
98 ; mutable scrollincr : int
99 ; mutable maxhfit : bool
100 ; mutable crophack : bool
101 ; mutable autoscroll : bool
102 ; mutable showall : bool
103 ; mutable hlinks : bool
104 ; mutable underinfo : bool
108 type outline = string * int * int * float;;
109 type outlines =
110 | Oarray of outline array
111 | Olist of outline list
112 | Onarrow of outline array * outline array
115 type rect = (float * float * float * float * float * float * float * float);;
117 type state =
118 { mutable csock : Unix.file_descr
119 ; mutable ssock : Unix.file_descr
120 ; mutable w : int
121 ; mutable h : int
122 ; mutable rotate : int
123 ; mutable y : int
124 ; mutable ty : float
125 ; mutable maxy : int
126 ; mutable layout : layout list
127 ; pagemap : ((int * int * int), string) Hashtbl.t
128 ; mutable pages : (int * int * int) list
129 ; mutable pagecount : int
130 ; pagecache : string circbuf
131 ; mutable rendering : bool
132 ; mutable mstate : mstate
133 ; mutable searchpattern : string
134 ; mutable rects : (int * int * rect) list
135 ; mutable rects1 : (int * int * rect) list
136 ; mutable text : string
137 ; mutable fullscreen : (int * int) option
138 ; mutable textentry : textentry option
139 ; mutable outlines : outlines
140 ; mutable outline : (bool * int * int * outline array * string) option
141 ; mutable bookmarks : outline list
142 ; mutable path : string
143 ; mutable password : string
144 ; mutable invalidated : int
145 ; mutable colorscale : float
146 ; hists : hists
148 and hists =
149 { pat : string circbuf
150 ; pag : string circbuf
151 ; nav : float circbuf
155 let conf =
156 { scrollw = 5
157 ; scrollh = 12
158 ; icase = true
159 ; preload = true
160 ; pagebias = 0
161 ; verbose = false
162 ; scrollincr = 24
163 ; maxhfit = true
164 ; crophack = false
165 ; autoscroll = false
166 ; showall = false
167 ; hlinks = false
168 ; underinfo = false
172 let state =
173 { csock = Unix.stdin
174 ; ssock = Unix.stdin
175 ; w = 900
176 ; h = 900
177 ; rotate = 0
178 ; y = 0
179 ; ty = 0.0
180 ; layout = []
181 ; maxy = max_int
182 ; pagemap = Hashtbl.create 10
183 ; pagecache = cbnew 10 ""
184 ; pages = []
185 ; pagecount = 0
186 ; rendering = false
187 ; mstate = Mnone
188 ; rects = []
189 ; rects1 = []
190 ; text = ""
191 ; fullscreen = None
192 ; textentry = None
193 ; searchpattern = ""
194 ; outlines = Olist []
195 ; outline = None
196 ; bookmarks = []
197 ; path = ""
198 ; password = ""
199 ; invalidated = 0
200 ; hists =
201 { nav = cbnew 100 0.0
202 ; pat = cbnew 20 ""
203 ; pag = cbnew 10 ""
205 ; colorscale = 1.0
209 let vlog fmt =
210 if conf.verbose
211 then
212 Printf.kprintf prerr_endline fmt
213 else
214 Printf.kprintf ignore fmt
217 let writecmd fd s =
218 let len = String.length s in
219 let n = 4 + len in
220 let b = Buffer.create n in
221 Buffer.add_char b (Char.chr ((len lsr 24) land 0xff));
222 Buffer.add_char b (Char.chr ((len lsr 16) land 0xff));
223 Buffer.add_char b (Char.chr ((len lsr 8) land 0xff));
224 Buffer.add_char b (Char.chr ((len lsr 0) land 0xff));
225 Buffer.add_string b s;
226 let s' = Buffer.contents b in
227 let n' = Unix.write fd s' 0 n in
228 if n' != n then failwith "write failed";
231 let readcmd fd =
232 let s = "xxxx" in
233 let n = Unix.read fd s 0 4 in
234 if n != 4 then failwith "incomplete read(len)";
235 let len = 0
236 lor (Char.code s.[0] lsl 24)
237 lor (Char.code s.[1] lsl 16)
238 lor (Char.code s.[2] lsl 8)
239 lor (Char.code s.[3] lsl 0)
241 let s = String.create len in
242 let n = Unix.read fd s 0 len in
243 if n != len then failwith "incomplete read(data)";
247 let yratio y =
248 if y = state.maxy
249 then 1.0
250 else float y /. float state.maxy
253 let makecmd s l =
254 let b = Buffer.create 10 in
255 Buffer.add_string b s;
256 let rec combine = function
257 | [] -> b
258 | x :: xs ->
259 Buffer.add_char b ' ';
260 let s =
261 match x with
262 | `b b -> if b then "1" else "0"
263 | `s s -> s
264 | `i i -> string_of_int i
265 | `f f -> string_of_float f
266 | `I f -> string_of_int (truncate f)
268 Buffer.add_string b s;
269 combine xs;
271 combine l;
274 let wcmd s l =
275 let cmd = Buffer.contents (makecmd s l) in
276 writecmd state.csock cmd;
279 let calcheight () =
280 let rec f pn ph fh l =
281 match l with
282 | (n, _, h) :: rest ->
283 let fh = fh + (n - pn) * ph in
284 f n h fh rest
286 | [] ->
287 let fh = fh + (ph * (state.pagecount - pn)) in
288 max 0 fh
290 let fh = f 0 0 0 state.pages in
294 let getpageyh pageno =
295 let rec f pn ph y l =
296 match l with
297 | (n, _, h) :: rest ->
298 if n >= pageno
299 then
300 y + (pageno - pn) * ph, h
301 else
302 let y = y + (n - pn) * ph in
303 f n h y rest
305 | [] ->
306 y + (pageno - pn) * ph, ph
308 f 0 0 0 state.pages;
311 let getpagey pageno = fst (getpageyh pageno);;
313 let layout y sh =
314 let rec f pageno pdimno prev vy py dy l cacheleft accu =
315 if pageno = state.pagecount || cacheleft = 0
316 then accu
317 else
318 let ((_, w, h) as curr), rest, pdimno =
319 match l with
320 | ((pageno', _, _) as curr) :: rest when pageno' = pageno ->
321 curr, rest, pdimno + 1
322 | _ ->
323 prev, l, pdimno
325 let pageno' = pageno + 1 in
326 if py + h > vy
327 then
328 let py' = vy - py in
329 let vh = h - py' in
330 if dy + vh > sh
331 then
332 let vh = sh - dy in
333 if vh <= 0
334 then
335 accu
336 else
337 let e =
338 { pageno = pageno
339 ; pagedimno = pdimno
340 ; pagew = w
341 ; pageh = h
342 ; pagedispy = dy
343 ; pagey = py'
344 ; pagevh = vh
347 e :: accu
348 else
349 let e =
350 { pageno = pageno
351 ; pagedimno = pdimno
352 ; pagew = w
353 ; pageh = h
354 ; pagedispy = dy
355 ; pagey = py'
356 ; pagevh = vh
359 let accu = e :: accu in
360 f pageno' pdimno curr
361 (vy + vh) (py + h) (dy + vh + 2) rest
362 (pred cacheleft) accu
363 else
364 f pageno' pdimno curr vy (py + h) dy rest cacheleft accu
366 if state.invalidated = 0
367 then
368 let accu = f 0 ~-1 (0,0,0) y 0 0 state.pages (cblen state.pagecache) [] in
369 state.maxy <- calcheight ();
370 List.rev accu
371 else
375 let clamp incr =
376 let y = state.y + incr in
377 let y = max 0 y in
378 let y = min y (state.maxy - (if conf.maxhfit then state.h else 0)) in
382 let getopaque pageno =
383 try Some (Hashtbl.find state.pagemap (pageno + 1, state.w - conf.scrollw,
384 state.rotate))
385 with Not_found -> None
388 let cache pageno opaque =
389 Hashtbl.replace state.pagemap (pageno + 1, state.w - conf.scrollw,
390 state.rotate) opaque
393 let validopaque opaque = String.length opaque > 0;;
395 let render l =
396 match getopaque l.pageno with
397 | None when not state.rendering ->
398 state.rendering <- true;
399 cache l.pageno "";
400 wcmd "render" [`i (l.pageno + 1)
401 ;`i l.pagedimno
402 ;`i l.pagew
403 ;`i l.pageh];
405 | _ -> ()
408 let loadlayout layout =
409 let rec f all = function
410 | l :: ls ->
411 begin match getopaque l.pageno with
412 | None -> render l; f false ls
413 | Some opaque -> f (all && validopaque opaque) ls
415 | [] -> all
417 f (layout <> []) layout;
420 let preload () =
421 if conf.preload
422 then
423 let evictedvisible =
424 let evictedopaque = cbpeekw state.pagecache in
425 List.exists (fun l ->
426 match getopaque l.pageno with
427 | Some opaque when validopaque opaque ->
428 evictedopaque = opaque
429 | otherwise -> false
430 ) state.layout
432 if not evictedvisible
433 then
434 let y = if state.y < state.h then 0 else state.y - state.h in
435 let pages = layout y (state.h*3) in
436 List.iter render pages;
439 let gotoy y =
440 let y = max 0 y in
441 let y = min state.maxy y in
442 let pages = layout y state.h in
443 let ready = loadlayout pages in
444 state.ty <- yratio y;
445 if conf.showall
446 then (
447 if ready
448 then (
449 state.layout <- pages;
450 state.y <- y;
451 Glut.postRedisplay ();
454 else (
455 state.layout <- pages;
456 state.y <- y;
457 Glut.postRedisplay ();
459 preload ();
462 let addnav () =
463 cbput state.hists.nav (yratio state.y);
464 cbrfollowlen state.hists.nav;
467 let getnav () =
468 let y = cbget state.hists.nav ~-1 in
469 truncate (y *. float state.maxy)
472 let gotopage n top =
473 let y, h = getpageyh n in
474 addnav ();
475 gotoy (y + (truncate (top *. float h)));
478 let gotopage1 n top =
479 let y = getpagey n in
480 addnav ();
481 gotoy (y + top);
484 let invalidate () =
485 state.layout <- [];
486 state.pages <- [];
487 state.rects <- [];
488 state.rects1 <- [];
489 state.invalidated <- state.invalidated + 1;
492 let scalecolor c =
493 let c = c *. state.colorscale in
494 (c, c, c);
497 let reshape ~w ~h =
498 state.w <- w;
499 state.h <- h;
500 GlDraw.viewport 0 0 w h;
501 GlMat.mode `modelview;
502 GlMat.load_identity ();
503 GlMat.mode `projection;
504 GlMat.load_identity ();
505 GlMat.rotate ~x:1.0 ~angle:180.0 ();
506 GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
507 GlMat.scale3 (2.0 /. float w, 2.0 /. float state.h, 1.0);
508 GlClear.color (scalecolor 1.0);
509 GlClear.clear [`color];
511 invalidate ();
512 wcmd "geometry" [`i (state.w - conf.scrollw); `i h];
515 let showtext c s =
516 GlDraw.color (0.0, 0.0, 0.0);
517 GlDraw.rect
518 (0.0, float (state.h - 18))
519 (float (state.w - conf.scrollw - 1), float state.h)
521 let font = Glut.BITMAP_8_BY_13 in
522 GlDraw.color (1.0, 1.0, 1.0);
523 GlPix.raster_pos ~x:0.0 ~y:(float (state.h - 5)) ();
524 Glut.bitmapCharacter ~font ~c:(Char.code c);
525 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s;
528 let enttext () =
529 let len = String.length state.text in
530 match state.textentry with
531 | None ->
532 if len > 0 then showtext ' ' state.text
534 | Some (c, text, _, _, _) ->
535 let s =
536 if len > 0
537 then
538 text ^ " [" ^ state.text ^ "]"
539 else
540 text
542 showtext c s;
545 let showtext c s =
546 if true
547 then (
548 state.text <- Printf.sprintf "%c%s" c s;
549 Glut.postRedisplay ();
551 else (
552 showtext c s;
553 Glut.swapBuffers ();
557 let act cmd =
558 match cmd.[0] with
559 | 'c' ->
560 state.pages <- [];
562 | 'D' ->
563 state.rects <- state.rects1;
564 Glut.postRedisplay ()
566 | 'C' ->
567 let n = Scanf.sscanf cmd "C %d" (fun n -> n) in
568 state.pagecount <- n;
569 state.invalidated <- state.invalidated - 1;
570 if state.invalidated = 0
571 then (
572 let rely = yratio state.y in
573 state.maxy <- calcheight ();
574 gotoy (truncate (float state.maxy *. rely));
577 | 't' ->
578 let s = Scanf.sscanf cmd "t %n"
579 (fun n -> String.sub cmd n (String.length cmd - n))
581 Glut.setWindowTitle s
583 | 'T' ->
584 let s = Scanf.sscanf cmd "T %n"
585 (fun n -> String.sub cmd n (String.length cmd - n))
587 if state.textentry = None
588 then (
589 state.text <- s;
590 showtext ' ' s;
592 else (
593 state.text <- s;
594 Glut.postRedisplay ();
597 | 'V' ->
598 if conf.verbose
599 then
600 let s = Scanf.sscanf cmd "V %n"
601 (fun n -> String.sub cmd n (String.length cmd - n))
603 state.text <- s;
604 showtext ' ' s;
606 | 'F' ->
607 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
608 Scanf.sscanf cmd "F %d %d %f %f %f %f %f %f %f %f"
609 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
610 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
612 let y = (getpagey pageno) + truncate y0 in
613 addnav ();
614 gotoy y;
615 state.rects1 <- [pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)]
617 | 'R' ->
618 let pageno, c, x0, y0, x1, y1, x2, y2, x3, y3 =
619 Scanf.sscanf cmd "R %d %d %f %f %f %f %f %f %f %f"
620 (fun p c x0 y0 x1 y1 x2 y2 x3 y3 ->
621 (p, c, x0, y0, x1, y1, x2, y2, x3, y3))
623 state.rects1 <-
624 (pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)) :: state.rects1
626 | 'r' ->
627 let n, w, h, r, p =
628 Scanf.sscanf cmd "r %d %d %d %d %s"
629 (fun n w h r p -> (n, w, h, r, p))
631 Hashtbl.replace state.pagemap (n, w, r) p;
632 let opaque = cbpeekw state.pagecache in
633 if validopaque opaque
634 then (
635 let k =
636 Hashtbl.fold
637 (fun k v a -> if v = opaque then k else a)
638 state.pagemap (-1, -1, -1)
640 wcmd "free" [`s opaque];
641 Hashtbl.remove state.pagemap k
643 cbput state.pagecache p;
644 state.rendering <- false;
645 if conf.showall
646 then gotoy (truncate (ceil (state.ty *. float state.maxy)))
647 else (
648 let visible = List.exists (fun l -> l.pageno + 1 = n) state.layout in
649 if visible
650 then gotoy state.y
651 else (ignore (loadlayout state.layout); preload ())
654 | 'l' ->
655 let (n, w, h) as pagelayout =
656 Scanf.sscanf cmd "l %d %d %d" (fun n w h -> n, w, h)
658 state.pages <- pagelayout :: state.pages
660 | 'o' ->
661 let (l, n, t, h, pos) =
662 Scanf.sscanf cmd "o %d %d %d %d %n" (fun l n t h pos -> l, n, t, h, pos)
664 let s = String.sub cmd pos (String.length cmd - pos) in
665 let s =
666 let l = String.length s in
667 let b = Buffer.create (String.length s) in
668 let rec loop pc2 i =
669 if i = l
670 then ()
671 else
672 let pc2 =
673 match s.[i] with
674 | '\xa0' when pc2 -> Buffer.add_char b ' '; false
675 | '\xc2' -> true
676 | c ->
677 let c = if Char.code c land 0x80 = 0 then c else '?' in
678 Buffer.add_char b c;
679 false
681 loop pc2 (i+1)
683 loop false 0;
684 Buffer.contents b
686 let outline = (s, l, n, float t /. float h) in
687 let outlines =
688 match state.outlines with
689 | Olist outlines -> Olist (outline :: outlines)
690 | Oarray _ -> Olist [outline]
691 | Onarrow _ -> Olist [outline]
693 state.outlines <- outlines
695 | _ ->
696 log "unknown cmd `%S'" cmd
699 let now = Unix.gettimeofday;;
701 let idle () =
702 let rec loop delay =
703 let r, _, _ = Unix.select [state.csock] [] [] delay in
704 begin match r with
705 | [] ->
706 if conf.autoscroll
707 then begin
708 let y = state.y + conf.scrollincr in
709 let y = if y >= state.maxy then 0 else y in
710 gotoy y;
711 state.text <- "";
712 end;
714 | _ ->
715 let cmd = readcmd state.csock in
716 act cmd;
717 loop 0.0
718 end;
719 in loop 0.001
722 let onhist cb = function
723 | HCprev -> cbget cb ~-1
724 | HCnext -> cbget cb 1
725 | HCfirst -> cbget cb ~-(cb.rc)
726 | HClast -> cbget cb (cb.len - 1 - cb.rc)
729 let search pattern forward =
730 if String.length pattern > 0
731 then
732 let pn, py =
733 match state.layout with
734 | [] -> 0, 0
735 | l :: _ ->
736 l.pageno, (l.pagey + if forward then 0 else 0*l.pagevh)
738 let cmd =
739 let b = makecmd "search"
740 [`b conf.icase; `i pn; `i py; `i (if forward then 1 else 0)]
742 Buffer.add_char b ',';
743 Buffer.add_string b pattern;
744 Buffer.add_char b '\000';
745 Buffer.contents b;
747 writecmd state.csock cmd;
750 let intentry text key =
751 let c = Char.unsafe_chr key in
752 match c with
753 | '0' .. '9' ->
754 let s = "x" in s.[0] <- c;
755 let text = text ^ s in
756 TEcont text
758 | _ ->
759 state.text <- Printf.sprintf "invalid char (%d, `%c')" key c;
760 TEcont text
763 let addchar s c =
764 let b = Buffer.create (String.length s + 1) in
765 Buffer.add_string b s;
766 Buffer.add_char b c;
767 Buffer.contents b;
770 let textentry text key =
771 let c = Char.unsafe_chr key in
772 match c with
773 | _ when key >= 32 && key < 127 ->
774 let text = addchar text c in
775 TEcont text
777 | _ ->
778 log "unhandled key %d char `%c'" key (Char.unsafe_chr key);
779 TEcont text
782 let rotate angle =
783 state.rotate <- angle;
784 invalidate ();
785 wcmd "rotate" [`i angle];
788 let optentry text key =
789 let btos b = if b then "on" else "off" in
790 let c = Char.unsafe_chr key in
791 match c with
792 | 's' ->
793 let ondone s =
794 try conf.scrollincr <- int_of_string s with exc ->
795 state.text <- Printf.sprintf "bad integer `%s': %s"
796 s (Printexc.to_string exc)
798 TEswitch ('#', "", None, intentry, ondone)
800 | 'R' ->
801 let ondone s =
802 match try
803 Some (int_of_string s)
804 with exc ->
805 state.text <- Printf.sprintf "bad integer `%s': %s"
806 s (Printexc.to_string exc);
807 None
808 with
809 | Some angle -> rotate angle
810 | None -> ()
812 TEswitch ('^', "", None, intentry, ondone)
814 | 'i' ->
815 conf.icase <- not conf.icase;
816 TEdone ("case insensitive search " ^ (btos conf.icase))
818 | 'p' ->
819 conf.preload <- not conf.preload;
820 gotoy state.y;
821 TEdone ("preload " ^ (btos conf.preload))
823 | 'v' ->
824 conf.verbose <- not conf.verbose;
825 TEdone ("verbose " ^ (btos conf.verbose))
827 | 'h' ->
828 conf.maxhfit <- not conf.maxhfit;
829 state.maxy <- state.maxy + (if conf.maxhfit then -state.h else state.h);
830 TEdone ("maxhfit " ^ (btos conf.maxhfit))
832 | 'c' ->
833 conf.crophack <- not conf.crophack;
834 TEdone ("crophack " ^ btos conf.crophack)
836 | 'a' ->
837 conf.showall <- not conf.showall;
838 TEdone ("showall " ^ btos conf.showall)
840 | 'f' ->
841 conf.underinfo <- not conf.underinfo;
842 TEdone ("underinfo " ^ btos conf.underinfo)
844 | _ ->
845 state.text <- Printf.sprintf "bad option %d `%c'" key c;
846 TEstop
849 let maxoutlinerows () = (state.h - 31) / 16;;
851 let enterselector allowdel outlines errmsg =
852 if Array.length outlines = 0
853 then (
854 showtext ' ' errmsg;
856 else (
857 Glut.setCursor Glut.CURSOR_INHERIT;
858 let pageno =
859 match state.layout with
860 | [] -> -1
861 | {pageno=pageno} :: rest -> pageno
863 let active =
864 let rec loop n =
865 if n = Array.length outlines
866 then 0
867 else
868 let (_, _, outlinepageno, _) = outlines.(n) in
869 if outlinepageno >= pageno then n else loop (n+1)
871 loop 0
873 state.outline <-
874 Some (allowdel, active,
875 max 0 ((active - maxoutlinerows () / 2)), outlines, "");
876 Glut.postRedisplay ();
880 let enteroutlinemode () =
881 let outlines =
882 match state.outlines with
883 | Oarray a -> a
884 | Olist l ->
885 let a = Array.of_list (List.rev l) in
886 state.outlines <- Oarray a;
888 | Onarrow (a, b) -> a
890 enterselector false outlines "Document has no outline";
893 let enterbookmarkmode () =
894 let bookmarks = Array.of_list state.bookmarks in
895 enterselector true bookmarks "Document has no bookmarks (yet)";
899 let quickbookmark ?title () =
900 match state.layout with
901 | [] -> ()
902 | l :: _ ->
903 let title =
904 match title with
905 | None ->
906 let sec = Unix.gettimeofday () in
907 let tm = Unix.localtime sec in
908 Printf.sprintf "Quick %d visited (%d/%d/%d %d:%d)"
909 l.pageno
910 tm.Unix.tm_mday
911 tm.Unix.tm_mon
912 (tm.Unix.tm_year + 1900)
913 tm.Unix.tm_hour
914 tm.Unix.tm_min
915 | Some title -> title
917 state.bookmarks <-
918 (title, 0, l.pageno, float l.pagey /. float l.pageh) :: state.bookmarks
921 let doreshape w h =
922 state.fullscreen <- None;
923 Glut.reshapeWindow w h;
926 let opendoc path password =
927 invalidate ();
928 state.path <- path;
929 state.password <- password;
930 Hashtbl.clear state.pagemap;
932 writecmd state.csock ("open " ^ path ^ "\000" ^ password ^ "\000");
933 Glut.setWindowTitle ("llpp " ^ Filename.basename path);
934 wcmd "geometry" [`i (state.w - conf.scrollw); `i state.h];
937 let viewkeyboard ~key ~x ~y =
938 let enttext te =
939 state.textentry <- te;
940 state.text <- "";
941 enttext ();
942 Glut.postRedisplay ()
944 match state.textentry with
945 | None ->
946 let c = Char.chr key in
947 begin match c with
948 | '\027' | 'q' ->
949 exit 0
951 | '\008' ->
952 let y = getnav () in
953 gotoy y
955 | 'o' ->
956 enteroutlinemode ()
958 | 'u' ->
959 state.rects <- [];
960 state.text <- "";
961 Glut.postRedisplay ()
963 | '/' | '?' ->
964 let ondone isforw s =
965 cbput state.hists.pat s;
966 cbrfollowlen state.hists.pat;
967 state.searchpattern <- s;
968 search s isforw
970 enttext (Some (c, "", Some (onhist state.hists.pat),
971 textentry, ondone (c ='/')))
973 | '+' ->
974 let ondone s =
975 let n =
976 try int_of_string s with exc ->
977 state.text <- Printf.sprintf "bad integer `%s': %s"
978 s (Printexc.to_string exc);
979 max_int
981 if n != max_int
982 then (
983 conf.pagebias <- n;
984 state.text <- "page bias is now " ^ string_of_int n;
987 enttext (Some ('+', "", None, intentry, ondone))
989 | '-' ->
990 let ondone msg =
991 state.text <- msg;
993 enttext (Some ('-', "", None, optentry, ondone))
995 | '0' .. '9' ->
996 let ondone s =
997 let n =
998 try int_of_string s with exc ->
999 state.text <- Printf.sprintf "bad integer `%s': %s"
1000 s (Printexc.to_string exc);
1003 if n >= 0
1004 then (
1005 addnav ();
1006 cbput state.hists.pag (string_of_int n);
1007 cbrfollowlen state.hists.pag;
1008 gotoy (getpagey (n + conf.pagebias - 1))
1011 let pageentry text key =
1012 match Char.unsafe_chr key with
1013 | 'g' -> TEdone text
1014 | _ -> intentry text key
1016 let text = "x" in text.[0] <- c;
1017 enttext (Some (':', text, Some (onhist state.hists.pag),
1018 pageentry, ondone))
1020 | 'b' ->
1021 conf.scrollw <- if conf.scrollw > 0 then 0 else 5;
1022 reshape state.w state.h;
1024 | 'l' ->
1025 conf.hlinks <- not conf.hlinks;
1026 state.text <- "highlightlinks " ^ if conf.hlinks then "on" else "off";
1027 Glut.postRedisplay ()
1029 | 'a' ->
1030 conf.autoscroll <- not conf.autoscroll
1032 | 'f' ->
1033 begin match state.fullscreen with
1034 | None ->
1035 state.fullscreen <- Some (state.w, state.h);
1036 Glut.fullScreen ()
1037 | Some (w, h) ->
1038 state.fullscreen <- None;
1039 doreshape w h
1042 | 'g' ->
1043 gotoy 0
1045 | 'n' ->
1046 search state.searchpattern true
1048 | 'p' | 'N' ->
1049 search state.searchpattern false
1051 | 't' ->
1052 begin match state.layout with
1053 | [] -> ()
1054 | l :: _ ->
1055 gotoy (state.y - l.pagey);
1058 | ' ' ->
1059 begin match List.rev state.layout with
1060 | [] -> ()
1061 | l :: _ ->
1062 gotoy (clamp (l.pageh - l.pagey))
1065 | '\127' ->
1066 begin match state.layout with
1067 | [] -> ()
1068 | l :: _ ->
1069 gotoy (clamp (-l.pageh));
1072 | '=' ->
1073 let f (fn, ln) l =
1074 if fn = -1 then l.pageno, l.pageno else fn, l.pageno
1076 let fn, ln = List.fold_left f (-1, -1) state.layout in
1077 let s =
1078 let maxy = state.maxy - (if conf.maxhfit then state.h else 0) in
1079 let percent =
1080 if maxy <= 0
1081 then 100.
1082 else (100. *. (float state.y /. float maxy)) in
1083 if fn = ln
1084 then
1085 Printf.sprintf "Page %d of %d %.2f%%"
1086 (fn+1) state.pagecount percent
1087 else
1088 Printf.sprintf
1089 "Pages %d-%d of %d %.2f%%"
1090 (fn+1) (ln+1) state.pagecount percent
1092 showtext ' ' s;
1094 | 'w' ->
1095 begin match state.layout with
1096 | [] -> ()
1097 | l :: _ ->
1098 doreshape (l.pagew + conf.scrollw) l.pageh;
1099 Glut.postRedisplay ();
1102 | '\'' ->
1103 enterbookmarkmode ()
1105 | 'm' ->
1106 let ondone s =
1107 match state.layout with
1108 | l :: _ ->
1109 state.bookmarks <-
1110 (s, 0, l.pageno, float l.pagey /. float l.pageh)
1111 :: state.bookmarks
1112 | _ -> ()
1114 enttext (Some ('~', "", None, textentry, ondone))
1116 | '~' ->
1117 quickbookmark ();
1118 showtext ' ' "Quick bookmark added";
1120 | 'z' ->
1121 begin match state.layout with
1122 | l :: _ ->
1123 let a = getpagewh l.pagedimno in
1124 let w, h =
1125 if conf.crophack
1126 then
1127 (truncate (1.8 *. (a.(1) -. a.(0))),
1128 truncate (1.2 *. (a.(3) -. a.(0))))
1129 else
1130 (truncate (a.(1) -. a.(0)),
1131 truncate (a.(3) -. a.(0)))
1133 doreshape (w + conf.scrollw) h;
1134 Glut.postRedisplay ();
1136 | [] -> ()
1139 | '<' | '>' ->
1140 rotate (state.rotate + (if c = '>' then 30 else -30));
1142 | '[' | ']' ->
1143 state.colorscale <-
1144 max 0.0
1145 (min (state.colorscale +. (if c = ']' then 0.1 else -0.1)) 1.0);
1146 Glut.postRedisplay ()
1148 | 'k' -> gotoy (clamp (-conf.scrollincr))
1149 | 'j' -> gotoy (clamp conf.scrollincr)
1151 | 'r' -> opendoc state.path state.password
1153 | _ ->
1154 vlog "huh? %d %c" key (Char.chr key);
1157 | Some (c, text, onhist, onkey, ondone) when key = 8 ->
1158 let len = String.length text in
1159 if len = 0
1160 then (
1161 state.textentry <- None;
1162 Glut.postRedisplay ();
1164 else (
1165 let s = String.sub text 0 (len - 1) in
1166 enttext (Some (c, s, onhist, onkey, ondone))
1169 | Some (c, text, onhist, onkey, ondone) ->
1170 begin match Char.unsafe_chr key with
1171 | '\r' | '\n' ->
1172 ondone text;
1173 state.textentry <- None;
1174 Glut.postRedisplay ()
1176 | '\027' ->
1177 state.textentry <- None;
1178 Glut.postRedisplay ()
1180 | _ ->
1181 begin match onkey text key with
1182 | TEdone text ->
1183 state.textentry <- None;
1184 ondone text;
1185 Glut.postRedisplay ()
1187 | TEcont text ->
1188 enttext (Some (c, text, onhist, onkey, ondone));
1190 | TEstop ->
1191 state.textentry <- None;
1192 Glut.postRedisplay ()
1194 | TEswitch te ->
1195 state.textentry <- Some te;
1196 Glut.postRedisplay ()
1197 end;
1198 end;
1201 let narrow outlines pattern =
1202 let reopt = try Some (Str.regexp_case_fold pattern) with _ -> None in
1203 match reopt with
1204 | None -> None
1205 | Some re ->
1206 let rec fold accu n =
1207 if n = -1
1208 then accu
1209 else
1210 let (s, _, _, _) as o = outlines.(n) in
1211 let accu =
1212 if (try ignore (Str.search_forward re s 0); true
1213 with Not_found -> false)
1214 then (o :: accu)
1215 else accu
1217 fold accu (n-1)
1219 let matched = fold [] (Array.length outlines - 1) in
1220 if matched = [] then None else Some (Array.of_list matched)
1223 let outlinekeyboard ~key ~x ~y (allowdel, active, first, outlines, qsearch) =
1224 let search active pattern incr =
1225 let dosearch re =
1226 let rec loop n =
1227 if n = Array.length outlines || n = -1
1228 then None
1229 else
1230 let (s, _, _, _) = outlines.(n) in
1232 (try ignore (Str.search_forward re s 0); true
1233 with Not_found -> false)
1234 then Some n
1235 else loop (n + incr)
1237 loop active
1240 let re = Str.regexp_case_fold pattern in
1241 dosearch re
1242 with Failure s ->
1243 state.text <- s;
1244 None
1246 let firstof active = max 0 (active - maxoutlinerows () / 2) in
1247 match key with
1248 | 27 ->
1249 if String.length qsearch = 0
1250 then (
1251 state.text <- "";
1252 state.outline <- None;
1253 Glut.postRedisplay ();
1255 else (
1256 state.text <- "";
1257 state.outline <- Some (allowdel, active, first, outlines, "");
1258 Glut.postRedisplay ();
1261 | 18 | 19 ->
1262 let incr = if key = 18 then -1 else 1 in
1263 let active, first =
1264 match search (active + incr) qsearch incr with
1265 | None ->
1266 state.text <- qsearch ^ " [not found]";
1267 active, first
1268 | Some active ->
1269 state.text <- qsearch;
1270 active, firstof active
1272 state.outline <- Some (allowdel, active, first, outlines, qsearch);
1273 Glut.postRedisplay ();
1275 | 8 ->
1276 let len = String.length qsearch in
1277 if len = 0
1278 then ()
1279 else (
1280 if len = 1
1281 then (
1282 state.text <- "";
1283 state.outline <- Some (allowdel, active, first, outlines, "");
1285 else
1286 let qsearch = String.sub qsearch 0 (len - 1) in
1287 let active, first =
1288 match search active qsearch ~-1 with
1289 | None ->
1290 state.text <- qsearch ^ " [not found]";
1291 active, first
1292 | Some active ->
1293 state.text <- qsearch;
1294 active, firstof active
1296 state.outline <- Some (allowdel, active, first, outlines, qsearch);
1298 Glut.postRedisplay ()
1300 | 13 ->
1301 if active < Array.length outlines
1302 then (
1303 let (_, _, n, t) = outlines.(active) in
1304 gotopage n t;
1306 state.text <- "";
1307 if allowdel then state.bookmarks <- Array.to_list outlines;
1308 state.outline <- None;
1309 Glut.postRedisplay ();
1311 | _ when key >= 32 && key < 127 ->
1312 let pattern = addchar qsearch (Char.chr key) in
1313 let active, first =
1314 match search active pattern 1 with
1315 | None ->
1316 state.text <- pattern ^ " [not found]";
1317 active, first
1318 | Some active ->
1319 state.text <- pattern;
1320 active, firstof active
1322 state.outline <- Some (allowdel, active, first, outlines, pattern);
1323 Glut.postRedisplay ()
1325 | 14 when not allowdel ->
1326 let optoutlines = narrow outlines qsearch in
1327 begin match optoutlines with
1328 | None -> state.text <- "can't narrow"
1329 | Some outlines ->
1330 state.outline <- Some (allowdel, 0, 0, outlines, qsearch);
1331 match state.outlines with
1332 | Olist l -> ()
1333 | Oarray a -> state.outlines <- Onarrow (outlines, a)
1334 | Onarrow (a, b) -> state.outlines <- Onarrow (outlines, b)
1335 end;
1336 Glut.postRedisplay ()
1338 | 21 when not allowdel ->
1339 let outline =
1340 match state.outlines with
1341 | Oarray a -> a
1342 | Olist l ->
1343 let a = Array.of_list (List.rev l) in
1344 state.outlines <- Oarray a;
1346 | Onarrow (a, b) ->
1347 state.outlines <- Oarray b;
1350 state.outline <- Some (allowdel, 0, 0, outline, qsearch);
1351 Glut.postRedisplay ()
1353 | 12 ->
1354 state.outline <-
1355 Some (allowdel, active, firstof active, outlines, qsearch);
1356 Glut.postRedisplay ()
1358 | 127 when allowdel ->
1359 let len = Array.length outlines - 1 in
1360 if len = 0
1361 then (
1362 state.outline <- None;
1363 state.bookmarks <- [];
1365 else (
1366 let bookmarks = Array.init len
1367 (fun i ->
1368 let i = if i >= active then i + 1 else i in
1369 outlines.(i)
1372 state.outline <-
1373 Some (allowdel,
1374 min active (len-1),
1375 min first (len-1),
1376 bookmarks, qsearch)
1379 Glut.postRedisplay ()
1381 | _ -> log "unknown key %d" key
1384 let keyboard ~key ~x ~y =
1385 if key = 7
1386 then
1387 wcmd "interrupt" []
1388 else
1389 match state.outline with
1390 | None -> viewkeyboard ~key ~x ~y
1391 | Some outline -> outlinekeyboard ~key ~x ~y outline
1394 let special ~key ~x ~y =
1395 match state.outline with
1396 | None ->
1397 begin match state.textentry with
1398 | None ->
1399 let y =
1400 match key with
1401 | Glut.KEY_F3 -> search state.searchpattern true; state.y
1402 | Glut.KEY_UP -> clamp (-conf.scrollincr)
1403 | Glut.KEY_DOWN -> clamp conf.scrollincr
1404 | Glut.KEY_PAGE_UP ->
1405 if Glut.getModifiers () land Glut.active_ctrl != 0
1406 then
1407 match state.layout with
1408 | [] -> state.y
1409 | l :: _ -> state.y - l.pagey
1410 else
1411 clamp (-state.h)
1412 | Glut.KEY_PAGE_DOWN ->
1413 if Glut.getModifiers () land Glut.active_ctrl != 0
1414 then
1415 match List.rev state.layout with
1416 | [] -> state.y
1417 | l :: _ -> getpagey l.pageno
1418 else
1419 clamp state.h
1420 | Glut.KEY_HOME -> addnav (); 0
1421 | Glut.KEY_END ->
1422 addnav ();
1423 state.maxy - (if conf.maxhfit then state.h else 0)
1424 | _ -> state.y
1426 if not conf.verbose then state.text <- "";
1427 gotoy y
1429 | Some (c, s, Some onhist, onkey, ondone) ->
1430 let s =
1431 match key with
1432 | Glut.KEY_UP -> onhist HCprev
1433 | Glut.KEY_DOWN -> onhist HCnext
1434 | Glut.KEY_HOME -> onhist HCfirst
1435 | Glut.KEY_END -> onhist HClast
1436 | _ -> state.text
1438 state.textentry <- Some (c, s, Some onhist, onkey, ondone);
1439 Glut.postRedisplay ()
1441 | _ -> ()
1444 | Some (allowdel, active, first, outlines, qsearch) ->
1445 let maxrows = maxoutlinerows () in
1446 let navigate incr =
1447 let active = active + incr in
1448 let active = max 0 (min active (Array.length outlines - 1)) in
1449 let first =
1450 if active > first
1451 then
1452 let rows = active - first in
1453 if rows > maxrows then active - maxrows else first
1454 else active
1456 state.outline <- Some (allowdel, active, first, outlines, qsearch);
1457 Glut.postRedisplay ()
1459 match key with
1460 | Glut.KEY_UP -> navigate ~-1
1461 | Glut.KEY_DOWN -> navigate 1
1462 | Glut.KEY_PAGE_UP -> navigate ~-maxrows
1463 | Glut.KEY_PAGE_DOWN -> navigate maxrows
1465 | Glut.KEY_HOME ->
1466 state.outline <- Some (allowdel, 0, 0, outlines, qsearch);
1467 Glut.postRedisplay ()
1469 | Glut.KEY_END ->
1470 let active = Array.length outlines - 1 in
1471 let first = max 0 (active - maxrows) in
1472 state.outline <- Some (allowdel, active, first, outlines, qsearch);
1473 Glut.postRedisplay ()
1475 | _ -> ()
1478 let drawplaceholder l =
1479 GlDraw.color (scalecolor 1.0);
1480 GlDraw.rect
1481 (0.0, float l.pagedispy)
1482 (float l.pagew, float (l.pagedispy + l.pagevh))
1484 let x = 0.0
1485 and y = float (l.pagedispy + 13) in
1486 let font = Glut.BITMAP_8_BY_13 in
1487 GlDraw.color (0.0, 0.0, 0.0);
1488 GlPix.raster_pos ~x ~y ();
1489 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c))
1490 ("Loading " ^ string_of_int l.pageno);
1493 let now () = Unix.gettimeofday ();;
1495 let drawpage i l =
1496 begin match getopaque l.pageno with
1497 | Some opaque when validopaque opaque ->
1498 if state.textentry = None
1499 then GlDraw.color (scalecolor 1.0)
1500 else GlDraw.color (scalecolor 0.4);
1501 let a = now () in
1502 draw (l.pagedispy, l.pagew, l.pagevh, l.pagey, conf.hlinks) opaque;
1503 let b = now () in
1504 let d = b-.a in
1505 vlog "draw %f sec" d;
1507 | _ ->
1508 drawplaceholder l;
1509 end;
1510 GlDraw.color (0.5, 0.5, 0.5);
1511 GlDraw.rect
1512 (0., float i)
1513 (float (state.w - conf.scrollw), float (i + (l.pagedispy - i)))
1515 l.pagedispy + l.pagevh;
1518 let scrollindicator () =
1519 let maxy = state.maxy - (if conf.maxhfit then state.h else 0) in
1520 GlDraw.color (0.64 , 0.64, 0.64);
1521 GlDraw.rect
1522 (float (state.w - conf.scrollw), 0.)
1523 (float state.w, float state.h)
1525 GlDraw.color (0.0, 0.0, 0.0);
1526 let sh = (float (maxy + state.h) /. float state.h) in
1527 let sh = float state.h /. sh in
1528 let sh = max sh (float conf.scrollh) in
1530 let percent =
1531 if state.y = state.maxy
1532 then 1.0
1533 else float state.y /. float maxy
1535 let position = (float state.h -. sh) *. percent in
1537 let position =
1538 if position +. sh > float state.h
1539 then
1540 float state.h -. sh
1541 else
1542 position
1544 GlDraw.rect
1545 (float (state.w - conf.scrollw), position)
1546 (float state.w, position +. sh)
1550 let showsel () =
1551 match state.mstate with
1552 | Mnone ->
1555 | Msel ((x0, y0), (x1, y1)) ->
1556 let rec loop = function
1557 | l :: ls ->
1558 if (y0 >= l.pagedispy && y0 <= (l.pagedispy + l.pagevh))
1559 || ((y1 >= l.pagedispy && y1 <= (l.pagedispy + l.pagevh)))
1560 then
1561 match getopaque l.pageno with
1562 | Some opaque when validopaque opaque ->
1563 let oy = -l.pagey + l.pagedispy in
1564 seltext opaque (x0, y0, x1, y1) oy;
1566 | _ -> ()
1567 else loop ls
1568 | [] -> ()
1570 loop state.layout
1573 let showrects () =
1574 Gl.enable `blend;
1575 GlDraw.color (0.0, 0.0, 1.0) ~alpha:0.5;
1576 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
1577 List.iter
1578 (fun (pageno, c, (x0, y0, x1, y1, x2, y2, x3, y3)) ->
1579 List.iter (fun l ->
1580 if l.pageno = pageno
1581 then (
1582 let d = float (l.pagedispy - l.pagey) in
1583 GlDraw.color (0.0, 0.0, 1.0 /. float c) ~alpha:0.5;
1584 GlDraw.begins `quads;
1586 GlDraw.vertex2 (x0, y0+.d);
1587 GlDraw.vertex2 (x1, y1+.d);
1588 GlDraw.vertex2 (x2, y2+.d);
1589 GlDraw.vertex2 (x3, y3+.d);
1591 GlDraw.ends ();
1593 ) state.layout
1594 ) state.rects
1596 Gl.disable `blend;
1599 let showoutline = function
1600 | None -> ()
1601 | Some (allowdel, active, first, outlines, qsearch) ->
1602 Gl.enable `blend;
1603 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
1604 GlDraw.color (0., 0., 0.) ~alpha:0.85;
1605 GlDraw.rect (0., 0.) (float state.w, float state.h);
1606 Gl.disable `blend;
1608 GlDraw.color (1., 1., 1.);
1609 let font = Glut.BITMAP_9_BY_15 in
1610 let draw_string x y s =
1611 GlPix.raster_pos ~x ~y ();
1612 String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
1614 let rec loop row =
1615 if row = Array.length outlines || (row - first) * 16 > state.h
1616 then ()
1617 else (
1618 let (s, l, _, _) = outlines.(row) in
1619 let y = (row - first) * 16 in
1620 let x = 5 + 15*l in
1621 if row = active
1622 then (
1623 Gl.enable `blend;
1624 GlDraw.polygon_mode `both `line;
1625 GlFunc.blend_func `src_alpha `one_minus_src_alpha;
1626 GlDraw.color (1., 1., 1.) ~alpha:0.9;
1627 GlDraw.rect (0., float (y + 1))
1628 (float (state.w - conf.scrollw - 1), float (y + 18));
1629 GlDraw.polygon_mode `both `fill;
1630 Gl.disable `blend;
1631 GlDraw.color (1., 1., 1.);
1633 draw_string (float x) (float (y + 16)) s;
1634 loop (row+1)
1637 loop first
1640 let display () =
1641 let lasty = List.fold_left drawpage 0 (state.layout) in
1642 GlDraw.color (scalecolor 0.5);
1643 GlDraw.rect
1644 (0., float lasty)
1645 (float (state.w - conf.scrollw), float state.h)
1647 showrects ();
1648 scrollindicator ();
1649 showsel ();
1650 showoutline state.outline;
1651 enttext ();
1652 Glut.swapBuffers ();
1655 let getunder x y =
1656 let rec f = function
1657 | l :: rest ->
1658 begin match getopaque l.pageno with
1659 | Some opaque when validopaque opaque ->
1660 let y = y - l.pagedispy in
1661 if y > 0
1662 then
1663 let y = l.pagey + y in
1664 match whatsunder opaque x y with
1665 | Unone -> f rest
1666 | under -> under
1667 else
1668 f rest
1669 | _ ->
1670 f rest
1672 | [] -> Unone
1674 f state.layout
1677 let mouse ~button ~bstate ~x ~y =
1678 match button with
1679 | Glut.OTHER_BUTTON n when (n == 3 || n == 4) && bstate = Glut.UP ->
1680 let incr =
1681 if n = 3
1682 then
1683 -conf.scrollincr
1684 else
1685 conf.scrollincr
1687 let incr = incr * 2 in
1688 let y = clamp incr in
1689 gotoy y
1691 | Glut.LEFT_BUTTON when state.outline = None ->
1692 let dest = if bstate = Glut.DOWN then getunder x y else Unone in
1693 begin match dest with
1694 | Ulinkgoto (pageno, top) ->
1695 if pageno >= 0
1696 then
1697 gotopage1 pageno top
1699 | Ulinkuri s ->
1700 print_endline s
1702 | Unone when bstate = Glut.DOWN ->
1703 Glut.setCursor Glut.CURSOR_INHERIT;
1704 state.mstate <- Mnone
1706 | Unone | Utext _ ->
1707 if bstate = Glut.DOWN
1708 then (
1709 if state.rotate mod 360 = 0
1710 then (
1711 state.mstate <- Msel ((x, y), (x, y));
1712 Glut.postRedisplay ()
1715 else (
1716 match state.mstate with
1717 | Mnone -> ()
1718 | Msel ((x0, y0), (x1, y1)) ->
1719 let f l =
1720 if (y0 >= l.pagedispy && y0 <= (l.pagedispy + l.pagevh))
1721 || ((y1 >= l.pagedispy && y1 <= (l.pagedispy + l.pagevh)))
1722 then
1723 match getopaque l.pageno with
1724 | Some opaque when validopaque opaque ->
1725 copysel opaque
1726 | _ -> ()
1728 List.iter f state.layout;
1729 copysel ""; (* ugly *)
1730 Glut.setCursor Glut.CURSOR_INHERIT;
1731 state.mstate <- Mnone;
1735 | _ ->
1738 let mouse ~button ~state ~x ~y = mouse button state x y;;
1740 let motion ~x ~y =
1741 if state.outline = None
1742 then
1743 match state.mstate with
1744 | Mnone -> ()
1745 | Msel (a, _) ->
1746 state.mstate <- Msel (a, (x, y));
1747 Glut.postRedisplay ()
1750 let pmotion ~x ~y =
1751 if state.outline = None
1752 then
1753 match state.mstate with
1754 | Mnone ->
1755 begin match getunder x y with
1756 | Unone -> Glut.setCursor Glut.CURSOR_INHERIT
1757 | Ulinkuri uri ->
1758 if conf.underinfo then showtext 'u' ("ri: " ^ uri);
1759 Glut.setCursor Glut.CURSOR_INFO
1760 | Ulinkgoto (page, y) ->
1761 if conf.underinfo then showtext 'p' ("age: " ^ string_of_int page);
1762 Glut.setCursor Glut.CURSOR_INFO
1763 | Utext s ->
1764 if conf.underinfo then showtext 'f' ("ont: " ^ s);
1765 Glut.setCursor Glut.CURSOR_TEXT
1768 | Msel (a, _) ->
1772 let () =
1773 let statepath =
1774 let home =
1775 if Sys.os_type = "Win32"
1776 then
1777 try Sys.getenv "HOMEPATH" with Not_found -> ""
1778 else
1779 try Filename.concat (Sys.getenv "HOME") ".config" with Not_found -> ""
1781 Filename.concat home "llpp"
1783 let pstate =
1785 let ic = open_in_bin statepath in
1786 let hash = input_value ic in
1787 close_in ic;
1788 hash
1789 with exn ->
1790 if false
1791 then
1792 prerr_endline ("Error loading state " ^ Printexc.to_string exn)
1794 Hashtbl.create 1
1796 let savestate () =
1798 let w, h =
1799 match state.fullscreen with
1800 | None -> state.w, state.h
1801 | Some wh -> wh
1803 Hashtbl.replace pstate state.path (state.bookmarks, w, h);
1804 let oc = open_out_bin statepath in
1805 output_value oc pstate
1806 with exn ->
1807 if false
1808 then
1809 prerr_endline ("Error saving state " ^ Printexc.to_string exn)
1812 let setstate () =
1814 let statebookmarks, statew, stateh = Hashtbl.find pstate state.path in
1815 state.w <- statew;
1816 state.h <- stateh;
1817 state.bookmarks <- statebookmarks;
1818 with Not_found -> ()
1819 | exn ->
1820 prerr_endline ("Error setting state " ^ Printexc.to_string exn)
1823 Arg.parse
1824 ["-p", Arg.String (fun s -> state.password <- s) , "password"]
1825 (fun s -> state.path <- s)
1826 ("Usage: " ^ Sys.argv.(0) ^ " [options] some.pdf\noptions:")
1828 let name =
1829 if String.length state.path = 0
1830 then (prerr_endline "filename missing"; exit 1)
1831 else state.path
1834 setstate ();
1835 let _ = Glut.init Sys.argv in
1836 let () = Glut.initDisplayMode ~depth:false ~double_buffer:true () in
1837 let () = Glut.initWindowSize state.w state.h in
1838 let _ = Glut.createWindow ("llpp " ^ Filename.basename name) in
1840 let csock, ssock =
1841 if Sys.os_type = "Unix"
1842 then
1843 Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0
1844 else
1845 let addr = Unix.ADDR_INET (Unix.inet_addr_loopback, 1337) in
1846 let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
1847 Unix.setsockopt sock Unix.SO_REUSEADDR true;
1848 Unix.bind sock addr;
1849 Unix.listen sock 1;
1850 let csock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
1851 Unix.connect csock addr;
1852 let ssock, _ = Unix.accept sock in
1853 Unix.close sock;
1854 let opts sock =
1855 Unix.setsockopt sock Unix.TCP_NODELAY true;
1856 Unix.setsockopt_optint sock Unix.SO_LINGER None;
1858 opts ssock;
1859 opts csock;
1860 at_exit (fun () -> Unix.shutdown ssock Unix.SHUTDOWN_ALL);
1861 ssock, csock
1864 let () = Glut.displayFunc display in
1865 let () = Glut.reshapeFunc reshape in
1866 let () = Glut.keyboardFunc keyboard in
1867 let () = Glut.specialFunc special in
1868 let () = Glut.idleFunc (Some idle) in
1869 let () = Glut.mouseFunc mouse in
1870 let () = Glut.motionFunc motion in
1871 let () = Glut.passiveMotionFunc pmotion in
1873 init ssock;
1874 state.csock <- csock;
1875 state.ssock <- ssock;
1876 state.text <- "Opening " ^ name;
1877 writecmd state.csock ("open " ^ state.path ^ "\000" ^ state.password ^ "\000");
1879 at_exit savestate;
1881 let rec handlelablglutbug () =
1883 Glut.mainLoop ();
1884 with Glut.BadEnum "key in special_of_int" ->
1885 showtext '!' " LablGlut bug: special key not recognized";
1886 handlelablglutbug ()
1888 handlelablglutbug ();