2 (in-package :lodematron
)
4 (defun null-terminate (vector)
6 ((zeroat (position 0 vector
)))
8 (subseq vector
0 zeroat
)
11 (defparameter *MD2-ANORMS
*
13 '( -
0.525731 0.000000 0.850651 )
14 '( -
0.442863 0.238856 0.864188 )
15 '( -
0.295242 0.000000 0.955423 )
16 '( -
0.309017 0.500000 0.809017 )
17 '( -
0.162460 0.262866 0.951056 )
18 '( 0.000000 0.000000 1.000000 )
19 '( 0.000000 0.850651 0.525731 )
20 '( -
0.147621 0.716567 0.681718 )
21 '( 0.147621 0.716567 0.681718 )
22 '( 0.000000 0.525731 0.850651 )
23 '( 0.309017 0.500000 0.809017 )
24 '( 0.525731 0.000000 0.850651 )
25 '( 0.295242 0.000000 0.955423 )
26 '( 0.442863 0.238856 0.864188 )
27 '( 0.162460 0.262866 0.951056 )
28 '( -
0.681718 0.147621 0.716567 )
29 '( -
0.809017 0.309017 0.500000 )
30 '( -
0.587785 0.425325 0.688191 )
31 '( -
0.850651 0.525731 0.000000 )
32 '( -
0.864188 0.442863 0.238856 )
33 '( -
0.716567 0.681718 0.147621 )
34 '( -
0.688191 0.587785 0.425325 )
35 '( -
0.500000 0.809017 0.309017 )
36 '( -
0.238856 0.864188 0.442863 )
37 '( -
0.425325 0.688191 0.587785 )
38 '( -
0.716567 0.681718 -
0.147621 )
39 '( -
0.500000 0.809017 -
0.309017 )
40 '( -
0.525731 0.850651 0.000000 )
41 '( 0.000000 0.850651 -
0.525731 )
42 '( -
0.238856 0.864188 -
0.442863 )
43 '( 0.000000 0.955423 -
0.295242 )
44 '( -
0.262866 0.951056 -
0.162460 )
45 '( 0.000000 1.000000 0.000000 )
46 '( 0.000000 0.955423 0.295242 )
47 '( -
0.262866 0.951056 0.162460 )
48 '( 0.238856 0.864188 0.442863 )
49 '( 0.262866 0.951056 0.162460 )
50 '( 0.500000 0.809017 0.309017 )
51 '( 0.238856 0.864188 -
0.442863 )
52 '( 0.262866 0.951056 -
0.162460 )
53 '( 0.500000 0.809017 -
0.309017 )
54 '( 0.850651 0.525731 0.000000 )
55 '( 0.716567 0.681718 0.147621 )
56 '( 0.716567 0.681718 -
0.147621 )
57 '( 0.525731 0.850651 0.000000 )
58 '( 0.425325 0.688191 0.587785 )
59 '( 0.864188 0.442863 0.238856 )
60 '( 0.688191 0.587785 0.425325 )
61 '( 0.809017 0.309017 0.500000 )
62 '( 0.681718 0.147621 0.716567 )
63 '( 0.587785 0.425325 0.688191 )
64 '( 0.955423 0.295242 0.000000 )
65 '( 1.000000 0.000000 0.000000 )
66 '( 0.951056 0.162460 0.262866 )
67 '( 0.850651 -
0.525731 0.000000 )
68 '( 0.955423 -
0.295242 0.000000 )
69 '( 0.864188 -
0.442863 0.238856 )
70 '( 0.951056 -
0.162460 0.262866 )
71 '( 0.809017 -
0.309017 0.500000 )
72 '( 0.681718 -
0.147621 0.716567 )
73 '( 0.850651 0.000000 0.525731 )
74 '( 0.864188 0.442863 -
0.238856 )
75 '( 0.809017 0.309017 -
0.500000 )
76 '( 0.951056 0.162460 -
0.262866 )
77 '( 0.525731 0.000000 -
0.850651 )
78 '( 0.681718 0.147621 -
0.716567 )
79 '( 0.681718 -
0.147621 -
0.716567 )
80 '( 0.850651 0.000000 -
0.525731 )
81 '( 0.809017 -
0.309017 -
0.500000 )
82 '( 0.864188 -
0.442863 -
0.238856 )
83 '( 0.951056 -
0.162460 -
0.262866 )
84 '( 0.147621 0.716567 -
0.681718 )
85 '( 0.309017 0.500000 -
0.809017 )
86 '( 0.425325 0.688191 -
0.587785 )
87 '( 0.442863 0.238856 -
0.864188 )
88 '( 0.587785 0.425325 -
0.688191 )
89 '( 0.688191 0.587785 -
0.425325 )
90 '( -
0.147621 0.716567 -
0.681718 )
91 '( -
0.309017 0.500000 -
0.809017 )
92 '( 0.000000 0.525731 -
0.850651 )
93 '( -
0.525731 0.000000 -
0.850651 )
94 '( -
0.442863 0.238856 -
0.864188 )
95 '( -
0.295242 0.000000 -
0.955423 )
96 '( -
0.162460 0.262866 -
0.951056 )
97 '( 0.000000 0.000000 -
1.000000 )
98 '( 0.295242 0.000000 -
0.955423 )
99 '( 0.162460 0.262866 -
0.951056 )
100 '( -
0.442863 -
0.238856 -
0.864188 )
101 '( -
0.309017 -
0.500000 -
0.809017 )
102 '( -
0.162460 -
0.262866 -
0.951056 )
103 '( 0.000000 -
0.850651 -
0.525731 )
104 '( -
0.147621 -
0.716567 -
0.681718 )
105 '( 0.147621 -
0.716567 -
0.681718 )
106 '( 0.000000 -
0.525731 -
0.850651 )
107 '( 0.309017 -
0.500000 -
0.809017 )
108 '( 0.442863 -
0.238856 -
0.864188 )
109 '( 0.162460 -
0.262866 -
0.951056 )
110 '( 0.238856 -
0.864188 -
0.442863 )
111 '( 0.500000 -
0.809017 -
0.309017 )
112 '( 0.425325 -
0.688191 -
0.587785 )
113 '( 0.716567 -
0.681718 -
0.147621 )
114 '( 0.688191 -
0.587785 -
0.425325 )
115 '( 0.587785 -
0.425325 -
0.688191 )
116 '( 0.000000 -
0.955423 -
0.295242 )
117 '( 0.000000 -
1.000000 0.000000 )
118 '( 0.262866 -
0.951056 -
0.162460 )
119 '( 0.000000 -
0.850651 0.525731 )
120 '( 0.000000 -
0.955423 0.295242 )
121 '( 0.238856 -
0.864188 0.442863 )
122 '( 0.262866 -
0.951056 0.162460 )
123 '( 0.500000 -
0.809017 0.309017 )
124 '( 0.716567 -
0.681718 0.147621 )
125 '( 0.525731 -
0.850651 0.000000 )
126 '( -
0.238856 -
0.864188 -
0.442863 )
127 '( -
0.500000 -
0.809017 -
0.309017 )
128 '( -
0.262866 -
0.951056 -
0.162460 )
129 '( -
0.850651 -
0.525731 0.000000 )
130 '( -
0.716567 -
0.681718 -
0.147621 )
131 '( -
0.716567 -
0.681718 0.147621 )
132 '( -
0.525731 -
0.850651 0.000000 )
133 '( -
0.500000 -
0.809017 0.309017 )
134 '( -
0.238856 -
0.864188 0.442863 )
135 '( -
0.262866 -
0.951056 0.162460 )
136 '( -
0.864188 -
0.442863 0.238856 )
137 '( -
0.809017 -
0.309017 0.500000 )
138 '( -
0.688191 -
0.587785 0.425325 )
139 '( -
0.681718 -
0.147621 0.716567 )
140 '( -
0.442863 -
0.238856 0.864188 )
141 '( -
0.587785 -
0.425325 0.688191 )
142 '( -
0.309017 -
0.500000 0.809017 )
143 '( -
0.147621 -
0.716567 0.681718 )
144 '( -
0.425325 -
0.688191 0.587785 )
145 '( -
0.162460 -
0.262866 0.951056 )
146 '( 0.442863 -
0.238856 0.864188 )
147 '( 0.162460 -
0.262866 0.951056 )
148 '( 0.309017 -
0.500000 0.809017 )
149 '( 0.147621 -
0.716567 0.681718 )
150 '( 0.000000 -
0.525731 0.850651 )
151 '( 0.425325 -
0.688191 0.587785 )
152 '( 0.587785 -
0.425325 0.688191 )
153 '( 0.688191 -
0.587785 0.425325 )
154 '( -
0.955423 0.295242 0.000000 )
155 '( -
0.951056 0.162460 0.262866 )
156 '( -
1.000000 0.000000 0.000000 )
157 '( -
0.850651 0.000000 0.525731 )
158 '( -
0.955423 -
0.295242 0.000000 )
159 '( -
0.951056 -
0.162460 0.262866 )
160 '( -
0.864188 0.442863 -
0.238856 )
161 '( -
0.951056 0.162460 -
0.262866 )
162 '( -
0.809017 0.309017 -
0.500000 )
163 '( -
0.864188 -
0.442863 -
0.238856 )
164 '( -
0.951056 -
0.162460 -
0.262866 )
165 '( -
0.809017 -
0.309017 -
0.500000 )
166 '( -
0.681718 0.147621 -
0.716567 )
167 '( -
0.681718 -
0.147621 -
0.716567 )
168 '( -
0.850651 0.000000 -
0.525731 )
169 '( -
0.688191 0.587785 -
0.425325 )
170 '( -
0.587785 0.425325 -
0.688191 )
171 '( -
0.425325 0.688191 -
0.587785 )
172 '( -
0.425325 -
0.688191 -
0.587785 )
173 '( -
0.587785 -
0.425325 -
0.688191 )
174 '( -
0.688191 -
0.587785 -
0.425325 ) )
175 "Normal lookup table used by md2 normal quantizer" )
177 (define-binary-class md2-header
180 ;; don't rely on skin info in header - it's most likely balls
198 (define-binary-class md2-skin-name
199 ((name :u8
:array-size
64)))
201 (define-binary-class md2-vector
206 (define-binary-class md2-uv
210 (define-binary-class md2-triangle
211 ((vertex-indices :u32
:array-size
3)
212 (uv-indices :u32
:array-size
3)))
214 (define-binary-class md2-vertex
215 ((position :u8
:array-size
3)
218 (define-binary-class md2-frame-header
220 (translate :md2-vector
)
221 (name :u8
:array-size
16)))
224 (defun parse-md2-skin-names (offset n stream
)
225 (file-position stream offset
)
228 (for i from
0 below n
)
229 (collecting (babel:octets-to-string
(read-value 'u8 stream
:array-size
64))))
233 (defun parse-md2-uvs (offset n stream
)
234 (file-position stream offset
)
235 (let ((result (iterate
236 (for i from
0 below n
)
237 (collecting (read-value 'md2-uv stream
)))))
240 (defun parse-md2-triangles (offset n stream
)
241 (file-position stream offset
)
242 (let ((result (iterate
243 (for i from
0 below n
)
244 (collecting (read-value 'md2-triangle stream
)))))
248 (defun parse-md2-frames (offset n size nverts stream
)
249 (file-position stream offset
)
250 (format *debug-io
* "~A Frames~%" n
)
253 (for i from
0 below n
)
254 (format *debug-io
* "Parsing frame ~A~%" i
)
255 (file-position stream
(+ offset
(* i size
)))
256 (format *debug-io
* "File read from ~X~%" (file-position stream
))
258 (let ((header (read-value 'md2-frame-header stream
)))
259 (format *debug-io
* "Header Name ~A~%" (babel::octets-to-string
(null-terminate (name-of header
)))
262 (for j from
0 below nverts
)
263 (collecting (read-value 'md2-vertex stream
)))))
264 (cons header vertices
))))))))
267 (defun process-vertices (scale translation vertices
)
269 (for vertex in vertices
)
272 (+ (* (aref (position-of vertex
) 0) (x-of scale
)) (x-of translation
))
273 (+ (* (aref (position-of vertex
) 1) (y-of scale
)) (y-of translation
))
274 (+ (* (aref (position-of vertex
) 1) (z-of scale
)) (z-of translation
))))))
276 (defun processs-normals (vertices)
278 (for vertex in vertices
)
279 (collecting (aref *MD2-ANORMS
* (normal-index-of vertex
)))))
281 (defun process-uvs (uvs swidth theight
)
284 (collecting (vector2d* (/ (u-of uv
) swidth
) (/ (v-of uv
) theight
)))))
286 (defun process-faces (tris)
291 (aref (vertex-indices-of tri
) 0)
292 (aref (vertex-indices-of tri
) 1)
293 (aref (vertex-indices-of tri
) 2))
295 (aref (uv-indices-of tri
) 0)
296 (aref (uv-indices-of tri
) 1)
297 (aref (uv-indices-of tri
) 2))))))
300 (defun parse-md2-file (stream out
)
303 (read-value 'md2-header stream
)))
304 (format *debug-io
* "~D Skins ~D Vertices ~D UVS ~D Tris" (nskins-of header
) (nvertices-of header
) (nuvs-of header
) (ntris-of header
))
306 ((skins (parse-md2-skin-names (skin-offset-of header
) (nskins-of header
) stream
))
307 (uvs (parse-md2-uvs (uv-offset-of header
) (nuvs-of header
) stream
))
308 (tris (parse-md2-triangles (tris-offset-of header
) (ntris-of header
) stream
))
309 (frames (parse-md2-frames (frames-offset-of header
) (nframes-of header
) (nvertices-of header
) stream
)))
311 (for frame in frames
)
312 (destructuring-bind (header vertices
)
314 (format ":vertices ~A"
315 (process-vertices (scale-of header
) (translation-of header
)))
316 (format ":texcoords ~A" (process-uvs uvs
318 (skinwidth-of header
) 'single-float
)
320 (skinheight-of header
) 'single-float
)))
321 (format ":normals ~A" (process-normals vertices
))
322 (format ":faces ~A " (process-faces tris
)))))))
328 ;; (defparameter *md2-file* (open (merge-pathnames #P"dalekx/tris.md2") :direction :input :element-type '(unsigned-byte 8)))
330 ;; (defparameter *header* (read-value 'md2-header *md2-file*))
332 ;; (defparameter *uvs* (parse-md2-uvs (uv-offset-of *header*) (nuvs-of *header*) *md2-file*))
334 ;; (defparameter *tris* (parse-md2-triangles (tris-offset-of *header*) (ntris-of *header*) *md2-file*))
336 ;; (defparameter *frames* (parse-md2-frames (frames-offset-of *header*) (nframes-of *header*) (framesize-of *header*) (nvertices-of *header*) *md2-file*))
338 ;; (format *debug-io* "~D Skins ~D Vertices ~D UVS ~D Tris" (nskins-of *header*) (nvertices-of *header*) (nuvs-of *header*) (ntris-of *header*))
341 ;; (close *md2-file*)