12 ; hdr1
: (int array
* float * int32
* int32
) array
13 ; hdr2
: (int32
* float * float * int32 array
)
27 ; nto
: (int * int * string) array
35 { vertexa
: float array
37 ; normala
: float array
40 ; surfaces
: (int list
* surf
* GlTex.texture_id lazy_t
) list
44 { size
= Xff.rint sbuf
0
45 ; surf
= Xff.rint sbuf
8
46 ; offs
= Xff.rint sbuf
16
47 ; tri_count
= Xff.rint sbuf
20
48 ; strip_count
= Xff.rint sbuf
24
52 let mag i j k s
= sqrt
(i
*.i
+. j
*.j
+. k
*.k
+. s
*.s
);;
54 let verts_in_surf1 surf1 sbuf
=
55 let sbuf = Xff.sbufplus
sbuf surf1
.offs
in
56 let r8 = Xff.r8 sbuf in
57 let rec r1 verts pos
=
58 let a, b
, c
, d
= r8 pos
, r8 (pos
+1), r8 (pos
+2), r8 (pos
+3) in
60 let skip pos = r verts
pos in
62 | 0x05 when c
= 0 -> skip pos
63 | 0x17 when c
= 0 -> skip pos
64 | 0x65 -> r verts
(pos + 4*c
)
65 | 0x68 when a = 1 -> r
(verts
+ c
) (pos + 12*c
)
66 | 0x68 -> skip (pos + 12*c
)
67 | 0x6c -> skip (pos + 16*c
)
68 | 0x6d -> skip (pos + 8*c
)
69 | 0x6e -> skip (pos + 4*c
)
70 | 0x00 when a = 0 && b
= 0 && c
= 0 -> verts
72 let msg = sprintf
"geom (a=%x b=%x c=%x d=%x)" a b c d
in
73 Xff.sbuferr
sbuf pos msg
75 if pos = surf1
.size
then verts
81 let app count
pos index pos_incr index_incr f
=
82 let rec g p i count
= if count
= 0 then () else (
84 g (p
+ pos_incr
) (i
+ index_incr
) (count
-1)
86 in g pos (index
*index_incr
) count
89 let rgeom1 start_index surf1 geom
sbuf =
90 let sbuf = Xff.sbufplus
sbuf surf1
.offs
in
91 let r8, r16s
, r16
, rfloat
=
92 Xff.r8 sbuf, Xff.r16s
sbuf, Xff.r16
sbuf, Xff.rfloat
sbuf
94 let rec r1 counts index prev_count
pos =
95 let a, b
, c
, d
= r8 pos, r8 (pos+1), r8 (pos+2), r8 (pos+3) in
97 let skip pos = r counts index prev_count
pos in
98 let skip2 n
= skip (pos+c
*n
) in
100 | 0x05 when c
= 0 -> skip pos
101 | 0x17 when c
= 0 -> skip pos
104 app c
pos index
4 2 (fun pos index
->
105 let u = r16s
(pos + 0)
106 and v
= r16s
(pos + 2) in
107 let u = float u /. 4096.0
108 and v
= float v
/. 4096.0 in
109 geom
.uva
.(index
+ 0) <- u;
110 geom
.uva
.(index
+ 1) <- v
;
115 let index = index + prev_count
in
116 app c
pos index 12 3 (fun pi vi
->
117 geom
.vertexa
.(vi
+ 0) <- rfloat
(pi
+ 0);
118 geom
.vertexa
.(vi
+ 1) <- rfloat
(pi
+ 4);
119 geom
.vertexa
.(vi
+ 2) <- rfloat
(pi
+ 8);
121 r
(c
:: counts
) index c
(pos + c
*12)
124 app c
pos index 12 3 (fun pi vi
->
125 let x = rfloat
(pi
+ 0) in
126 let y = rfloat
(pi
+ 4) in
127 let z = rfloat
(pi
+ 8) in
128 geom
.normala
.(vi
+ 0) <- x;
129 geom
.normala
.(vi
+ 1) <- y;
130 geom
.normala
.(vi
+ 2) <- z;
135 app c
pos index 12 3 (fun pi vi
->
136 let x = rfloat
(pi
+ 0) in
137 let y = rfloat
(pi
+ 4) in
138 let z = rfloat
(pi
+ 8) in
141 printf
"% f, % f, % f -> %f@." x y z (sqrt
(x*.x +. y*.y +. z*.z));
145 | 0x6c when a = 0 -> skip (pos + 16*c
)
147 app c
pos index 16 1 (fun pi
index ->
148 let a = rfloat
(pi
+ 0) in
149 let b = rfloat
(pi
+ 4) in
150 let c = rfloat
(pi
+ 8) in
151 let d = Xff.rint
sbuf (pi
+ 12) in
152 if a < 0.0 || b < 0.0 || c < 0.0
154 printf
"%d: % f, % f, % f : %d@." index a b c d
156 geom
.skin
.(index) <- (a,b,c,d);
161 app c pos index 8 3 (fun pi vi
->
162 let x = r16s
(pi
+ 0) in
163 let y = r16s
(pi
+ 2) in
164 let z = r16s
(pi
+ 4) in
165 geom
.normala
.(vi
+ 0) <- float x /. 4096.;
166 geom
.normala
.(vi
+ 1) <- float y /. 4096.;
167 geom
.normala
.(vi
+ 2) <- float z /. 4096.;
172 app c pos index 8 1 (fun pi vi
->
173 let a = r16s
(pi
+ 0) in
174 let b = r16s
(pi
+ 2) in
175 let c = r16s
(pi
+ 4) in
176 let d = r16s
(pi
+ 6) in
177 let i = float a /. 4096. in
178 let j = float b /. 4096. in
179 let k = float c /. 4096. in
180 let s = float d /. 4096. in
181 let _ = i,j,k,s in ()
197 | 0x00 when a = 0 && b = 0 && c = 0 ->
198 index + prev_count
, counts
201 let msg = sprintf
"geom (a=%x b=%x c=%x d=%x)" a b c d in
202 Xff.sbuferr
sbuf pos msg
204 and r counts
index prev_count
pos =
206 then index + prev_count
, counts
207 else r1 counts
index prev_count
pos
209 r
[] start_index
0 12
212 let rtext n sectbuf
sbuf =
213 if not
(Xff.cmp
sbuf (`chars
"TEX\000"))
215 Xff.sbuferr
sbuf 0 "invalid TEX signature"
217 let int5 = Array.init
5 (fun n
-> Xff.r32
sbuf (4+n
*4)) in
218 let half2_1 = Array.init
2 (fun n
-> Xff.r16
sbuf (24+n
*2)) in
219 let w = Xff.r16
sbuf 28
220 and h
= Xff.r16
sbuf 30 in
221 let nameoff = int5.(0) in
222 let name = (Xff.rcstrtabent sectbuf
(Int32.to_int
nameoff) 0) in
225 if true then Xff.test2
(name ^
".nto")
226 else Xff.test2
("scee_logo_uk.nto")
229 Nto.r
xff sbuf ~
dim ()
240 let rsrf n sectbuf
sbuf =
241 if not
(Xff.cmp
sbuf (`chars
"SRF\000"))
243 Xff.sbuferr
sbuf 0 "invalid SRF signature"
245 let tricount = Xff.rint
sbuf 4
246 and stripcount
= Xff.rint
sbuf 8
247 and nameoff = Xff.rint
sbuf 12 in
251 let sbuf = Xff.sbufplus
sbuf (16 + n
*16) in
252 let _0 = Array.init
4 (fun n
-> Xff.r8 sbuf n
) in
253 let _1 = Xff.rfloat
sbuf 4 in
254 let _2 = Xff.r32
sbuf 8 in
255 let _3 = Xff.r32
sbuf 12 in
260 let sbuf = Xff.sbufplus
sbuf (16 + 3*16) in
261 let _0 = Xff.r32
sbuf 0 in
262 let _1 = Xff.rfloat
sbuf 4 in
263 let _2 = Xff.rfloat
sbuf 8 in
264 let _3 = Array.init
5 (fun n
-> Xff.r32
sbuf (12 + n
*4)) in
268 let sbuf = Xff.sbufplus
sbuf (16 + 3*16 + 32) in
269 Array.init
48 (fun n
-> Xff.r32
sbuf (n
*4))
271 let name = Xff.rcstrtabent sectbuf
nameoff 0 in
272 { tricount = tricount
273 ; strcount
= stripcount
282 if Array.length
xff.Xff.sections
!= 2
284 Xff.sbuferr sbufxff
0 "number of xff sections is not 2"
286 let sectpos = xff.Xff.sections
.(1).Xff.off
in
287 let sectbuf = Xff.sbufplus sbufxff
sectpos in
288 let nmobuf = Xff.sbufplus
sectbuf xff.Xff.entry
in
289 if not
(Xff.cmp
nmobuf (`chars
"NMO\000"))
291 Xff.sbuferr
nmobuf 0 "invalid NMO signature"
293 let hdrs = Array.init
5 (fun n
->
294 let pos = 0x30 + n
*16 in
295 let off = Xff.rint
nmobuf pos
296 and count
= Xff.rint
nmobuf (pos+4) in
303 Array.init
hdrs.(1).count
(fun n
->
304 let sbuf = Xff.sbufplus
sectbuf (hdrs.(1).off + (n
*32)) in
310 Array.init
hdrs.(2).count
(fun n
->
311 let sbuf = Xff.sbufplus
sectbuf (hdrs.(2).off + (n
*288)) in
316 let num_vertices, num_strips
=
317 let rec calc num_vertices n
=
318 if n
= hdrs.(3).count
then num_vertices
320 let sbuf = Xff.sbufplus
sectbuf (hdrs.(3).off + (n
*32)) in
321 let surf1 = rsurf1 sbuf in
322 let here_verts = verts_in_surf1 surf1 sectbuf in
323 calc (num_vertices + here_verts) (n
+ 1)
325 let num_vertices = calc 0 0 in
328 (fun num_strips surf
-> num_strips + surf
.strcount
) 0 surfs
330 (num_vertices, num_strips)
333 let surf1s = Array.init
hdrs.(3).count
(fun n
->
334 let sbuf = Xff.sbufplus
sectbuf (hdrs.(3).off + (n
*32)) in
344 let nto = text
.nto in
345 let id = GlTex.gen_texture
() in
346 GlTex.bind_texture `texture_2d
id;
347 GlTex.parameter `texture_2d
(`mag_filter `linear
);
348 if !Rend.mipmaps
then (
349 GlTex.parameter `texture_2d
(`min_filter `linear_mipmap_linear
);
350 (* GlTex.parameter `texture_2d (`generate_mipmap true); *)
353 external genmipmaps
:unit -> unit = "ml_set_generate_mipmaps"
358 GlTex.parameter `texture_2d
(`min_filter `linear
);
360 GlTex.parameter `texture_2d
(`wrap_s `repeat
);
361 GlTex.parameter `texture_2d
(`wrap_t `repeat
);
362 let image2d level
(w, h
, data
) =
363 let raw = Raw.of_string data `ubyte
in
364 let pix = GlPix.of_raw
raw `rgba
w h
in
365 GlTex.image2d ~level
pix
367 if !Rend.mipmaps
then Array.iteri
image2d nto else image2d 0 nto.(0);
374 { vertexa
= Array.make
(num_vertices*3) 0.0
375 ; normala
= Array.create
(num_vertices*3) 0.0
376 ; colora
= String.create
(num_vertices*4)
377 ; uva
= Array.make
(num_vertices*2) 0.0
378 ; skin
= Array.create
num_vertices (0., 0., 0., 0)
384 (fun (last_index
, countss
) surf1 ->
385 let index, counts
= rgeom1 last_index
surf1 geom sectbuf in
386 let surf = surfs.(surf1.surf) in
387 let _, _, _, texindex
= surf.hdr1.(1) in
388 let text = texts.(Int32.to_int texindex
) in
389 (index, (List.rev counts
, surf, text) :: countss
)
392 { geom with surfaces
= List.rev surfaces
}
399 !Rend.try_vbo
&& Glut.extensionSupported
"GL_ARB_vertex_buffer_object"
403 (geom.vertexa
, geom.normala
, geom.uva
, geom.skin
, geom.colora
)
406 fun ~textures ~lighting ~solid ~colormaterial
() ->
407 let () = Lazy.force
l in
410 Gl.enable `texture_2d
;
413 GlDraw.line_width
1.0;
414 GlDraw.color
(1., 1., 1.);
416 if colormaterial
then (
417 let a = Rend.view
.Rend.ambient
418 and d = Rend.view
.Rend.diffuse
in
419 GlLight.light
0 (`ambient
(a,a,a,1.));
420 GlLight.light
0 (`diffuse
(d,d,d,1.));
421 Gl.enable `color_material
;
424 GlLight.light
0 (`ambient
(let c = 0.0 in (c,c,c,1.)));
425 GlLight.light
0 (`diffuse
(let c = 1.0 in (c,c,c,1.)));
426 GlLight.material `both
(`ambient
(0.2, 0.2, 0.2, 1.0));
427 GlLight.material `both
(`diffuse
(0.8, 0.8, 0.8, 1.0));
432 Gl.enable `normalize
;
433 GlTex.env
(`mode `modulate
);
434 GlLight.light_model
(`two_side
false);
437 GlTex.env
(`mode `replace
);
439 GlDraw.polygon_mode `both
(if solid
then `fill
else `line
);
441 let rec f last_index
surf = function
444 GlArray.draw_arrays `triangle_strip last_index count
;
445 f (last_index
+ count
) surf rest
446 and g last_index
= function
448 | (counts
, surf, id) :: rest
->
449 let texid = Lazy.force
id in
450 GlTex.bind_texture `texture_2d
texid;
451 let last_index = f last_index surf counts
in
461 Gl.disable `texture_2d
;
462 Gl.disable `lighting
;
464 Gl.disable `color_material
;
469 let draw = draw geom in
470 let onoff c s b = c, "toggle " ^
s, if b then "on" else "off" in
476 val colormaterial
= false
479 [onoff "t" "textures" textures
480 ;onoff "l" "lighting" lighting
481 ;onoff "w" "wireframe" (not solid
)
482 ;onoff "c" "color material" colormaterial
483 ;onoff "m" "model" dodraw
489 draw ~textures ~lighting ~solid ~colormaterial
()
493 | 't'
-> {< textures
= not textures
>}
494 | '
l'
-> {< lighting
= not lighting
>}
495 | '
w'
-> {< solid
= not solid
>}
496 | '
c'
-> {< colormaterial
= not colormaterial
>}
497 | 'm'
-> {< dodraw
= not dodraw
>}
504 match !Rend.nmo_name
with
505 | None
-> failwith
"must supply model name"
506 | Some
s -> Filename.basename
s
508 let x, sbuf = Xff.test2
name in
509 let geom = r x sbuf in
511 let rec f ((minx
, maxx
, miny
, maxy
, minz
, maxz
) as minmax) i =
512 if i >= Array.length
geom.vertexa
515 let x = geom.vertexa
.(i+0) in
516 let y = geom.vertexa
.(i+1) in
517 let z = geom.vertexa
.(i+2) in
519 min minx
x, max maxx
x,
520 min miny
y, max maxy
y,
521 min minz
z, max maxz
z
525 let x = geom.vertexa
.(0) in
526 let y = geom.vertexa
.(1) in
527 let z = geom.vertexa
.(2) in
528 f (x, x, y, y, z, z) 3
531 Rend.add_obj
(obj geom);