rend.ml

   1 class type draw = object
   2   method draw: unit
   3   method char: char -> draw
   4   method help: (string * string * string) list
   5 end;;
   6
   7 let try_vbo = ref true
   8 let nmo_name = ref None
   9 let anb_names = ref []
  10 let skb_name = ref None
  11 let vp_name = ref ""
  12 let mipmaps = ref false
  13 let slerp_step = ref 1.0
  14
  15 type view =
  16     { mutable w : int
  17     ; mutable h : int
  18     ; mutable rotx : float
  19     ; mutable roty : float
  20     ; mutable rotz : float
  21     ; mutable zoom : float
  22     ; mutable center : (float * float * float)
  23     ; mutable radial_scale : float
  24     ; mutable objs : draw list
  25     ; mutable persp : bool
  26     ; mutable last_time : float
  27     ; mutable animated : bool
  28     ; mutable dumpchan : out_channel Lazy.t
  29     ; mutable dodump : bool
  30     ; mutable aincr : float
  31     ; mutable roteye: bool
  32     ; mutable sphere : bool
  33     ; mutable help : bool
  34     ; mutable x : int
  35     ; mutable y : int
  36     ; mutable mtype : [`none|`zoom|`rotate|`move]
  37     ; mutable transl : (float * float * float)
  38     ; mutable alpha : float
  39     ; mutable ambient : float
  40     ; mutable diffuse : float
  41     }
  42
  43 let view =
  44   { w = 0; h = 0
  45   ; rotx = 4.0; roty = 16.0; rotz = 0.0
  46   ; center = (0.0, 0.0, 0.0)
  47   ; radial_scale = 0.0
  48   ; zoom = 1.2
  49   ; objs = []
  50   ; persp = true
  51   ; last_time = 0.0
  52   ; animated = false
  53   ; dumpchan = lazy (open_out_bin "dump.rgb")
  54   ; dodump = false
  55   ; aincr = 3.0
  56   ; roteye = true
  57   ; sphere = false
  58   ; help = false
  59   ; x = 0
  60   ; y = 0
  61   ; mtype = `none
  62   ; transl = (0.0, 0.0, 0.0)
  63   ; alpha = 0.04
  64   ; ambient = 1.3
  65   ; diffuse = 0.5
  66   }
  67 ;;
  68
  69 let mapchar c = view.objs <- List.map (fun draw -> draw#char c) view.objs;;
  70 let appdraw () = List.iter (fun draw -> draw#draw) view.objs;;
  71 let deg2rad deg = deg /. 180.0 *. acos ~-.1.;;
  72
  73 let center_and_radial_scale (minx, maxx, miny, maxy, minz, maxz) =
  74   let xc = (maxx +. minx) /. 2.0 in
  75   let yc = (maxy +. miny) /. 2.0 in
  76   let zc = (maxz +. minz) /. 2.0 in
  77   let rs =
  78     let rs = maxx -. minx in
  79     let rs = max rs (maxy -. miny) in
  80     let rs = max rs (maxz -. minz) in
  81     rs
  82   in
  83   if false
  84   then (
  85     Format.eprintf "x (% f, % f)@." minx maxx;
  86     Format.eprintf "y (% f, % f)@." miny maxy;
  87     Format.eprintf "z (% f, % f)@." minz maxz;
  88     Format.eprintf "c (% f, % f, % f)@." xc yc zc;
  89     Format.eprintf "rs %f@." rs;
  90   );
  91   ((xc, yc, zc), rs)
  92 ;;
  93
  94 let help () =
  95   let font = Glut.BITMAP_HELVETICA_18 in
  96   let draw_string x y s =
  97     GlPix.raster_pos ~x ~y ();
  98     String.iter (fun c -> Glut.bitmapCharacter ~font ~c:(Char.code c)) s
  99   in
 100   GlMat.mode `projection;
 101   GlMat.push ();
 102   GlMat.load_identity ();
 103   GlMat.mode `modelview;
 104   GlMat.push ();
 105   GlMat.load_identity ();
 106   GlMat.ortho
 107     ~x:(0.0, float view.w)
 108     ~y:(0.0, float view.h)
 109     ~z:(-1., 1.)
 110   ;
 111
 112   Gl.disable `depth_test;
 113   Gl.disable `alpha_test;
 114
 115   GlDraw.polygon_mode `both `fill;
 116   Gl.enable `blend;
 117   GlFunc.blend_func `src_alpha `one_minus_src_alpha;
 118   GlDraw.color (0., 0., 0.) ~alpha:0.3;
 119   GlDraw.rect (0., 0.) (float view.w, float view.h);
 120   Gl.disable `blend;
 121
 122   GlDraw.color (1., 1., 1.);
 123   let rec loop row = function
 124     | [] -> ()
 125     | (s, s2, s3) :: rest ->
 126         let y = view.h - row * 18 - 2 in
 127         let x = if row = 1 then 0.0 else 5.0 in
 128         draw_string (x+.5.0) (float y) s;
 129         draw_string (x+.105.0) (float y) s2;
 130         draw_string (x+.345.0) (float y) s3;
 131         loop (row+1) rest
 132   in
 133   let help =
 134     let onoff b = if b then "on" else "off" in
 135     let angles =
 136       Printf.sprintf "% f, % f, % f" view.rotx view.roty view.rotz
 137     in
 138     [("Keys (h toggles this screen):", "", "")
 139     ;"e", "toggle eye/model rotation", if view.roteye then "eye" else "model"
 140     ;"a", "toggle animation", onoff view.animated
 141     ;"o", "toggle bounding sphere", onoff view.sphere
 142     ;"d", "dump images to dump.rgb", onoff view.dodump
 143     ;"q, ESC", "quit", ""
 144     ;"z,x,arrows", "rotate", angles
 145     ;"0,9", "zoom", Printf.sprintf "%f" view.zoom
 146     ;"< , >", "decrease/increase alpha", Printf.sprintf "%1.2f" view.alpha
 147     ;"[ , ]", "decrease/increase slerp step", Printf.sprintf "%2.1f" !slerp_step
 148     ;"3,4", "decrease/increase ambient", Printf.sprintf "%2.1f" view.ambient
 149     ;"5,6", "decrease/increase diffuse", Printf.sprintf "%2.1f" view.diffuse
 150     ;"","",""
 151     ]
 152   in
 153   let help =
 154     List.fold_left (fun accu draw -> accu @ draw#help) help view.objs
 155   in
 156   loop 1
 157     (help @
 158         ["", "", ""
 159         ;"Move mouse while holding left button pressed to rotate model", "", ""
 160         ;"Move mouse while holding right button pressed to zoom", "", ""
 161         ;"Move mouse while holding left button and shift pressed to move model", "", ""
 162         ;"",
 163         (let tx, ty, tz = view.transl in
 164           Printf.sprintf "translation % f, % f, % f" tx ty tz),
 165         ""
 166         ])
 167   ;
 168
 169   Gl.enable `depth_test;
 170   Gl.enable `alpha_test;
 171   GlMat.pop ();
 172   GlMat.mode `projection;
 173   GlMat.pop ();
 174 ;;
 175
 176 let display () =
 177   GlClear.color (0.5, 0.5, 0.5) ~alpha:1.0;
 178   GlClear.clear [`color; `depth];
 179   GlDraw.color (0.0, 0.0, 0.0);
 180   GlFunc.alpha_func `greater view.alpha;
 181
 182   if view.sphere then (
 183     let cx, cy, cz = view.center in
 184     let cx = -.cx and cy = -.cy and cz = -.cz in
 185     GlDraw.line_width 1.0;
 186     GlMat.mode `modelview;
 187     GlMat.push ();
 188     GlMat.translate3 (cx, cy, cz);
 189     GlDraw.polygon_mode `back `line;
 190     GlDraw.polygon_mode `front `line;
 191     Gl.disable `texture_2d;
 192     GluQuadric.sphere ~radius:(0.7*.view.radial_scale) ~stacks:25 ~slices:25 ();
 193     GlMat.pop ();
 194   );
 195
 196   appdraw ();
 197   if view.help then help ();
 198   Glut.swapBuffers ();
 199
 200   if view.dodump then (
 201     let pix = GlPix.read 0 0 view.w view.h `rgb `ubyte in
 202     let raw = GlPix.to_raw pix in
 203     let pitch = view.w * 3 in
 204     let size = view.h * pitch in
 205     let s = Raw.gets_string raw 0 size in
 206     let dc = Lazy.force view.dumpchan in
 207     let rec loop pos =
 208       let pos = pos - pitch in
 209       if pos < 0 then ()
 210       else (
 211         output dc s pos pitch;
 212         loop pos
 213       )
 214     in
 215     loop size;
 216   );
 217 ;;
 218
 219 let get_eye_and_up () =
 220   if not view.roteye
 221   then
 222     (0.0, 0.0, 2.0), (0.0, 1.0, 0.0)
 223   else
 224     let q =
 225       let rx = deg2rad view.rotx
 226       and ry = deg2rad view.roty
 227       and rz = deg2rad view.rotz in
 228       Qtr.from_euler rz ~-.ry rx
 229     in
 230     let v = Qtr.apply q (Vec.make 0.0 0.0 2.0) in
 231     let u = Qtr.apply q (Vec.make 0.0 1.0 0.0) in
 232     Vec.elts v, Vec.elts u
 233 ;;
 234
 235 let setup w h =
 236   view.w <- w;
 237   view.h <- h;
 238   GlDraw.viewport 0 0 w h;
 239
 240   let rs = view.zoom /. view.radial_scale in
 241
 242   GlMat.mode `projection;
 243   GlMat.load_identity ();
 244   GlMat.translate3 view.transl;
 245   GluMat.perspective
 246     ~fovy:45.0
 247     ~aspect:(float w /. float h)
 248     ~z:(0.1, 10.)
 249   ;
 250
 251   GlMat.mode `modelview;
 252   GlMat.load_identity ();
 253
 254   let eye, up = get_eye_and_up () in
 255   GluMat.look_at
 256     ~eye
 257     ~center:(0.0, 0.0, 0.0)
 258     ~up
 259   ;
 260
 261   if not view.roteye then (
 262     GlMat.rotate ~angle:view.rotx ~x:1.0 ();
 263     GlMat.rotate ~angle:view.roty ~y:~-.1.0 ();
 264     GlMat.rotate ~angle:view.rotz ~z:1.0 ();
 265   );
 266
 267   GlMat.scale3 (-.rs, rs, rs);
 268   GlMat.translate3 view.center;
 269 ;;
 270
 271 let reshape ~w ~h =
 272   setup w h;
 273 ;;
 274
 275 let idle () =
 276   let deadline = view.last_time +. 0.04 in
 277   let currtime = Unix.gettimeofday () in
 278   mapchar 'n';
 279   if deadline > currtime
 280   then
 281     let _ = Unix.select [] [] [] (deadline -. currtime) in
 282     view.last_time <- Unix.gettimeofday ()
 283   else
 284     view.last_time <- view.last_time +. 0.04
 285   ;
 286   Glut.postRedisplay ();
 287 ;;
 288
 289 let keyboard ~key ~x ~y =
 290   begin match Char.chr key with
 291   | '\027' | 'q' -> exit 0
 292   | '9' -> view.zoom <- view.zoom +. 0.05
 293   | '0' -> view.zoom <- view.zoom -. 0.05
 294   | 'z' -> view.roty <- view.roty +. view.aincr
 295   | 'x' -> view.roty <- view.roty -. view.aincr
 296   | 'd' -> view.dodump <- not view.dodump
 297   | 'e' -> view.roteye <- not view.roteye
 298   | 'o' -> view.sphere <- not view.sphere;
 299   | 'h' -> view.help <- not view.help
 300   | 'p' -> Skin.set_text ()
 301   | 'a' ->
 302       if view.animated
 303       then (
 304         view.animated <- false;
 305         Glut.idleFunc None
 306       )
 307       else (
 308         view.animated <- true; view.
 309         last_time <- Unix.gettimeofday ();
 310         Glut.idleFunc (Some idle)
 311       )
 312   | ('f' | 'b') as c when not view.animated -> mapchar c;
 313   | '<' -> view.alpha <- max (view.alpha -. 0.01) 0.0;
 314   | '>' -> view.alpha <- min (view.alpha +. 0.01) 1.0;
 315   | '[' -> slerp_step := max (!slerp_step -. 0.1) 0.0;
 316   | ']' -> slerp_step := min (!slerp_step +. 0.1) 1.0;
 317   | '3' -> view.ambient <- view.ambient -. 0.1;
 318   | '4' -> view.ambient <- view.ambient +. 0.1;
 319   | '5' -> view.diffuse <- view.diffuse -. 0.1;
 320   | '6' -> view.diffuse <- view.diffuse +. 0.1;
 321   | c -> mapchar c;
 322   end;
 323   setup view.w view.h;
 324   Glut.postRedisplay ();
 325 ;;
 326
 327 let special ~key ~x ~y =
 328   begin match key with
 329   | Glut.KEY_LEFT  -> view.rotz <- view.rotz +. view.aincr
 330   | Glut.KEY_RIGHT -> view.rotz <- view.rotz -. view.aincr
 331   | Glut.KEY_UP    -> view.rotx <- view.rotx -. view.aincr
 332   | Glut.KEY_DOWN  -> view.rotx <- view.rotx +. view.aincr
 333   | _ -> ()
 334   end;
 335   setup view.w view.h;
 336   Glut.postRedisplay ();
 337 ;;
 338
 339 let motion ~x ~y =
 340   let dx = (x - view.x) in
 341   let dy = (y - view.y) in
 342   view.x <- x;
 343   view.y <- y;
 344   match view.mtype with
 345   | `move ->
 346       let x, y, z = view.transl in
 347       let dx = float dx /. 100.0
 348       and dy = float dy /. 100.0 in
 349       view.transl <- (x +. dx, y -. dy, z);
 350       setup view.w view.h;
 351       Glut.postRedisplay ();
 352   | `rotate ->
 353       view.rotx <- view.rotx +. float dy;
 354       view.roty <- view.roty -. float dx;
 355       setup view.w view.h;
 356       Glut.postRedisplay ();
 357   | `zoom ->
 358       view.zoom <- view.zoom +. (float dy /. 50.);
 359       setup view.w view.h;
 360       Glut.postRedisplay ();
 361   | `none ->
 362       ()
 363 ;;
 364
 365 let mouse ~button ~state ~x ~y =
 366   if button = Glut.LEFT_BUTTON
 367   then (
 368     if state = Glut.DOWN
 369     then (
 370       view.x <- x;
 371       view.y <- y;
 372       view.mtype <-
 373         if Glut.getModifiers () = Glut.active_shift
 374         then `move else `rotate;
 375     )
 376     else view.mtype <- `none;
 377   )
 378   else if button = Glut.RIGHT_BUTTON
 379   then (
 380     if state = Glut.DOWN
 381     then (
 382       view.x <- x;
 383       view.y <- y;
 384       view.mtype <- `zoom;
 385     )
 386     else view.mtype <- `none;
 387   );
 388 ;;
 389
 390 let main () =
 391   let () = Glut.displayFunc display in
 392   let () = Glut.reshapeFunc reshape in
 393   let () = Glut.keyboardFunc keyboard in
 394   let () = Glut.specialFunc special in
 395   let () = Glut.mouseFunc mouse in
 396   let () = Glut.motionFunc motion in
 397   mapchar '\000';                       (* bootstrap *)
 398   let () = Glut.mainLoop () in
 399   ()
 400 ;;
 401
 402 let add_obj draw =
 403   view.objs <- draw :: view.objs;
 404 ;;
 405
 406 let init minmax =
 407   let (cx, cy, cz), rs = center_and_radial_scale minmax in
 408   view.center <- (-.cx, -.cy, -.cz);
 409   view.radial_scale <- rs;
 410 ;;
 411
 412 let _ =
 413   let w = 704
 414   and h = 576 in
 415   let _ = Glut.init Sys.argv in
 416   let () = Glut.initDisplayMode ~depth:true ~double_buffer:true () in
 417   let () = Glut.initWindowSize w h in
 418   let _ = Glut.createWindow "rend (press 'h' to get help)" in
 419   Gl.enable `depth_test;
 420   Gl.enable `alpha_test;
 421   let setsome r s = r := Some s in
 422   let spec =
 423     ["-slice", Arg.String Slice.openslice, "<path> of file/dir to slice data to"
 424     ;"-index", Arg.Set_string Xff.index_path, "<path> to index"
 425     ;"-base", Arg.String (setsome Xff.base_path), "<directory> base"
 426     ;"-sstep", Arg.Set_float slerp_step, "<float> slerp step"
 427     ;"-novbo", Arg.Clear try_vbo, " do not use vertex buffer objects"
 428     ;("-skb", Arg.String (setsome skb_name),
 429      "<name> use specified skb instead of guessing")
 430     ;"-mipmaps", Arg.Set mipmaps, " use mipmaps"
 431     ;"-vp", Arg.Set_string vp_name, "<path> vertex program"
 432     ]
 433   in
 434   Arg.parse (Arg.align spec)
 435     (fun s ->
 436       if !nmo_name != None
 437       then anb_names := s :: !anb_names
 438       else nmo_name := Some s;
 439     )
 440     "Usage: dormin [options] model.nmo [animation.anb ...]"
 441   ;
 442   if !mipmaps && not (Glut.extensionSupported "GL_SGIS_generate_mipmap")
 443   then (
 444     Format.eprintf "OpenGL does not support automatic mipmap generation@.";
 445     mipmaps := false;
 446   );
 447   Skin.set !vp_name;
 448 ;;