1 class type draw
= object
3 method char
: char
-> draw
4 method help
: (string * string * string) list
8 let nmo_name = ref None
10 let skb_name = ref None
12 let mipmaps = ref false
13 let slerp_step = ref 1.0
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
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
45 ; rotx
= 4.0; roty
= 16.0; rotz
= 0.0
46 ; center
= (0.0, 0.0, 0.0)
53 ; dumpchan
= lazy (open_out_bin
"dump.rgb")
62 ; transl
= (0.0, 0.0, 0.0)
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.;;
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
78 let rs = maxx
-. minx
in
79 let rs = max
rs (maxy
-. miny
) in
80 let rs = max
rs (maxz
-. minz
) in
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;
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
100 GlMat.mode `projection
;
102 GlMat.load_identity
();
103 GlMat.mode `modelview
;
105 GlMat.load_identity
();
107 ~x
:(0.0, float view.w
)
108 ~y
:(0.0, float view.h
)
112 Gl.disable `depth_test
;
113 Gl.disable `alpha_test
;
115 GlDraw.polygon_mode `both `fill
;
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
);
122 GlDraw.color
(1., 1., 1.);
123 let rec loop row
= function
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
;
134 let onoff b
= if b
then "on" else "off" in
136 Printf.sprintf
"% f, % f, % f" view.rotx
view.roty
view.rotz
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
154 List.fold_left
(fun accu draw
-> accu
@ draw#
help) help view.objs
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", "", ""
163 (let tx, ty
, tz
= view.transl
in
164 Printf.sprintf
"translation % f, % f, % f" tx ty tz
),
169 Gl.enable `depth_test
;
170 Gl.enable `alpha_test
;
172 GlMat.mode `projection
;
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
;
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
;
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 ();
197 if view.help then help ();
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
208 let pos = pos - pitch in
211 output
dc s pos pitch;
219 let get_eye_and_up () =
222 (0.0, 0.0, 2.0), (0.0, 1.0, 0.0)
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
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
238 GlDraw.viewport
0 0 w h
;
240 let rs = view.zoom
/. view.radial_scale
in
242 GlMat.mode `projection
;
243 GlMat.load_identity
();
244 GlMat.translate3
view.transl
;
247 ~aspect
:(float w
/. float h
)
251 GlMat.mode `modelview
;
252 GlMat.load_identity
();
254 let eye, up
= get_eye_and_up () in
257 ~center
:(0.0, 0.0, 0.0)
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 ();
267 GlMat.scale3
(-.rs, rs, rs);
268 GlMat.translate3
view.center
;
276 let deadline = view.last_time
+. 0.04 in
277 let currtime = Unix.gettimeofday
() in
279 if deadline > currtime
281 let _ = Unix.select
[] [] [] (deadline -. currtime) in
282 view.last_time
<- Unix.gettimeofday
()
284 view.last_time
<- view.last_time
+. 0.04
286 Glut.postRedisplay
();
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
()
304 view.animated
<- false;
308 view.animated
<- true; view.
309 last_time
<- Unix.gettimeofday
();
310 Glut.idleFunc
(Some
idle)
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;
324 Glut.postRedisplay
();
327 let special ~key ~
x ~
y =
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
336 Glut.postRedisplay
();
340 let dx = (x - view.x) in
341 let dy = (y - view.y) in
344 match view.mtype
with
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
);
351 Glut.postRedisplay
();
353 view.rotx
<- view.rotx
+. float dy;
354 view.roty
<- view.roty
-. float dx;
356 Glut.postRedisplay
();
358 view.zoom
<- view.zoom
+. (float dy /. 50.);
360 Glut.postRedisplay
();
365 let mouse ~button ~state ~
x ~
y =
366 if button
= Glut.LEFT_BUTTON
373 if Glut.getModifiers
() = Glut.active_shift
374 then `move
else `rotate
;
376 else view.mtype
<- `none
;
378 else if button
= Glut.RIGHT_BUTTON
386 else view.mtype
<- `none
;
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
403 view.objs
<- draw
:: view.objs
;
407 let (cx, cy
, cz
), rs = center_and_radial_scale minmax
in
408 view.center
<- (-.cx, -.cy
, -.cz
);
409 view.radial_scale
<- rs;
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
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"
434 Arg.parse
(Arg.align
spec)
437 then anb_names := s :: !anb_names
438 else nmo_name := Some
s;
440 "Usage: dormin [options] model.nmo [animation.anb ...]"
442 if !mipmaps && not
(Glut.extensionSupported
"GL_SGIS_generate_mipmap")
444 Format.eprintf
"OpenGL does not support automatic mipmap generation@.";