More work on lwo loading. Useful bit - destructuring macro.
[lodematron.git] / file-md2.lisp
blob881e5ef5b06ebcfd1b0489a3fa7053b2beae044a
2 (in-package :cl-lwo)
4 (defconstant +MD2-ANORMS+
5 ( -0.525731 0.000000 0.850651 )
6 ( -0.442863 0.238856 0.864188 )
7 ( -0.295242 0.000000 0.955423 )
8 ( -0.309017 0.500000 0.809017 )
9 ( -0.162460 0.262866 0.951056 )
10 ( 0.000000 0.000000 1.000000 )
11 ( 0.000000 0.850651 0.525731 )
12 ( -0.147621 0.716567 0.681718 )
13 ( 0.147621 0.716567 0.681718 )
14 ( 0.000000 0.525731 0.850651 )
15 ( 0.309017 0.500000 0.809017 )
16 ( 0.525731 0.000000 0.850651 )
17 ( 0.295242 0.000000 0.955423 )
18 ( 0.442863 0.238856 0.864188 )
19 ( 0.162460 0.262866 0.951056 )
20 ( -0.681718 0.147621 0.716567 )
21 ( -0.809017 0.309017 0.500000 )
22 ( -0.587785 0.425325 0.688191 )
23 ( -0.850651 0.525731 0.000000 )
24 ( -0.864188 0.442863 0.238856 )
25 ( -0.716567 0.681718 0.147621 )
26 ( -0.688191 0.587785 0.425325 )
27 ( -0.500000 0.809017 0.309017 )
28 ( -0.238856 0.864188 0.442863 )
29 ( -0.425325 0.688191 0.587785 )
30 ( -0.716567 0.681718 -0.147621 )
31 ( -0.500000 0.809017 -0.309017 )
32 ( -0.525731 0.850651 0.000000 )
33 ( 0.000000 0.850651 -0.525731 )
34 ( -0.238856 0.864188 -0.442863 )
35 ( 0.000000 0.955423 -0.295242 )
36 ( -0.262866 0.951056 -0.162460 )
37 ( 0.000000 1.000000 0.000000 )
38 ( 0.000000 0.955423 0.295242 )
39 ( -0.262866 0.951056 0.162460 )
40 ( 0.238856 0.864188 0.442863 )
41 ( 0.262866 0.951056 0.162460 )
42 ( 0.500000 0.809017 0.309017 )
43 ( 0.238856 0.864188 -0.442863 )
44 ( 0.262866 0.951056 -0.162460 )
45 ( 0.500000 0.809017 -0.309017 )
46 ( 0.850651 0.525731 0.000000 )
47 ( 0.716567 0.681718 0.147621 )
48 ( 0.716567 0.681718 -0.147621 )
49 ( 0.525731 0.850651 0.000000 )
50 ( 0.425325 0.688191 0.587785 )
51 ( 0.864188 0.442863 0.238856 )
52 ( 0.688191 0.587785 0.425325 )
53 ( 0.809017 0.309017 0.500000 )
54 ( 0.681718 0.147621 0.716567 )
55 ( 0.587785 0.425325 0.688191 )
56 ( 0.955423 0.295242 0.000000 )
57 ( 1.000000 0.000000 0.000000 )
58 ( 0.951056 0.162460 0.262866 )
59 ( 0.850651 -0.525731 0.000000 )
60 ( 0.955423 -0.295242 0.000000 )
61 ( 0.864188 -0.442863 0.238856 )
62 ( 0.951056 -0.162460 0.262866 )
63 ( 0.809017 -0.309017 0.500000 )
64 ( 0.681718 -0.147621 0.716567 )
65 ( 0.850651 0.000000 0.525731 )
66 ( 0.864188 0.442863 -0.238856 )
67 ( 0.809017 0.309017 -0.500000 )
68 ( 0.951056 0.162460 -0.262866 )
69 ( 0.525731 0.000000 -0.850651 )
70 ( 0.681718 0.147621 -0.716567 )
71 ( 0.681718 -0.147621 -0.716567 )
72 ( 0.850651 0.000000 -0.525731 )
73 ( 0.809017 -0.309017 -0.500000 )
74 ( 0.864188 -0.442863 -0.238856 )
75 ( 0.951056 -0.162460 -0.262866 )
76 ( 0.147621 0.716567 -0.681718 )
77 ( 0.309017 0.500000 -0.809017 )
78 ( 0.425325 0.688191 -0.587785 )
79 ( 0.442863 0.238856 -0.864188 )
80 ( 0.587785 0.425325 -0.688191 )
81 ( 0.688191 0.587785 -0.425325 )
82 ( -0.147621 0.716567 -0.681718 )
83 ( -0.309017 0.500000 -0.809017 )
84 ( 0.000000 0.525731 -0.850651 )
85 ( -0.525731 0.000000 -0.850651 )
86 ( -0.442863 0.238856 -0.864188 )
87 ( -0.295242 0.000000 -0.955423 )
88 ( -0.162460 0.262866 -0.951056 )
89 ( 0.000000 0.000000 -1.000000 )
90 ( 0.295242 0.000000 -0.955423 )
91 ( 0.162460 0.262866 -0.951056 )
92 ( -0.442863 -0.238856 -0.864188 )
93 ( -0.309017 -0.500000 -0.809017 )
94 ( -0.162460 -0.262866 -0.951056 )
95 ( 0.000000 -0.850651 -0.525731 )
96 ( -0.147621 -0.716567 -0.681718 )
97 ( 0.147621 -0.716567 -0.681718 )
98 ( 0.000000 -0.525731 -0.850651 )
99 ( 0.309017 -0.500000 -0.809017 )
100 ( 0.442863 -0.238856 -0.864188 )
101 ( 0.162460 -0.262866 -0.951056 )
102 ( 0.238856 -0.864188 -0.442863 )
103 ( 0.500000 -0.809017 -0.309017 )
104 ( 0.425325 -0.688191 -0.587785 )
105 ( 0.716567 -0.681718 -0.147621 )
106 ( 0.688191 -0.587785 -0.425325 )
107 ( 0.587785 -0.425325 -0.688191 )
108 ( 0.000000 -0.955423 -0.295242 )
109 ( 0.000000 -1.000000 0.000000 )
110 ( 0.262866 -0.951056 -0.162460 )
111 ( 0.000000 -0.850651 0.525731 )
112 ( 0.000000 -0.955423 0.295242 )
113 ( 0.238856 -0.864188 0.442863 )
114 ( 0.262866 -0.951056 0.162460 )
115 ( 0.500000 -0.809017 0.309017 )
116 ( 0.716567 -0.681718 0.147621 )
117 ( 0.525731 -0.850651 0.000000 )
118 ( -0.238856 -0.864188 -0.442863 )
119 ( -0.500000 -0.809017 -0.309017 )
120 ( -0.262866 -0.951056 -0.162460 )
121 ( -0.850651 -0.525731 0.000000 )
122 ( -0.716567 -0.681718 -0.147621 )
123 ( -0.716567 -0.681718 0.147621 )
124 ( -0.525731 -0.850651 0.000000 )
125 ( -0.500000 -0.809017 0.309017 )
126 ( -0.238856 -0.864188 0.442863 )
127 ( -0.262866 -0.951056 0.162460 )
128 ( -0.864188 -0.442863 0.238856 )
129 ( -0.809017 -0.309017 0.500000 )
130 ( -0.688191 -0.587785 0.425325 )
131 ( -0.681718 -0.147621 0.716567 )
132 ( -0.442863 -0.238856 0.864188 )
133 ( -0.587785 -0.425325 0.688191 )
134 ( -0.309017 -0.500000 0.809017 )
135 ( -0.147621 -0.716567 0.681718 )
136 ( -0.425325 -0.688191 0.587785 )
137 ( -0.162460 -0.262866 0.951056 )
138 ( 0.442863 -0.238856 0.864188 )
139 ( 0.162460 -0.262866 0.951056 )
140 ( 0.309017 -0.500000 0.809017 )
141 ( 0.147621 -0.716567 0.681718 )
142 ( 0.000000 -0.525731 0.850651 )
143 ( 0.425325 -0.688191 0.587785 )
144 ( 0.587785 -0.425325 0.688191 )
145 ( 0.688191 -0.587785 0.425325 )
146 ( -0.955423 0.295242 0.000000 )
147 ( -0.951056 0.162460 0.262866 )
148 ( -1.000000 0.000000 0.000000 )
149 ( -0.850651 0.000000 0.525731 )
150 ( -0.955423 -0.295242 0.000000 )
151 ( -0.951056 -0.162460 0.262866 )
152 ( -0.864188 0.442863 -0.238856 )
153 ( -0.951056 0.162460 -0.262866 )
154 ( -0.809017 0.309017 -0.500000 )
155 ( -0.864188 -0.442863 -0.238856 )
156 ( -0.951056 -0.162460 -0.262866 )
157 ( -0.809017 -0.309017 -0.500000 )
158 ( -0.681718 0.147621 -0.716567 )
159 ( -0.681718 -0.147621 -0.716567 )
160 ( -0.850651 0.000000 -0.525731 )
161 ( -0.688191 0.587785 -0.425325 )
162 ( -0.587785 0.425325 -0.688191 )
163 ( -0.425325 0.688191 -0.587785 )
164 ( -0.425325 -0.688191 -0.587785 )
165 ( -0.587785 -0.425325 -0.688191 )
166 ( -0.688191 -0.587785 -0.425325 ))
168 (define-binary-class md2-header
169 ((ident :u32)
170 (version :u32)
171 (skinwidth :u32)
172 (skinheight :u32)
173 (framesize :u32)
174 (nskins :u32)
175 (nvertices :u32)
176 (nsts :u32)
177 (ntris :u32)
178 (nglcmds :u32)
179 (nframes :u32)
180 (skin-offset :u32)
181 (st-offset :u32)
182 (tris-offset :u32)
183 (frames-offset :u32)
184 (glcmds-offset :u32)
185 (end-offset :u32)))
187 (define-binary-class md2-skin-name
188 ((name :u8 :array-size 64)))
190 (define-binary-class md2-vector
191 ((x :float32)
192 (y :float32)
193 (z :float32)))
195 (define-binary-class md2-st
196 ((s :s32)
197 (t :s32)))
199 (define-binary-class md2-triangle
200 ( (vertex-indices :u32 :array-size 3)
201 (st-indices :u32 :array-size 3)))
203 (define-binary-class md2-vertex
204 ((position :u8 :array-size 3)
205 (normal-index :u8)))
207 (define-binary-class md2-frame-header
208 ((scale :md2-vector)
209 (translate :md2-vector)
210 (name :u8 :array-size 16)))
212 (defun parse-md2-skin-names (offset n stream out)
213 (file-position stream offset)
214 (let ((result nil))
215 (iterate
216 (for i from 0 below n)
217 (collecting (octets-to-string (read-value 'u8 stream :array-size 64))))))
220 (defun parse-md2-sts (offset n stream out)
221 (file-position stream offset)
222 (let ((result (iterate
223 (for i from 0 below n)
224 (collecting (read-value 'md2-st stream)))))
225 result))
227 (defun parse-md2-triangles (offset n stream out)
228 (file-position stream offset)
229 (let ((result (iterate
230 (for i from 0 below n)
231 (collecting (read-value 'md2-triangle stream)))))
232 result))
235 (defun parse-md2-frames (offset n nverts stream out)
236 (file-position stream offset)
237 (let ((frames
238 (iterate
239 (for i from 0 below n)
240 (collecting
241 (let ((header (read-value 'md2-frame-header stream))
242 (vertices
243 (iterate
244 (for j from 0 below nverts)
245 (collecting (read-value 'md2-vertex)))))
246 (list header vertices))))))
247 frames))
249 (defun process-vertices (scale translation vertices)
250 (iterate
251 (for vertex in vertices)
252 (collecting
253 (list
254 (+ (* (aref (position-of vertex) 0) (x-of scale)) (x-of translation))
255 (+ (* (aref (position-of vertex) 1) (y-of scale)) (y-of translation))
256 (+ (* (aref (position-of vertex) 1) (z-of scale)) (z-of translation))))))
258 (defun processs-normals (vertices)
259 (iterate
260 (for vertex in vertices)
261 (collecting (aref +MD2-ANORMS+ (normal-index-of vertex)))))
263 (defun process-sts (sts swidth theight)
264 (for st in sts)
265 (collecting (/ (s-of st) swidth)
266 (/ (t-of st) theight))))
268 (defun process-faces (tris)
269 (iterate
270 (for tri in tris)
271 (collecting (list :vertices
272 (aref (vertex-indices-of tri) 0)
273 (aref (vertex-indices-of tri) 1)
274 (aref (vertex-indices-of tri) 2))
275 (list :uvs
276 (aref (st-indices-of tri) 0)
277 (aref (st-indices-of tri) 1)
278 (aref (st-indices-of tri) 2)))))
281 (defun parse-md2-file (stream out)
282 (let*
283 ((header
284 (read-value 'md2-header stream)))
285 (format *debug-io* "~D Skins ~D Vertices ~D STS ~D Tris" (nskins-of header) (nvertices-of header) (nsts-of header) (ntris-of header))
286 (let*
287 ((skins (parse-md2-skin-names (skin-offset-of header) (nskins-of header) stream out))
288 (sts (parse-md2-sts (st-offset-of header) (nsts-of header) stream out))
289 (tris (parse-md2-triangles (tris-offset-of header) (ntris-of header) stream out))
290 (frames (parse-md2-frames (frames-offset-of header) (nframes-of header) stream out)))
291 (iterate
292 (for frame in frames)
293 (destructuring-bind (header vertices)
294 frame
296 (format ":vertices ~A"
297 (process-vertices (scale-of header) (translation-of header)))
298 (format ":texcoords ~A" (process-sts sts
299 (coerce
300 (skinwidth-of header) 'single-float)
301 (coerce
302 (skinheight-of header) 'single-float)))
303 (format ":normals ~A" (process-normals vertices))
304 (format ":faces ~A " (process-faces tris)))))))