1 type cmd
= | Char
of char
| Draw
;;
2 type func
= cmd
-> func_ret
3 and func_ret
= Func
of func
5 let nmo_name = ref None
6 let anb_name = ref None
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
29 ; mutable track_mouse
: bool
34 ; rotx
= 0.0; roty
= 0.0; rotz
= 0.0
35 ; center
= (0.0, 0.0, 0.0)
42 ; dumpchan
= lazy (open_out_bin
"dump.rgb")
54 let deg2rad deg
= deg
/. 180.0 *. acos ~
-.1.;;
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
61 let rs = maxx
-. minx
in
62 let rs = max
rs (maxy
-. miny
) in
63 let rs = max
rs (maxz
-. minz
) in
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;
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
83 GlDraw.color
(0., 0., 0.);
84 GlMat.mode `projection
;
86 GlMat.load_identity
();
87 GlMat.mode `modelview
;
89 GlMat.load_identity
();
91 ~x
:(0.0, float view.w
)
92 ~y
:(0.0, float view.h
)
95 Gl.disable `depth_test
;
96 let rec loop row
= function
99 let y = view.h
- row
* 18 in
100 draw_string 0.0 (float y) s
;
101 draw_string 100.0 (float y) s2
;
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"
123 Gl.enable `depth_test
;
125 GlMat.mode `projection
;
130 GlClear.color
(0.5, 0.5, 0.5) ~alpha
:1.0;
131 GlClear.clear
[`color
; `depth
];
132 GlDraw.color
(0.0, 0.0, 0.0);
134 if view.sphere
then (
135 let cx, cy
, cz
= view.center
in
136 let cx = -.cx and cy
= -.cy
and cz
= -.cz
in
137 GlMat.mode `modelview
;
139 GlMat.translate3
(cx, cy
, cz
);
140 GlDraw.polygon_mode `back `line
;
141 GlDraw.polygon_mode `front `line
;
142 Gl.disable `texture_2d
;
143 GluQuadric.sphere ~radius
:(0.7*.view.radial_scale
) ~stacks
:25 ~slices
:25 ();
147 List.iter
(fun f
-> ignore
(f Draw
)) view.func
;
148 if view.help then help ();
151 if view.dodump
then (
152 let pix = GlPix.read
0 0 view.w
view.h `rgb `ubyte
in
153 let raw = GlPix.to_raw
pix in
154 let pitch = view.w
* 3 in
155 let size = view.h
* pitch in
156 let s = Raw.gets_string
raw 0 size in
157 let dc = Lazy.force
view.dumpchan
in
159 let pos = pos - pitch in
162 output
dc s pos pitch;
170 let get_eye_and_up () =
173 (0.0, 0.0, 2.0), (0.0, 1.0, 0.0)
176 let rx = deg2rad view.rotx
177 and ry
= deg2rad view.roty
178 and rz
= deg2rad view.rotz
in
179 Qtr.from_euler rz ~
-.ry
rx
181 let v = Qtr.apply
q (Vec.make
0.0 0.0 2.0) in
182 let u = Qtr.apply
q (Vec.make
0.0 1.0 0.0) in
183 Vec.elts
v, Vec.elts
u
189 GlDraw.viewport
0 0 w h
;
191 let cx, cy
, cz
= view.center
in
192 let rs = view.zoom
/. view.radial_scale
in
194 GlMat.mode `projection
;
195 GlMat.load_identity
();
198 ~aspect
:(float w
/. float h
)
202 GlMat.mode `modelview
;
203 GlMat.load_identity
();
205 let eye, up
= get_eye_and_up () in
208 ~center
:(0.0, 0.0, 0.0)
212 GlMat.scale3
(rs, rs, rs);
214 if not
view.roteye
then (
215 GlMat.rotate ~angle
:view.rotx ~x
:1.0 ();
216 GlMat.rotate ~angle
:view.roty ~
y:~
-.1.0 ();
217 GlMat.rotate ~angle
:view.rotz ~z
:1.0 ();
219 GlMat.translate3
(cx, cy
, cz
);
227 view.func
<- List.map
(fun f
-> let Func fr
= f cmd
in fr
) view.func
;
231 let deadline = view.last_time
+. 0.04 in
232 let currtime = Unix.gettimeofday
() in
233 if deadline > currtime
235 let _ = Unix.select
[] [] [] (deadline -. currtime) in
236 view.last_time
<- Unix.gettimeofday
()
238 view.last_time
<- view.last_time
+. 0.04
240 view.func
<- List.map
(fun f
-> let Func fr
= f
(Char 'f'
) in fr
) view.func
;
241 Glut.postRedisplay
();
244 let keyboard ~key ~x ~
y =
245 begin match Char.chr key
with
246 | '
\027'
| '
q'
-> exit
0
247 | '
9'
-> view.zoom
<- view.zoom
+. 0.05
248 | '
0'
-> view.zoom
<- view.zoom
-. 0.05
249 | 'z'
-> view.roty
<- view.roty
+. view.aincr
250 | 'x'
-> view.roty
<- view.roty
-. view.aincr
251 | 'd'
-> view.dodump
<- not
view.dodump
252 | 'e'
-> view.roteye
<- not
view.roteye
253 | 'o'
-> view.sphere
<- not
view.sphere
;
254 | 'h'
-> view.help <- not
view.help
258 view.animated
<- false;
262 view.animated
<- true; view.
263 last_time
<- Unix.gettimeofday
();
264 Glut.idleFunc
(Some
idle)
266 | 'f'
| 'b'
when not
view.animated
-> allfunc (Char
(Char.chr key
))
267 | c
-> allfunc (Char c
)
270 Glut.postRedisplay
();
273 let special ~key ~x ~
y =
275 | Glut.KEY_LEFT
-> view.rotz
<- view.rotz
+. view.aincr
276 | Glut.KEY_RIGHT
-> view.rotz
<- view.rotz
-. view.aincr
277 | Glut.KEY_UP
-> view.rotx
<- view.rotx
-. view.aincr
278 | Glut.KEY_DOWN
-> view.rotx
<- view.rotx
+. view.aincr
282 Glut.postRedisplay
();
288 let dx = (x
- view.x
) in
289 let dy = (y - view.y) in
292 view.rotx
<- view.rotx
+. float dy;
293 view.roty
<- view.roty
-. float dx;
295 Glut.postRedisplay
();
298 let mouse ~button ~state ~x ~
y =
299 if button
= Glut.LEFT_BUTTON
305 view.track_mouse
<- true;
307 else view.track_mouse
<- false
313 let _ = Glut.init
Sys.argv
in
314 let () = Glut.initDisplayMode ~depth
:true ~double_buffer
:true () in
315 let () = Glut.initWindowSize
w h
in
316 let _ = Glut.createWindow
"rend" in
317 Gl.enable `depth_test
;
318 Gl.enable `alpha_test
;
319 GlFunc.alpha_func `greater
0.1;
320 let () = Glut.displayFunc
display in
321 let () = Glut.reshapeFunc
reshape in
322 let () = Glut.keyboardFunc
keyboard in
323 let () = Glut.specialFunc
special in
324 let () = Glut.mouseFunc
mouse in
325 let () = Glut.motionFunc
motion in
326 let () = Glut.mainLoop
() in
331 view.func
<- func
:: view.func
;
335 let (cx, cy
, cz
), rs = center_and_radial_scale minmax
in
336 view.center
<- (-.cx, -.cy
, -.cz
);
337 view.radial_scale
<- rs;
341 let setsome r
s = r
:= Some
s in
343 ["-slice", Arg.String
Slice.openslice
, " <path> of file to slice data to"
344 ;"-index", Arg.Set_string
Xff.index_path
, " <path> of index"
345 ;"-base", Arg.String
(setsome Xff.base_path
), " <directory> base"
348 Arg.parse
(Arg.align
spec)
350 if !nmo_name != None
then (
352 then raise
(Arg.Bad
"invalid usage")
353 else anb_name := Some
s;
354 ) else nmo_name := Some
s;
356 "Usage: dormin model.nmo [animation.anb]"