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 (defgeneric chunk-size
(chunk))
98 (defgeneric parse-chunk
(chunk parent-chunk in-stream out
))
100 (defclass 3ds-chunk
()
101 ((chunk-id :accessor chunk-id-of
)
102 (chunk-size :accessor chunk-size-of
)))
104 (defmethod initialize-instance :after
((self 3ds-chunk
) &key stream
)
105 "Create a 3ds chunk and read it in."
106 (setf (chunk-id-of self
) (read-value 'u16 stream
))
107 (setf (chunk-size-of self
) (read-value 'u32 stream
)))
109 (defmethod chunk-size ((chunk 3ds-chunk
)) (- (chunk-size-of chunk
) 6))
111 ;; -- chunk parser table and macros ------------------------------------
112 (defparameter *3ds-chunk-parsers
* (make-hash-table))
115 (defun advance-file-position (stream by
)
116 (file-position stream
117 (+ (file-position stream
) by
)))
119 (defun unknown-3ds-chunk-parser (chunk parent-chunk in-stream out-stream
)
120 (declare (ignore parent-chunk out-stream
))
121 (formatting *debug-io
* "~&Skipping unknown chunk "
122 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-id-of chunk
))
124 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-size-of chunk
))
126 (advance-file-position in-stream
(chunk-size chunk
)))
128 (defmethod parse-chunk ((chunk 3ds-chunk
) parent-chunk in-stream out
)
129 (funcall (gethash (chunk-id-of chunk
) *3ds-chunk-parsers
* #'unknown-3ds-chunk-parser
)
130 chunk parent-chunk in-stream out
))
132 (defmacro make-3ds-chunk-parser
((chunk chunk-sym parent-chunk-sym stream-sym out-sym
)
134 (with-gensyms (chunk-end)
135 `(setf (gethash ,chunk
*3ds-chunk-parsers
*)
136 (lambda (,chunk-sym
,parent-chunk-sym
,stream-sym
,out-sym
)
137 (declare (ignorable ,stream-sym
,parent-chunk-sym
,out-sym
))
138 (formatting *debug-io
* "~&Reading 3ds chunk "
139 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-id-of ,chunk-sym
))
141 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-size-of ,chunk-sym
))
143 (:hex
:width
4 :fillchar
#\
0 :form
(- (file-position ,stream-sym
) 6))
146 (let ((,chunk-end
(+ (file-position ,stream-sym
) (chunk-size ,chunk-sym
))))
149 (while (not (>= (file-position ,stream-sym
) ,chunk-end
)))
150 (parse-chunk (make-instance '3ds-chunk
:stream
,stream-sym
) ,parent-chunk-sym
,stream-sym
,out-sym
))))
153 ;; -- actual chunk parsers ------------------------------------
156 (make-3ds-chunk-parser
157 (+MAIN3DS
+ main-chunk parent-chunk stream out
)
158 :before
(formatting *debug-io
* "Reading main chunk " :freshline
))
160 (make-3ds-chunk-parser
161 (+EDIT3DS
+ edit-chunk main-chunk stream out
)
162 :before
(formatting *debug-io
* "Reading editor chunk " :freshline
))
164 (defparameter *object-name
* "")
166 (make-3ds-chunk-parser
167 (+EDIT_OBJECT
+ object-chunk edit-chunk stream out
)
168 :before
(progn (formatting *debug-io
* "Reading object chunk " :freshline
)
169 (let ((object-name (read-value 'asciiz stream
)))
170 (format *debug-io
* "Object Name ~A~%" object-name
)
171 (setf *object-name
* object-name
))))
173 (make-3ds-chunk-parser
174 (+OBJ_TRIMESH
+ mesh-chunk object-chunk stream out
)
176 (formatting *debug-io
* "Reading trimesh chunk " :freshline
)
177 (format *debug-io
* "~%(make-mesh ~A " (symbol-name (gensym *object-name
*))))
178 :after
(format *debug-io
* ")~%")
181 (make-3ds-chunk-parser
182 (+OBJ_CAMERA
+ camera-chunk edit-chunk stream out
)
183 :before
(formatting *debug-io
* "Reading camera chunk " :freshline
))
185 (make-3ds-chunk-parser
186 (+OBJ_LIGHT
+ light-chunk edit-chunk stream out
)
187 :before
(formatting *debug-io
* "Reading light chunk " :freshline
))
190 (make-3ds-chunk-parser
191 (+TRI_VERTEXL
+ vertex-chunk trimesh-chunk stream out
)
192 :before
(progn (formatting *debug-io
* "Reading vertex list chunk " :freshline
)
193 (let ((vertex-count (read-value 'u16 stream
)))
194 (formatting *debug-io
* "Total vertices " :decimal vertex-count
)
195 (format *debug-io
* "~&~T:vertices '( ")
197 (for index from
0 below vertex-count
)
198 (format *debug-io
* "~%~T~T(~F ~F ~F)"
199 (read-value 'float32 stream
)
200 (read-value 'float32 stream
)
201 (read-value 'float32 stream
)))
202 (format *debug-io
* ")"))))
204 (make-3ds-chunk-parser
205 (+TRI_FACEL1
+ face-chunk trimesh-chunk stream out
)
207 (formatting *debug-io
* "Reading face list chunk " :freshline
)
208 (let ((face-count (read-value 'u16 stream
)))
209 (formatting *debug-io
* "Total Faces " :decimal face-count
)
210 (format *debug-io
* "~&~T:faces '( ")
212 (for index from
0 below face-count
)
213 (format *debug-io
* "~&~T~T(~4D ~4D ~4D)"
214 (read-value 'u16 stream
)
215 (read-value 'u16 stream
)
216 (read-value 'u16 stream
))
217 (read-value 'u16 stream
))
218 (format *debug-io
* ")"))))
220 (make-3ds-chunk-parser
221 (+TRI_MAPPINGCOORS
+ uv-chunk trimesh-chunk stream out
)
223 (formatting *debug-io
* "Reading Mapping list chunk " :freshline
)
224 (let ((uv-count (read-value 'u16 stream
)))
225 (formatting *debug-io
* "Total uvs " :decimal uv-count
)
226 (format *debug-io
* "~&:texcoords '( ")
228 (for index from
0 below uv-count
)
229 (format *debug-io
* "~T~&(~4D ~4D)"
230 (read-value 'float32 stream
)
231 (read-value 'float32 stream
)))
232 (format *debug-io
* ")"))))
234 (make-3ds-chunk-parser
235 (+TRI_LOCAL
+ local-coord-chunk trimesh-chunk stream out
)
237 (formatting *debug-io
* "Reading Local coord sys " :freshline
)
238 (format *debug-io
* "X : ~4D ~4D ~4D ~%"
239 (read-value 'float32 stream
)
240 (read-value 'float32 stream
)
241 (read-value 'float32 stream
))
242 (format *debug-io
* "Y : ~4D ~4D ~4D ~%"
243 (read-value 'float32 stream
)
244 (read-value 'float32 stream
)
245 (read-value 'float32 stream
))
246 (format *debug-io
* "Z : ~4D ~4D ~4D ~%"
247 (read-value 'float32 stream
)
248 (read-value 'float32 stream
)
249 (read-value 'float32 stream
))
250 (format *debug-io
* "O : ~4D ~4D ~4D ~%"
251 (read-value 'float32 stream
)
252 (read-value 'float32 stream
)
253 (read-value 'float32 stream
))))
255 (make-3ds-chunk-parser
256 (+TRI_MATERIAL
+ face-material-chunk face-chunk stream out
)
258 (formatting *debug-io
* "Reading face material " :freshline
)
259 (let* ((material-name (read-value 'asciiz stream
))
260 (face-count (read-value 'u16 stream
))
262 (for i from
0 below face-count
)
263 (collect (read-value 'u16 stream
)))))
264 (format *debug-io
* "Name ~A ~%" material-name
)
265 (format *debug-io
* "Applied to ~A faces." faces
))))
267 (make-3ds-chunk-parser
268 (+EDIT_MATERIAL
+ material-chunk edit-chunk stream out
)
270 (formatting *debug-io
* "Reading material Chunk " :freshline
)))
272 (make-3ds-chunk-parser
273 (+MAT_NAME01
+ material-name-chunk material-chunk stream out
)
275 (let* ((material-name (read-value 'asciiz stream
)))
276 (format *debug-io
* "Name ~A %" material-name
))))
278 (make-3ds-chunk-parser
279 (+MAT_AMBIENT
+ ambient-chunk material-chunk stream out
)
281 (formatting *debug-io
* "Reading ambient color hunk " :freshline
)))
284 (make-3ds-chunk-parser
285 (+MAT_DIFFUSE
+ diffuse-chunk material-chunk stream out
)
287 (formatting *debug-io
* "Reading diffuse color hunk " :freshline
)))
289 (make-3ds-chunk-parser
290 (+MAT_SPECULAR
+ specular-chunk material-chunk stream out
)
292 (formatting *debug-io
* "Reading specular color hunk " :freshline
)))
294 (make-3ds-chunk-parser ( +MAT_SHININESS
+ shiny-chunk material-chunk stream out
)
296 (formatting *debug-io
* "Reading shininess hunk " :freshline
)))
298 (make-3ds-chunk-parser ( +MAT_STRENGTH
+ strength-chunk material-chunk stream out
)
300 (formatting *debug-io
* "Reading shininess strength chunk " :freshline
)))
302 (make-3ds-chunk-parser
303 ( +MAT_FALLOFF
+ falloff-chunk material-chunk stream out
)
305 (formatting *debug-io
* "Reading falloff hunk " :freshline
)))
307 (make-3ds-chunk-parser
308 ( +AMOUNT
+ amount-chunk parent-chunk stream out
)
309 :before
(let ((amount (read-value 'u16 stream
)))
310 (format *debug-io
* "Amount ~D" amount
)))
312 (make-3ds-chunk-parser
313 (+COL_RGB
+ color-chunk parent-chunk stream out
)
315 ((red (read-value 'float32 stream
))
316 (green (read-value 'float32 stream
))
317 (blue (read-value 'float32 stream
)))
318 (format *debug-io
* "Red ~F Green ~F Blue ~F" red green blue
)))
320 (make-3ds-chunk-parser
321 (+COL_TRU
+ color-chunk parent-chunk stream out
)
324 ((red (read-value 'u8 stream
))
325 (green (read-value 'u8 stream
))
326 (blue (read-value 'u8 stream
)))
327 (format *debug-io
* "Red ~F Green ~F Blue ~F" red green blue
)))
329 ;; to do -- assume output fn is a funcallable mesh
330 (defun parse-3ds-file (input-file output-fn
)
331 "Parse the named file as a 3ds file, making meshbuilding calls to the supplied function."
333 (in-stream input-file
:element-type
'(unsigned-byte 8))
334 (parse-chunk (make-instance '3ds-chunk
:stream in-stream
) nil in-stream output-fn
)))
