12 ; hdr1
: (int array
* float * int32
* int32
) array
13 ; hdr2
: (int32
* float * float * int32 array
)
27 ; nto
: (int * int * string)
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 for i
= 0 to pred c
do
117 let vi = index*3 + i
*3
118 and pi
= pos + i
*12 in
119 geom
.vertexa
.(vi + 0) <- rfloat
(pi
+ 0);
120 geom
.vertexa
.(vi + 1) <- rfloat
(pi
+ 4);
121 geom
.vertexa
.(vi + 2) <- rfloat
(pi
+ 8);
123 r
(c
:: counts
) index c
(pos + c
*12)
126 for i
= 0 to pred c
do
127 let vi = index*3 + i
*3 in
128 let x = rfloat
(pos + i
*12 + 0) in
129 let y = rfloat
(pos + i
*12 + 4) in
130 let z = rfloat
(pos + i
*12 + 8) in
131 geom
.normala
.(vi + 0) <- x;
132 geom
.normala
.(vi + 1) <- y;
133 geom
.normala
.(vi + 2) <- z;
137 | 0x6c when a = 0 -> skip (pos + 16*c
)
139 for i
= 0 to pred c
do
140 let pi = pos + i
*16 in
141 let a = rfloat
(pi + 0) in
142 let b = rfloat
(pi + 4) in
143 let c = rfloat
(pi + 8) in
144 let d = Xff.rint
sbuf (pi + 12) in
145 geom
.skin
.(index + i
) <- (a,b,c,d);
150 for i
= 0 to pred
c do
151 let vi = index*3 + i
*3 in
152 let x = r16s
(pos + i
*8 + 0) in
153 let y = r16s
(pos + i
*8 + 2) in
154 let z = r16s
(pos + i
*8 + 4) in
155 geom
.normala
.(vi + 0) <- float x /. 4096.;
156 geom
.normala
.(vi + 1) <- float y /. 4096.;
157 geom
.normala
.(vi + 2) <- float z /. 4096.;
162 for i
= 0 to pred
c do
163 let a = r16s
(pos + i
*8 + 0) in
164 let b = r16s
(pos + i
*8 + 2) in
165 let c = r16s
(pos + i
*8 + 4) in
166 let d = r16s
(pos + i
*8 + 6) in
167 let i = float a /. 4096. in
168 let j = float b /. 4096. in
169 let k = float c /. 4096. in
170 let s = float d /. 4096. in
171 let _ = i,j,k,s in ()
179 for i = 0 to pred
c do
180 let vi = index*4 + i*4 in
190 | 0x00 when a = 0 && b = 0 && c = 0 ->
191 index + prev_count
, counts
194 let msg = sprintf
"geom (a=%x b=%x c=%x d=%x)" a b c d in
195 Xff.sbuferr
sbuf pos msg
197 and r counts
index prev_count
pos =
199 then index + prev_count
, counts
200 else r1 counts
index prev_count
pos
202 r
[] start_index
0 12
205 let rtext n sectbuf
sbuf =
206 if not
(Xff.cmp
sbuf (`chars
"TEX\000"))
208 Xff.sbuferr
sbuf 0 "invalid TEX signature"
210 let int5 = Array.init
5 (fun n
-> Xff.r32
sbuf (4+n
*4)) in
211 let half2_1 = Array.init
2 (fun n
-> Xff.r16
sbuf (24+n
*2)) in
212 let w = Xff.r16
sbuf 28
213 and h
= Xff.r16
sbuf 30 in
214 let nameoff = int5.(0) in
215 let name = (Xff.rcstrtabent sectbuf
(Int32.to_int
nameoff) 0) in
218 if true then Xff.test2
(name ^
".nto")
219 else Xff.test2
("scee_logo_uk.nto")
222 Nto.r
xff sbuf ~
dim ()
233 let rsrf n sectbuf
sbuf =
234 if not
(Xff.cmp
sbuf (`chars
"SRF\000"))
236 Xff.sbuferr
sbuf 0 "invalid SRF signature"
238 let tricount = Xff.rint
sbuf 4
239 and stripcount
= Xff.rint
sbuf 8
240 and nameoff = Xff.rint
sbuf 12 in
244 let sbuf = Xff.sbufplus
sbuf (16 + n
*16) in
245 let _0 = Array.init
4 (fun n
-> Xff.r8 sbuf n
) in
246 let _1 = Xff.rfloat
sbuf 4 in
247 let _2 = Xff.r32
sbuf 8 in
248 let _3 = Xff.r32
sbuf 12 in
253 let sbuf = Xff.sbufplus
sbuf (16 + 3*16) in
254 let _0 = Xff.r32
sbuf 0 in
255 let _1 = Xff.rfloat
sbuf 4 in
256 let _2 = Xff.rfloat
sbuf 8 in
257 let _3 = Array.init
5 (fun n
-> Xff.r32
sbuf (12 + n
*4)) in
261 let sbuf = Xff.sbufplus
sbuf (16 + 3*16 + 32) in
262 Array.init
48 (fun n
-> Xff.r32
sbuf (n
*4))
264 let name = Xff.rcstrtabent sectbuf
nameoff 0 in
265 { tricount = tricount
266 ; strcount
= stripcount
275 if Array.length
xff.Xff.sections
!= 2
277 Xff.sbuferr sbufxff
0 "number of xff sections is not 2"
279 let sectpos = xff.Xff.sections
.(1).Xff.off
in
280 let sectbuf = Xff.sbufplus sbufxff
sectpos in
281 let nmobuf = Xff.sbufplus
sectbuf xff.Xff.entry
in
282 if not
(Xff.cmp
nmobuf (`chars
"NMO\000"))
284 Xff.sbuferr
nmobuf 0 "invalid NMO signature"
286 let hdrs = Array.init
5 (fun n
->
287 let pos = 0x30 + n
*16 in
288 let off = Xff.rint
nmobuf pos
289 and count
= Xff.rint
nmobuf (pos+4) in
296 Array.init
hdrs.(1).count
(fun n
->
297 let sbuf = Xff.sbufplus
sectbuf (hdrs.(1).off + (n
*32)) in
303 Array.init
hdrs.(2).count
(fun n
->
304 let sbuf = Xff.sbufplus
sectbuf (hdrs.(2).off + (n
*288)) in
309 let num_vertices, num_strips
=
310 let rec calc num_vertices n
=
311 if n
= hdrs.(3).count
then num_vertices
313 let sbuf = Xff.sbufplus
sectbuf (hdrs.(3).off + (n
*32)) in
314 let surf1 = rsurf1 sbuf in
315 let here_verts = verts_in_surf1 surf1 sectbuf in
316 calc (num_vertices + here_verts) (n
+ 1)
318 let num_vertices = calc 0 0 in
321 (fun num_strips surf
-> num_strips + surf
.strcount
) 0 surfs
323 (num_vertices, num_strips)
326 let surf1s = Array.init
hdrs.(3).count
(fun n
->
327 let sbuf = Xff.sbufplus
sectbuf (hdrs.(3).off + (n
*32)) in
337 let nto = text
.nto in
338 let (_, _, data
) = nto in
340 let id = GlTex.gen_texture
() in
341 let raw = Raw.of_string data `ubyte
in
342 let pix = GlPix.of_raw
raw `rgba text
.w text
.h
in
343 GlTex.bind_texture `texture_2d
id;
344 GlTex.parameter `texture_2d
(`min_filter `linear
);
345 GlTex.parameter `texture_2d
(`mag_filter `linear
);
346 GlTex.parameter `texture_2d
(`wrap_s `repeat
);
347 GlTex.parameter `texture_2d
(`wrap_t `repeat
);
355 { vertexa
= Array.make
(num_vertices*3) 0.0
356 ; normala
= Array.create
(num_vertices*3) 0.0
357 ; colora
= String.create
(num_vertices*4)
358 ; uva
= Array.make
(num_vertices*2) 0.0
359 ; skin
= Array.create
num_vertices (0., 0., 0., 0)
365 (fun (last_index
, countss
) surf1 ->
366 let index, counts
= rgeom1 last_index
surf1 geom sectbuf in
367 let surf = surfs.(surf1.surf) in
368 let _, _, _, texindex
= surf.hdr1.(1) in
369 let text = texts.(Int32.to_int texindex
) in
370 (index, (List.rev counts
, surf, text) :: countss
)
373 { geom with surfaces
= List.rev surfaces
}
379 Skin.init
(geom.vertexa
, geom.normala
, geom.uva
, geom.skin
, geom.colora
)
382 fun ~textures ~lighting ~solid ~colormaterial
() ->
383 let () = Lazy.force
l in
386 Gl.enable `texture_2d
;
389 GlDraw.line_width
1.0;
390 GlDraw.color
(1., 1., 1.);
392 if colormaterial
then (
393 GlLight.light
0 (`ambient
(let c = 1.0 in (c,c,c,1.)));
394 GlLight.light
0 (`diffuse
(let c = 0.0 in (c,c,c,1.)));
395 Gl.enable `color_material
;
398 GlLight.light
0 (`ambient
(let c = 0.0 in (c,c,c,1.)));
399 GlLight.light
0 (`diffuse
(let c = 1.0 in (c,c,c,1.)));
400 GlLight.material `both
(`ambient
(0.2, 0.2, 0.2, 1.0));
401 GlLight.material `both
(`diffuse
(0.8, 0.8, 0.8, 1.0));
406 Gl.enable `normalize
;
407 GlTex.env
(`mode `modulate
);
408 GlLight.light_model
(`two_side
false);
411 GlTex.env
(`mode `replace
);
413 GlDraw.polygon_mode `both
(if solid
then `fill
else `line
);
415 let rec f last_index
surf = function
418 GlArray.draw_arrays `triangle_strip last_index count
;
419 f (last_index
+ count
) surf rest
420 and g last_index
= function
422 | (counts
, surf, id) :: rest
->
423 let texid = Lazy.force
id in
424 GlTex.bind_texture `texture_2d
texid;
425 let last_index = f last_index surf counts
in
435 Gl.disable `texture_2d
;
436 Gl.disable `lighting
;
438 Gl.disable `color_material
;
443 let draw = draw geom in
444 let rec subfunc dodraw ~textures ~lighting ~solid ~colormaterial
=
449 ?
(colormaterial
=colormaterial
) dodraw
=
450 Rend.Func
(subfunc dodraw ~textures ~lighting ~solid ~colormaterial
)
453 | Rend.Char 't'
-> f ~textures
:(not textures
) dodraw
454 | Rend.Char '
l'
-> f ~lighting
:(not lighting
) dodraw
455 | Rend.Char '
w'
-> f ~solid
:(not solid
) dodraw
456 | Rend.Char '
c'
-> f ~colormaterial
:(not colormaterial
) dodraw
457 | Rend.Char 'm'
-> f (not dodraw
)
458 | Rend.Draw
when dodraw
->
459 draw ~textures ~lighting ~solid ~colormaterial
();
461 | Rend.Char
_ | Rend.Draw
-> f dodraw
463 subfunc true ~textures
:false ~lighting
:false ~solid
:true ~colormaterial
:false
468 match !Rend.nmo_name
with
469 | None
-> failwith
"must supply model name"
470 | Some
s -> Filename.basename
s
472 let x, sbuf = Xff.test2
name in
473 let geom = r x sbuf in
475 let rec f ((minx
, maxx
, miny
, maxy
, minz
, maxz
) as minmax) i =
476 if i >= Array.length
geom.vertexa
then minmax
478 let x = geom.vertexa
.(i+0) in
479 let y = geom.vertexa
.(i+1) in
480 let z = geom.vertexa
.(i+2) in
482 min minx
x, max maxx
x,
483 min miny
y, max maxy
y,
484 min minz
z, max maxz
z
488 let x = geom.vertexa
.(0) in
489 let y = geom.vertexa
.(1) in
490 let z = geom.vertexa
.(2) in
491 f (x, y, z, x, y, z) 3
494 Rend.add_func
(func geom);