main.ml

   1 open Format;;
   2 external init : Unix.file_descr -> unit = "ml_init";;
   3 external draw : int -> int -> int -> int -> string  -> unit = "ml_draw";;
   4 external preload : string -> unit = "ml_preload";;
   5 (* external layout : int -> unit = "ml_layout";; *)
   6
   7 type ('a, 'b, 'c) g =
   8     { mutable csock : Unix.file_descr
   9     ; mutable ssock : Unix.file_descr
  10     ; mutable w : int
  11     ; mutable h : int
  12     ; mutable y : int
  13     ; mutable maxy : int
  14     ; mutable layout : (int * int * int * int * int * int * int) list
  15     ; pixcache : ((int * int * int), string) Hashtbl.t
  16     ; mutable pages : 'a list
  17     ; mutable pagecount : int
  18     ; lru : string array
  19     ; mutable lruidx : int
  20     }
  21 ;;
  22
  23 let state =
  24   { csock = Unix.stdin
  25   ; ssock = Unix.stdin
  26   ; w = 0
  27   ; h = 0
  28   ; y = 0
  29   ; layout = []
  30   ; maxy = max_int
  31   ; pixcache = Hashtbl.create 10
  32   ; pages = []
  33   ; pagecount = 0
  34   ; lru = Array.create 12 ""
  35   ; lruidx = 0
  36   }
  37 ;;
  38
  39 let aincr = 20;;
  40 let log fmt = Printf.kprintf prerr_endline fmt;;
  41 let dolog fmt = Printf.kprintf prerr_endline fmt;;
  42
  43 let writecmd fd s =
  44   let len = String.length s in
  45   let n = 4 + len in
  46   let b = Buffer.create n in
  47   Buffer.add_char b (Char.chr ((len lsr 24) land 0xff));
  48   Buffer.add_char b (Char.chr ((len lsr 16) land 0xff));
  49   Buffer.add_char b (Char.chr ((len lsr  8) land 0xff));
  50   Buffer.add_char b (Char.chr ((len lsr  0) land 0xff));
  51   Buffer.add_string b s;
  52   let s' = Buffer.contents b in
  53   let n' = Unix.write fd s' 0 n in
  54   if n' != n then failwith "write failed";
  55 ;;
  56
  57 let readcmd fd =
  58   let s = "xxxx" in
  59   let n = Unix.read fd s 0 4 in
  60   if n != 4 then failwith "incomplete read(len)";
  61   let len = 0
  62     lor (Char.code s.[0] lsl 24)
  63     lor (Char.code s.[1] lsl 16)
  64     lor (Char.code s.[2] lsl  8)
  65     lor (Char.code s.[3] lsl  0)
  66   in
  67   let s = String.create len in
  68   let n = Unix.read fd s 0 len in
  69   if n != len then failwith "incomplete read(data)";
  70   s
  71 ;;
  72
  73 let wcmd s l =
  74   let b = Buffer.create 10 in
  75   Buffer.add_string b s;
  76   let rec combine = function
  77     | [] -> Buffer.contents b
  78     | x :: xs ->
  79         Buffer.add_char b ' ';
  80         let s =
  81           match x with
  82           | `s s -> s
  83           | `i i -> string_of_int i
  84           | `f f -> string_of_float f
  85           | `I f -> string_of_int (truncate f)
  86         in
  87         Buffer.add_string b s;
  88         combine xs;
  89   in
  90   let s = combine l in
  91   writecmd state.csock s;
  92 ;;
  93
  94 let layout y sh =
  95   let rec f pagenum pindex prev vy py dy l accu =
  96     if pagenum = state.pagecount
  97     then accu
  98     else
  99       let ((_, w, h) as curr), rest, pindex =
 100         match l with
 101         | ((pagenum', _, _) as curr) :: rest when pagenum' = pagenum ->
 102             (* log "pagenum=%d(%d) index=%d" pagenum pagenum' pindex; *)
 103             curr, rest, pindex + 1
 104         | _ ->
 105             prev, l, pindex
 106       in
 107       let pagenum' = pagenum + 1 in
 108       if py + h > vy
 109       then
 110         let py' = vy - py in
 111         let vh = h - py' in
 112         if dy + vh > sh
 113         then
 114           let vh = sh - dy in
 115           let e = pagenum, pindex, w, h, dy, py', vh in
 116           (* log "lay1[%d,%d] %dx%d" pagenum pindex w h; *)
 117           e :: accu
 118         else
 119           let e = pagenum, pindex, w, h, dy, py', vh in
 120           let accu = e :: accu in
 121           (* log "lay2[%d,%d] %dx%d" pagenum pindex w h; *)
 122           f pagenum' pindex curr (vy + vh) (py + h) (dy + vh) rest accu
 123       else
 124         f pagenum' pindex curr vy (py + h) dy rest accu
 125   in
 126   let accu = f 0 ~-1 (0,0,0) y 0 0 state.pages [] in
 127   (* log ""; *)
 128   List.rev accu
 129 ;;
 130
 131 let reshape ~w ~h =
 132   state.w <- w;
 133   state.h <- h;
 134   GlDraw.viewport 0 0 w h;
 135   GlMat.mode `modelview;
 136   GlMat.load_identity ();
 137   GlMat.mode `projection;
 138   GlMat.load_identity ();
 139   GlMat.rotate ~x:1.0 ~angle:180.0 ();
 140   GlMat.translate ~x:~-.1.0 ~y:~-.1.0 ();
 141   GlMat.scale3 (2.0 /. float state.w, 2.0 /. float state.h, 1.0);
 142   state.pages <- [];
 143   wcmd "geometry" [`i w; `i h];
 144   let pages = layout state.y state.h in
 145   state.layout <- pages;
 146   Glut.postRedisplay ();
 147   log "reshape %dx%d" w h;
 148 ;;
 149
 150 let act cmd =
 151   match cmd.[0] with
 152   | 'C' ->
 153       let n = Scanf.sscanf cmd "C %d" (fun n -> n) in
 154       state.pagecount <- n;
 155       let pages = layout state.y state.h in
 156       state.layout <- pages;
 157       Glut.postRedisplay ();
 158
 159   | 'c' ->
 160       state.layout <- []
 161
 162   | 'r' ->
 163       let n, w, h, p =
 164         Scanf.sscanf cmd "r %d %d %d %s"
 165           (fun n w h p -> (n, w, h, p))
 166       in
 167       Hashtbl.replace state.pixcache (n, w, h) p;
 168       let idx = state.lruidx mod (Array.length state.lru) in
 169       let s = state.lru.(idx) in
 170       if String.length s != 0
 171       then begin
 172         log "free %s" s;
 173         wcmd "free" [`s s];
 174         let l = Hashtbl.fold (fun k s' a ->
 175           if s = s' then k :: a else a) state.pixcache []
 176         in
 177         List.iter (fun k ->
 178           let n,w,h = k in
 179           Hashtbl.remove state.pixcache k) l;
 180       end;
 181       state.lru.(idx) <- p;
 182       state.lruidx <- state.lruidx + 1;
 183       Glut.postRedisplay ();
 184
 185   | 'm' ->
 186       let n = Scanf.sscanf cmd "m %d" (fun n -> n) in
 187       state.maxy <- n
 188
 189   | 'u' ->
 190       let n = Scanf.sscanf cmd "u %d" (fun n -> n) in
 191       let s = Hashtbl.find state.pixcache (n, state.w, state.h) in
 192       Hashtbl.replace state.pixcache (n, state.w, state.h) s
 193
 194   | 'l' ->
 195       let (n, w, h) as pagelayout =
 196         Scanf.sscanf cmd "l %d %d %d" (fun n w h -> n, w, h)
 197       in
 198 (*       if n = 0 *)
 199 (*       then state.pages <- []; *)
 200       state.pages <- pagelayout :: state.pages
 201
 202   | _ ->
 203       log "unknown cmd `%S'" cmd
 204 ;;
 205
 206 let preload
 207     ((pageno, pindex, pagewidth, pageheight, screeny, pageyoffset, screenheight) as page) =
 208   let key = (pageno + 1, state.w, state.h) in
 209   begin try
 210       let pixmap = Hashtbl.find state.pixcache key in
 211       if
 212         String.length pixmap = 0
 213       then
 214         ()
 215       else (
 216         (* preload pixmap *)
 217       );
 218     with Not_found ->
 219       log "preload render %d" pageno;
 220       Hashtbl.add state.pixcache key "";
 221       wcmd "render" [`i (pageno + 1)
 222                     ;`i pindex
 223                     ;`i pagewidth
 224                     ;`i pageheight];
 225   end;
 226 ;;
 227
 228 let idle () =
 229   let r, _, _ = Unix.select [state.csock] [] [] 0.01 in
 230
 231   begin match r with
 232   | [] ->
 233       if false then begin
 234         let h = state.h in
 235         let pages = layout (state.y + state.h) h in
 236         List.iter preload pages;
 237       end
 238
 239   | _ ->
 240       let cmd = readcmd state.csock in
 241       act cmd;
 242   end;
 243 ;;
 244
 245 let clamp incr =
 246   let y = state.y + incr in
 247   let y = max 0 y in
 248   let y = min y state.maxy in
 249   state.y <- y;
 250 ;;
 251
 252 let keyboard ~key ~x ~y =
 253   begin match Char.chr key with
 254   | '\027' | 'q' -> exit 0
 255   | 'n' ->
 256       begin match List.rev state.layout with
 257       | [] -> ()
 258       | (_, _, _, h, _, pyo, sh) :: _ ->
 259           log "%d %d" h pyo;
 260           clamp (h-pyo);
 261           let pages = layout state.y state.h in
 262           state.layout <- pages;
 263           Glut.postRedisplay ();
 264       end
 265
 266   | 'w' ->
 267       begin match state.layout with
 268       | [] -> ()
 269       | (_, _, w, h, _, _, _) :: _ ->
 270           Glut.reshapeWindow w h
 271       end
 272
 273   | 'p' ->
 274       begin match state.layout with
 275       | [] -> ()
 276       | (_, _, _, h, _, _, sh) :: _ ->
 277           clamp ~-h;
 278           let pages = layout state.y state.h in
 279           state.layout <- pages;
 280           Glut.postRedisplay ();
 281       end
 282   | _ -> ()
 283   end;
 284   Glut.postRedisplay ();
 285 ;;
 286
 287 let special ~key ~x ~y =
 288   begin match key with
 289   | Glut.KEY_LEFT      -> ()
 290   | Glut.KEY_RIGHT     -> ()
 291   | Glut.KEY_UP        -> clamp ~-aincr
 292   | Glut.KEY_DOWN      -> clamp aincr
 293   | Glut.KEY_PAGE_UP   -> clamp (-state.h)
 294   | Glut.KEY_PAGE_DOWN -> clamp state.h
 295   | Glut.KEY_HOME -> state.y <- 0
 296   | Glut.KEY_END -> state.y <- state.maxy - state.h
 297   | _ -> ()
 298   end;
 299   let pages = layout state.y state.h in
 300   state.layout <- pages;
 301   Glut.postRedisplay ();
 302 ;;
 303
 304 let colors =
 305   [| (1.0, 0.0, 0.0)
 306   ;  (0.0, 1.0, 0.0)
 307   ;  (0.0, 0.0, 1.0)
 308   ;  (0.0, 0.0, 0.0)
 309   ;  (1.0, 1.0, 1.0)
 310   ;  (1.0, 1.0, 0.0)
 311   ;  (1.0, 0.0, 1.0)
 312   ;  (0.0, 1.0, 1.0)
 313   |]
 314 ;;
 315
 316 let drawplaceholder (pageno, pindex, pagewidth, pageheight,
 317                     screeny, pageyoffset, screenheight) =
 318   GlDraw.color (0.0, 0.0, 0.0);
 319   GlDraw.begins `quads;
 320   GlDraw.vertex2 (0.0, float screeny);
 321   GlDraw.vertex2 (float pagewidth, float screeny);
 322   GlDraw.vertex2 (float pagewidth, float (screeny + screenheight));
 323   GlDraw.vertex2 (0.0, float (screeny + screenheight));
 324   GlDraw.ends ();
 325 ;;
 326
 327 let now () = Unix.gettimeofday ();;
 328
 329 let drawpage i
 330     ((pageno, pindex, pagewidth, pageheight, screeny, pageyoffset, screenheight) as page) =
 331   let key = (pageno + 1, state.w, state.h) in
 332   begin try
 333       let pixmap = Hashtbl.find state.pixcache key in
 334       if
 335         String.length pixmap = 0
 336       then
 337         drawplaceholder page
 338       else (
 339         GlDraw.color (1.0, 1.0, 1.0);
 340         let a = now () in
 341         draw screeny pagewidth screenheight pageyoffset pixmap;
 342         let b = now () in
 343         let d = b-.a in
 344         if d > 0.000405
 345         then
 346           log "draw %f sec" d
 347         ;
 348       );
 349     with Not_found ->
 350       Hashtbl.add state.pixcache key "";
 351       drawplaceholder page;
 352       wcmd "render" [`i (pageno + 1)
 353                     ;`i pindex
 354                     ;`i pagewidth
 355                     ;`i pageheight];
 356   end;
 357   succ i;
 358 ;;
 359
 360 let display () =
 361   GlClear.color (0.5, 0.5, 0.5) ~alpha:0.0;
 362   GlClear.clear [`color];
 363   GlDraw.color (0.0, 0.0, 0.0);
 364   ignore (List.fold_left drawpage 0 (state.layout));
 365   Gl.finish ();
 366   Glut.swapBuffers ();
 367 ;;
 368
 369 let () =
 370   let w = 704
 371   and h = 576 in
 372   let w = 1448 in
 373 (*   let w = 612 *)
 374 (*   and h = 792 in *)
 375   let w = 800
 376   and h = 900 in
 377   let _ = Glut.init Sys.argv in
 378   let () = Glut.initDisplayMode ~depth:false ~double_buffer:true () in
 379   let () = Glut.initWindowSize w h in
 380   let _ = Glut.createWindow "lpdf (press 'h' to get help)" in
 381
 382   let csock, ssock = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
 383   init ssock;
 384   state.w <- w;
 385   state.h <- h;
 386   state.csock <- csock;
 387   state.ssock <- ssock;
 388   let name =
 389     if Array.length Sys.argv = 1
 390     then "/home/malc/x/inc/Info_PT_Sans.pdf"
 391     else Sys.argv.(1)
 392   in
 393   writecmd csock ("open " ^ name ^ "\000");
 394   (* writecmd csock "open /home/malc/x/doc/cell/CBE_Handbook_v1.1_24APR2007_pub.pdf\000"; *)
 395   (* writecmd csock "box 1"; *)
 396
 397   let () = Glut.displayFunc display in
 398   let () = Glut.reshapeFunc reshape in
 399   let () = Glut.keyboardFunc keyboard in
 400   let () = Glut.specialFunc special in
 401   let () = Glut.idleFunc (Some idle) in
 402   (* let () = Glut.mouseFunc mouse in *)
 403   (* let () = Glut.motionFunc motion in *)
 404   Glut.mainLoop ();
 405 ;;