Made dependent on mixamesh
[lodematron.git] / file-3ds.lisp
blob98b8d4212c041eaa6dd2590c8f4c9c3e7db7ec01
2 (in-package :lodematron)
4 (defconstant +MAIN3DS+ #X4D4D)
5 (defconstant +EDIT3DS+ #X3D3D)
6 (defconstant +EDIT_MATERIAL+ #XAFFF)
7 (defconstant +MAT_NAME01+ #XA000)
8 (defconstant +MAT_AMBIENT+ #XA010) ;;S ambient color [RGB1 and RGB2]
9 (defconstant +MAT_DIFFUSE+ #XA020) ;;S ;; diffuse color idem
10 (defconstant +MAT_SPECULAR+ #xA030) ;;S specular color idem
11 (defconstant +MAT_SHININESS+ #XA040) ;;S shininess [amount of]
12 (defconstant +MAT_STRENGTH+ #XA041) ;;S ;;shin. strength "
13 (defconstant +MAT_TRANSPARENCY+ #XA050) ;;S ;; transparency "
14 (defconstant +MAT_FALLOFF+ #XA052) ;; trans. falloff "
15 ;; A053 S reflect blur "
16 ;; A100 intsh material type [1=flat 2=gour. 3=phong 4=metal]
17 ;; A084 S self illum [amount of]
18 (defconstant +EDIT_CONFIG1+ #X0100)
19 (defconstant +EDIT_CONFIG2+ #X3E3D)
20 (defconstant +EDIT_VIEW_P1+ #X7012)
21 (defconstant +TOP+ #X0001)
22 (defconstant +BOTTOM+ #X0002)
23 (defconstant +LEFT+ #X0003)
24 (defconstant +RIGHT+ #X0004)
25 (defconstant +FRONT+ #X0005)
26 (defconstant +BACK+ #X0006)
27 (defconstant +USER+ #X0007)
28 (defconstant +CAMERA+ #XFFFF)
29 (defconstant +LIGHT+ #X0009)
30 (defconstant +DISABLED+ #X0010)
31 (defconstant +BOGUS+ #X0011)
32 (defconstant +EDIT_VIEW_P2+ #X7011)
33 (defconstant +EDIT_VIEW_P3+ #X7020)
34 (defconstant +EDIT_VIEW1+ #X7001)
35 (defconstant +EDIT_BACKGR+ #X1200)
36 (defconstant +EDIT_AMBIENT+ #X2100)
37 (defconstant +EDIT_OBJECT+ #X4000)
38 (defconstant +OBJ_TRIMESH+ #X4100)
39 (defconstant +TRI_VERTEXL+ #X4110)
40 (defconstant +TRI_VERTEXOPTIONS+ #X4111)
41 (defconstant +TRI_MAPPINGCOORS+ #X4140)
42 (defconstant +TRI_MAPPINGSTANDARD+ #X4170)
43 (defconstant +TRI_FACEL1+ #X4120)
44 (defconstant +TRI_SMOOTH+ #X4150)
45 (defconstant +TRI_MATERIAL+ #X4130)
46 (defconstant +TRI_LOCAL+ #X4160)
47 (defconstant +TRI_VISIBLE+ #X4165)
48 (defconstant +OBJ_LIGHT+ #X4600)
49 (defconstant +LIT_OFF+ #X4620)
50 (defconstant +LIT_SPOT+ #X4610)
51 (defconstant +LIT_UNKNWN01+ #X465A)
52 (defconstant +OBJ_CAMERA+ #X4700)
53 (defconstant +CAM_UNKNWN01+ #X4710)
54 (defconstant +CAM_UNKNWN02+ #X4720)
55 (defconstant +OBJ_UNKNWN01+ #X4710)
56 (defconstant +OBJ_UNKNWN02+ #X4720)
57 (defconstant +EDIT_UNKNW01+ #X1100)
58 (defconstant +EDIT_UNKNW02+ #X1201)
59 (defconstant +EDIT_UNKNW03+ #X1300)
60 (defconstant +EDIT_UNKNW04+ #X1400)
61 (defconstant +EDIT_UNKNW05+ #X1420)
62 (defconstant +EDIT_UNKNW06+ #X1450)
63 (defconstant +EDIT_UNKNW07+ #X1500)
64 (defconstant +EDIT_UNKNW08+ #X2200)
65 (defconstant +EDIT_UNKNW09+ #X2201)
66 (defconstant +EDIT_UNKNW10+ #X2210)
67 (defconstant +EDIT_UNKNW11+ #X2300)
68 (defconstant +EDIT_UNKNW12+ #X2302)
69 (defconstant +EDIT_UNKNW13+ #X2000)
70 (defconstant +EDIT_UNKNW14+ #XAFFF)
71 (defconstant +KEYF3DS+ #XB000)
72 (defconstant +KEYF_UNKNWN01+ #XB00A)
73 ;; +............. #X7001) ( viewport, same as editor )
74 (defconstant +KEYF_FRAMES+ #XB008)
75 (defconstant +KEYF_UNKNWN02+ #XB009)
76 (defconstant +KEYF_OBJDES+ #XB002)
77 (defconstant +KEYF_OBJHIERARCH+ #XB010)
78 (defconstant +KEYF_OBJDUMMYNAME+ #XB011)
79 (defconstant +KEYF_OBJUNKNWN01+ #XB013)
80 (defconstant +KEYF_OBJUNKNWN02+ #XB014)
81 (defconstant +KEYF_OBJUNKNWN03+ #XB015)
82 (defconstant +KEYF_OBJPIVOT+ #XB020)
83 (defconstant +KEYF_OBJUNKNWN04+ #XB021)
84 (defconstant +KEYF_OBJUNKNWN05+ #XB022)
86 ;; >>------ these define the different color chunk types
88 (defconstant +COL_RGB+ #X0010)
89 (defconstant +COL_TRU+ #X0011)
90 (defconstant +COL_UNK+ #X0013)
91 (defconstant +AMOUNT+ #X0030)
94 ;; -- definition of 3ds chunk -----------------------------------------
96 (defclass 3ds-chunk ()
97 ((chunk-id :accessor chunk-id-of)
98 (chunk-size :accessor chunk-size-of)))
100 (defmethod initialize-instance :after ((self 3ds-chunk) &key stream)
101 "Create a 3ds chunk and read it in."
102 (setf (chunk-id-of self) (read-value 'u16 stream))
103 (setf (chunk-size-of self) (read-value 'u32 stream)))
105 (defmethod chunk-size ((chunk 3ds-chunk)) (- (chunk-size-of chunk) 6))
107 ;; -- chunk parser table and macros ------------------------------------
108 (defparameter *3ds-chunk-parsers* (make-hash-table))
111 (defun advance-file-position (stream by)
112 (file-position stream
113 (+ (file-position stream) by)))
115 (defun unknown-3ds-chunk-parser (chunk parent-chunk in-stream out-stream)
116 (declare (ignore parent-chunk out-stream))
117 (formatting *debug-io* "~&Skipping unknown chunk "
118 (:hex :width 4 :fillchar #\0 :form (chunk-id-of chunk))
119 :tab "Size "
120 (:hex :width 4 :fillchar #\0 :form (chunk-size-of chunk))
121 :freshline)
122 (advance-file-position in-stream (chunk-size chunk)))
124 (defmethod parse-chunk ((chunk 3ds-chunk) parent-chunk in-stream out)
125 (funcall (gethash (chunk-id-of chunk) *3ds-chunk-parsers* #'unknown-3ds-chunk-parser)
126 chunk parent-chunk in-stream out))
128 (defmacro make-3ds-chunk-parser ((chunk chunk-sym parent-chunk-sym stream-sym out-sym)
129 &key before after)
130 (with-gensyms (chunk-end)
131 `(setf (gethash ,chunk *3ds-chunk-parsers*)
132 (lambda (,chunk-sym ,parent-chunk-sym ,stream-sym ,out-sym)
133 (declare (ignorable ,stream-sym ,parent-chunk-sym ,out-sym))
134 (formatting *debug-io* "~&Reading 3ds chunk "
135 (:hex :width 4 :fillchar #\0 :form (chunk-id-of ,chunk-sym))
136 :tab "Size "
137 (:hex :width 4 :fillchar #\0 :form (chunk-size-of ,chunk-sym))
138 :tab "At "
139 (:hex :width 4 :fillchar #\0 :form (- (file-position ,stream-sym) 6))
140 :freshline)
141 ,before
142 (let ((,chunk-end (+ (file-position ,stream-sym) (chunk-size ,chunk-sym))))
143 (ignore-errors
144 (iterate
145 (while (not (>= (file-position ,stream-sym) ,chunk-end)))
146 (parse-chunk (make-instance '3ds-chunk :stream ,stream-sym) ,parent-chunk-sym ,stream-sym ,out-sym))))
147 ,after))))
149 ;; -- actual chunk parsers ------------------------------------
152 (make-3ds-chunk-parser
153 (+MAIN3DS+ main-chunk parent-chunk stream out)
154 :before (formatting *debug-io* "Reading main chunk " :freshline))
156 (make-3ds-chunk-parser
157 (+EDIT3DS+ edit-chunk main-chunk stream out)
158 :before (formatting *debug-io* "Reading editor chunk " :freshline))
160 (defparameter *object-name* "")
162 (make-3ds-chunk-parser
163 (+EDIT_OBJECT+ object-chunk edit-chunk stream out)
164 :before (progn (formatting *debug-io* "Reading object chunk " :freshline)
165 (let ((object-name (read-value 'asciiz stream)))
166 (format *debug-io* "Object Name ~A~%" object-name)
167 (setf *object-name* object-name))))
169 (make-3ds-chunk-parser
170 (+OBJ_TRIMESH+ mesh-chunk object-chunk stream out)
171 :before (progn
172 (formatting *debug-io* "Reading trimesh chunk " :freshline)
173 (format *debug-io* "~%(make-mesh ~A " (symbol-name (gensym *object-name*))))
174 :after (format *debug-io* ")~%")
177 (make-3ds-chunk-parser
178 (+OBJ_CAMERA+ camera-chunk edit-chunk stream out)
179 :before (formatting *debug-io* "Reading camera chunk " :freshline))
181 (make-3ds-chunk-parser
182 (+OBJ_LIGHT+ light-chunk edit-chunk stream out)
183 :before (formatting *debug-io* "Reading light chunk " :freshline))
186 (make-3ds-chunk-parser
187 (+TRI_VERTEXL+ vertex-chunk trimesh-chunk stream out)
188 :before (progn (formatting *debug-io* "Reading vertex list chunk " :freshline)
189 (let ((vertex-count (read-value 'u16 stream)))
190 (formatting *debug-io* "Total vertices " :decimal vertex-count)
191 (format *debug-io* "~&~T:vertices '( ")
192 (iterate
193 (for index from 0 below vertex-count)
194 (format *debug-io* "~%~T~T(~F ~F ~F)"
195 (read-value 'float32 stream)
196 (read-value 'float32 stream)
197 (read-value 'float32 stream)))
198 (format *debug-io* ")"))))
200 (make-3ds-chunk-parser
201 (+TRI_FACEL1+ face-chunk trimesh-chunk stream out)
202 :before (progn
203 (formatting *debug-io* "Reading face list chunk " :freshline)
204 (let ((face-count (read-value 'u16 stream)))
205 (formatting *debug-io* "Total Faces " :decimal face-count)
206 (format *debug-io* "~&~T:faces '( ")
207 (iterate
208 (for index from 0 below face-count)
209 (format *debug-io* "~&~T~T(~4D ~4D ~4D)"
210 (read-value 'u16 stream)
211 (read-value 'u16 stream)
212 (read-value 'u16 stream))
213 (read-value 'u16 stream))
214 (format *debug-io* ")"))))
216 (make-3ds-chunk-parser
217 (+TRI_MAPPINGCOORS+ uv-chunk trimesh-chunk stream out)
218 :before (progn
219 (formatting *debug-io* "Reading Mapping list chunk " :freshline)
220 (let ((uv-count (read-value 'u16 stream)))
221 (formatting *debug-io* "Total uvs " :decimal uv-count)
222 (format *debug-io* "~&:texcoords '( ")
223 (iterate
224 (for index from 0 below uv-count)
225 (format *debug-io* "~T~&(~4D ~4D)"
226 (read-value 'float32 stream)
227 (read-value 'float32 stream)))
228 (format *debug-io* ")"))))
230 (make-3ds-chunk-parser
231 (+TRI_LOCAL+ local-coord-chunk trimesh-chunk stream out)
232 :before (progn
233 (formatting *debug-io* "Reading Local coord sys " :freshline)
234 (format *debug-io* "X : ~4D ~4D ~4D ~%"
235 (read-value 'float32 stream)
236 (read-value 'float32 stream)
237 (read-value 'float32 stream))
238 (format *debug-io* "Y : ~4D ~4D ~4D ~%"
239 (read-value 'float32 stream)
240 (read-value 'float32 stream)
241 (read-value 'float32 stream))
242 (format *debug-io* "Z : ~4D ~4D ~4D ~%"
243 (read-value 'float32 stream)
244 (read-value 'float32 stream)
245 (read-value 'float32 stream))
246 (format *debug-io* "O : ~4D ~4D ~4D ~%"
247 (read-value 'float32 stream)
248 (read-value 'float32 stream)
249 (read-value 'float32 stream))))
251 (make-3ds-chunk-parser
252 (+TRI_MATERIAL+ face-material-chunk face-chunk stream out)
253 :before (progn
254 (formatting *debug-io* "Reading face material " :freshline)
255 (let* ((material-name (read-value 'asciiz stream))
256 (face-count (read-value 'u16 stream))
257 (faces (iterate
258 (for i from 0 below face-count)
259 (collect (read-value 'u16 stream)))))
260 (format *debug-io* "Name ~A ~%" material-name)
261 (format *debug-io* "Applied to ~A faces." faces))))
263 (make-3ds-chunk-parser
264 (+EDIT_MATERIAL+ material-chunk edit-chunk stream out)
265 :before (progn
266 (formatting *debug-io* "Reading material Chunk " :freshline)))
268 (make-3ds-chunk-parser
269 (+MAT_NAME01+ material-name-chunk material-chunk stream out)
270 :before (progn
271 (let* ((material-name (read-value 'asciiz stream)))
272 (format *debug-io* "Name ~A %" material-name))))
274 (make-3ds-chunk-parser
275 (+MAT_AMBIENT+ ambient-chunk material-chunk stream out)
276 :before (progn
277 (formatting *debug-io* "Reading ambient color hunk " :freshline)))
280 (make-3ds-chunk-parser
281 (+MAT_DIFFUSE+ diffuse-chunk material-chunk stream out)
282 :before (progn
283 (formatting *debug-io* "Reading diffuse color hunk " :freshline)))
285 (make-3ds-chunk-parser
286 (+MAT_SPECULAR+ specular-chunk material-chunk stream out)
287 :before (progn
288 (formatting *debug-io* "Reading specular color hunk " :freshline)))
290 (make-3ds-chunk-parser ( +MAT_SHININESS+ shiny-chunk material-chunk stream out)
291 :before (progn
292 (formatting *debug-io* "Reading shininess hunk " :freshline)))
294 (make-3ds-chunk-parser ( +MAT_STRENGTH+ strength-chunk material-chunk stream out)
295 :before (progn
296 (formatting *debug-io* "Reading shininess strength chunk " :freshline)))
298 (make-3ds-chunk-parser
299 ( +MAT_FALLOFF+ falloff-chunk material-chunk stream out )
300 :before (progn
301 (formatting *debug-io* "Reading falloff hunk " :freshline)))
303 (make-3ds-chunk-parser
304 ( +AMOUNT+ amount-chunk parent-chunk stream out )
305 :before (let ((amount (read-value 'u16 stream)))
306 (format *debug-io* "Amount ~D" amount)))
308 (make-3ds-chunk-parser
309 (+COL_RGB+ color-chunk parent-chunk stream out)
310 :before (let
311 ((red (read-value 'float32 stream))
312 (green (read-value 'float32 stream))
313 (blue (read-value 'float32 stream)))
314 (format *debug-io* "Red ~F Green ~F Blue ~F" red green blue)))
316 (make-3ds-chunk-parser
317 (+COL_TRU+ color-chunk parent-chunk stream out)
318 :before
319 (let
320 ((red (read-value 'u8 stream))
321 (green (read-value 'u8 stream))
322 (blue (read-value 'u8 stream)))
323 (format *debug-io* "Red ~F Green ~F Blue ~F" red green blue)))
325 ;; to do -- assume output fn is a funcallable mesh
326 (defun parse-3ds-file (input-file output-fn)
327 "Parse the named file as a 3ds file, making meshbuilding calls to the supplied function."
328 (with-open-file
329 (in-stream input-file :element-type '(unsigned-byte 8))
330 (parse-chunk (make-instance '3ds-chunk :stream in-stream) nil in-stream output-fn)))