rend.ml

   1 type cmd = | Char of char | Draw;;
   2 type func = cmd -> func_ret
   3 and func_ret = Func of func
   4
   5 let nmo_name = ref None
   6 let anb_name = ref None
   7
   8 type view =
   9     { mutable w : int
  10     ; mutable h : int
  11     ; mutable rotx : float
  12     ; mutable roty : float
  13     ; mutable rotz : float
  14     ; mutable zoom : float
  15     ; mutable center : (float * float * float)
  16     ; mutable radial_scale : float
  17     ; mutable func : func list
  18     ; mutable persp : bool
  19     ; mutable last_time : float
  20     ; mutable animated : bool
  21     ; mutable dumpchan : out_channel Lazy.t
  22     ; mutable dodump : bool
  23     ; mutable aincr : float
  24     ; mutable roteye: bool
  25     ; mutable sphere : bool
  26     ; mutable help : bool
  27     ; mutable x : int
  28     ; mutable y : int
  29     ; mutable mtype : [`none|`zoom|`rotate]
  30     }
  31
  32 let view =
  33   { w = 0; h = 0
  34   ; rotx = 0.0; roty = 0.0; rotz = 0.0
  35   ; center = (0.0, 0.0, 0.0)
  36   ; radial_scale = 0.0
  37   ; zoom = 1.0
  38   ; func = []
  39   ; persp = true
  40   ; last_time = 0.0
  41   ; animated = false
  42   ; dumpchan = lazy (open_out_bin "dump.rgb")
  43   ; dodump = false
  44   ; aincr = 3.0
  45   ; roteye = true
  46   ; sphere = false
  47   ; help = true
  48   ; x = 0
  49   ; y = 0
  50   ; mtype = `none
  51   }
  52 ;;
  53
  54 let deg2rad deg = deg /. 180.0 *. acos ~-.1.;;
  55
  56 let center_and_radial_scale (minx, maxx, miny, maxy, minz, maxz) =
  57   let xc = (maxx -. minx) /. 2.0 +. minx in
  58   let yc = (maxy -. miny) /. 2.0 +. miny in
  59   let zc = (maxz -. minz) /. 2.0 +. minz in
  60   let rs =
  61     let rs = maxx -. minx in
  62     let rs = max rs (maxy -. miny) in
  63     let rs = max rs (maxz -. minz) in
  64     rs
  65   in
  66   if false
  67   then (
  68     Format.eprintf "x (% f, % f)@." minx maxx;
  69     Format.eprintf "y (% f, % f)@." miny maxy;
  70     Format.eprintf "z (% f, % f)@." minz maxz;
  71     Format.eprintf "c (% f, % f, % f)@." xc yc zc;
  72     Format.eprintf "rs %f@." rs;
  73   );
  74   ((xc, yc, zc), rs)
  75 ;;
  76
  77 let help () =
  78   let font = Glut.BITMAP_HELVETICA_18 in
  79   let draw_string x y s =
  80     GlPix.raster_pos ~x ~y ();
  81     String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
  82   in
  83   GlDraw.color (0., 0., 0.);
  84   GlMat.mode `projection;
  85   GlMat.push ();
  86   GlMat.load_identity ();
  87   GlMat.mode `modelview;
  88   GlMat.push ();
  89   GlMat.load_identity ();
  90   GlMat.ortho
  91     ~x:(0.0, float view.w)
  92     ~y:(0.0, float view.h)
  93     ~z:(-1., 1.)
  94   ;
  95   Gl.disable `depth_test;
  96   let rec loop row = function
  97     | [] -> ()
  98     | (s, s2) :: rest ->
  99         let y = view.h - row * 18 in
 100         draw_string 0.0 (float y) s;
 101         draw_string 100.0 (float y) s2;
 102         loop (row+1) rest
 103   in
 104   loop 1
 105     [("Keys:", "")
 106     ;" h", "toggle help"
 107     ;" e", "toggle eye/model rotation"
 108     ;" s", "toggle skeleton"
 109     ;" t", "toggle texturing"
 110     ;" l", "toggle lighting"
 111     ;" m", "toggle model"
 112     ;" w", "toggle wireframe"
 113     ;" a", "toggle animation"
 114     ;" o", "toggle bounding sphere"
 115     ;" f", "forward one frame"
 116     ;" b", "backward one frame"
 117     ;" r", "bring skeleton to rest pose and set frame number to 0"
 118     ;" d", "dump images to dump.rgb"
 119     ;" z,x,arrows", "rotate"
 120     ;" 0,9", "zoom"
 121     ;"", ""
 122     ;"Move mouse while holding left button pressed to rotate model", ""
 123     ;"Move mouse while holding right button pressed to zoom", ""
 124     ];
 125
 126   Gl.enable `depth_test;
 127   GlMat.pop ();
 128   GlMat.mode `projection;
 129   GlMat.pop ();
 130 ;;
 131
 132 let display () =
 133   GlClear.color (0.5, 0.5, 0.5) ~alpha:1.0;
 134   GlClear.clear [`color; `depth];
 135   GlDraw.color (0.0, 0.0, 0.0);
 136
 137   if view.sphere then (
 138     let cx, cy, cz = view.center in
 139     let cx = -.cx and cy = -.cy and cz = -.cz in
 140     GlMat.mode `modelview;
 141     GlMat.push ();
 142     GlMat.translate3 (cx, cy, cz);
 143     GlDraw.polygon_mode `back `line;
 144     GlDraw.polygon_mode `front `line;
 145     Gl.disable `texture_2d;
 146     GluQuadric.sphere ~radius:(0.7*.view.radial_scale) ~stacks:25 ~slices:25 ();
 147     GlMat.pop ();
 148   );
 149
 150   List.iter (fun f -> ignore (f Draw)) view.func;
 151   if view.help then help ();
 152   Glut.swapBuffers ();
 153
 154   if view.dodump then (
 155     let pix = GlPix.read 0 0 view.w view.h `rgb `ubyte in
 156     let raw = GlPix.to_raw pix in
 157     let pitch = view.w * 3 in
 158     let size = view.h * pitch in
 159     let s = Raw.gets_string raw 0 size in
 160     let dc = Lazy.force view.dumpchan in
 161     let rec loop pos =
 162       let pos = pos - pitch in
 163       if pos < 0 then ()
 164       else (
 165         output dc s pos pitch;
 166         loop pos
 167       )
 168     in
 169     loop size;
 170   );
 171 ;;
 172
 173 let get_eye_and_up () =
 174   if not view.roteye
 175   then
 176     (0.0, 0.0, 2.0), (0.0, 1.0, 0.0)
 177   else
 178     let q =
 179       let rx = deg2rad view.rotx
 180       and ry = deg2rad view.roty
 181       and rz = deg2rad view.rotz in
 182       Qtr.from_euler rz ~-.ry rx
 183     in
 184     let v = Qtr.apply q (Vec.make 0.0 0.0 2.0) in
 185     let u = Qtr.apply q (Vec.make 0.0 1.0 0.0) in
 186     Vec.elts v, Vec.elts u
 187 ;;
 188
 189 let setup w h =
 190   view.w <- w;
 191   view.h <- h;
 192   GlDraw.viewport 0 0 w h;
 193
 194   let cx, cy, cz = view.center in
 195   let rs = view.zoom /. view.radial_scale in
 196
 197   GlMat.mode `projection;
 198   GlMat.load_identity ();
 199   GluMat.perspective
 200     ~fovy:45.0
 201     ~aspect:(float w /. float h)
 202     ~z:(0.1, 10.)
 203   ;
 204
 205   GlMat.mode `modelview;
 206   GlMat.load_identity ();
 207
 208   let eye, up = get_eye_and_up () in
 209   GluMat.look_at
 210     ~eye
 211     ~center:(0.0, 0.0, 0.0)
 212     ~up
 213   ;
 214
 215   GlMat.scale3 (rs, rs, rs);
 216
 217   if not view.roteye then (
 218     GlMat.rotate ~angle:view.rotx ~x:1.0 ();
 219     GlMat.rotate ~angle:view.roty ~y:~-.1.0 ();
 220     GlMat.rotate ~angle:view.rotz ~z:1.0 ();
 221   );
 222   GlMat.translate3 (cx, cy, cz);
 223 ;;
 224
 225 let reshape ~w ~h =
 226   setup w h;
 227 ;;
 228
 229 let allfunc cmd =
 230   view.func <- List.map (fun f -> let Func fr = f cmd in fr)  view.func;
 231 ;;
 232
 233 let idle () =
 234   let deadline = view.last_time +. 0.04 in
 235   let currtime = Unix.gettimeofday () in
 236   if deadline > currtime
 237   then
 238     let _ = Unix.select [] [] [] (deadline -. currtime) in
 239     view.last_time <- Unix.gettimeofday ()
 240   else
 241     view.last_time <- view.last_time +. 0.04
 242   ;
 243   view.func <- List.map (fun f -> let Func fr = f (Char 'f') in fr)  view.func;
 244   Glut.postRedisplay ();
 245 ;;
 246
 247 let keyboard ~key ~x ~y =
 248   begin match Char.chr key with
 249   | '\027' | 'q' -> exit 0
 250   | '9' -> view.zoom <- view.zoom +. 0.05
 251   | '0' -> view.zoom <- view.zoom -. 0.05
 252   | 'z' -> view.roty <- view.roty +. view.aincr
 253   | 'x' -> view.roty <- view.roty -. view.aincr
 254   | 'd' -> view.dodump <- not view.dodump
 255   | 'e' -> view.roteye <- not view.roteye
 256   | 'o' -> view.sphere <- not view.sphere;
 257   | 'h' -> view.help <- not view.help
 258   | 'a' ->
 259       if view.animated
 260       then (
 261         view.animated <- false;
 262         Glut.idleFunc None
 263       )
 264       else (
 265         view.animated <- true; view.
 266         last_time <- Unix.gettimeofday ();
 267         Glut.idleFunc (Some idle)
 268       )
 269   | 'f' | 'b' when not view.animated -> allfunc (Char (Char.chr key))
 270   | c -> allfunc (Char c)
 271   end;
 272   setup view.w view.h;
 273   Glut.postRedisplay ();
 274 ;;
 275
 276 let special ~key ~x ~y =
 277   begin match key with
 278   | Glut.KEY_LEFT  -> view.rotz <- view.rotz +. view.aincr
 279   | Glut.KEY_RIGHT -> view.rotz <- view.rotz -. view.aincr
 280   | Glut.KEY_UP    -> view.rotx <- view.rotx -. view.aincr
 281   | Glut.KEY_DOWN  -> view.rotx <- view.rotx +. view.aincr
 282   | _ -> ()
 283   end;
 284   setup view.w view.h;
 285   Glut.postRedisplay ();
 286 ;;
 287
 288 let motion ~x ~y =
 289   let dx = (x - view.x) in
 290   let dy = (y - view.y) in
 291   view.x <- x;
 292   view.y <- y;
 293   match view.mtype with
 294   | `rotate ->
 295       view.rotx <- view.rotx +. float dy;
 296       view.roty <- view.roty -. float dx;
 297       setup view.w view.h;
 298       Glut.postRedisplay ();
 299   | `zoom ->
 300       view.zoom <- view.zoom +. (float dy /. 50.);
 301       setup view.w view.h;
 302       Glut.postRedisplay ();
 303   | `none ->
 304       ()
 305 ;;
 306
 307 let mouse ~button ~state ~x ~y =
 308   if button = Glut.LEFT_BUTTON
 309   then (
 310     if state = Glut.DOWN
 311     then (
 312       view.x <- x;
 313       view.y <- y;
 314       view.mtype <- `rotate;
 315     )
 316     else view.mtype <- `none;
 317   )
 318   else if button = Glut.RIGHT_BUTTON
 319   then (
 320     if state = Glut.DOWN
 321     then (
 322       view.x <- x;
 323       view.y <- y;
 324       view.mtype <- `zoom;
 325     )
 326     else view.mtype <- `none;
 327   );
 328 ;;
 329
 330 let main () =
 331   let w = 704
 332   and h = 576 in
 333   let _ = Glut.init Sys.argv in
 334   let () = Glut.initDisplayMode ~depth:true ~double_buffer:true () in
 335   let () = Glut.initWindowSize w h in
 336   let _ = Glut.createWindow "rend" in
 337   Gl.enable `depth_test;
 338   Gl.enable `alpha_test;
 339   GlFunc.alpha_func `greater 0.1;
 340   let () = Glut.displayFunc display in
 341   let () = Glut.reshapeFunc reshape in
 342   let () = Glut.keyboardFunc keyboard in
 343   let () = Glut.specialFunc special in
 344   let () = Glut.mouseFunc mouse in
 345   let () = Glut.motionFunc motion in
 346   let () = Glut.mainLoop () in
 347   ()
 348 ;;
 349
 350 let add_func func =
 351   view.func <- func :: view.func;
 352 ;;
 353
 354 let init minmax =
 355   let (cx, cy, cz), rs = center_and_radial_scale minmax in
 356   view.center <- (-.cx, -.cy, -.cz);
 357   view.radial_scale <- rs;
 358 ;;
 359
 360 let _ =
 361   let setsome r s = r := Some s in
 362   let spec =
 363     ["-slice", Arg.String Slice.openslice, " <path> of file to slice data to"
 364     ;"-index", Arg.Set_string Xff.index_path, " <path> of index"
 365     ;"-base", Arg.String (setsome Xff.base_path), " <directory> base"
 366     ]
 367   in
 368   Arg.parse (Arg.align spec)
 369     (fun s ->
 370       if !nmo_name != None then (
 371         if !anb_name != None
 372         then raise (Arg.Bad "invalid usage")
 373         else anb_name := Some s;
 374       ) else nmo_name := Some s;
 375     )
 376     "Usage: dormin model.nmo [animation.anb]"
 377 ;;