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-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
))
120 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-size-of chunk
))
122 (advance-file-position in-stream
(chunk-size chunk
)))
124 (defmethod parse-chunk ((chunk 3ds-chunk
) parent-chunk in-stream out-stream
)
125 (funcall (gethash (chunk-id-of chunk
) *3ds-chunk-parsers
* #'unknown-chunk-parser
)
126 chunk parent-chunk in-stream out-stream
))
128 (defmacro make-3ds-chunk-parser
((chunk chunk-sym parent-chunk-sym stream-sym out-sym
)
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
))
137 (:hex
:width
4 :fillchar
#\
0 :form
(chunk-size-of ,chunk-sym
))
139 (:hex
:width
4 :fillchar
#\
0 :form
(- (file-position ,stream-sym
) 6))
142 (let ((,chunk-end
(+ (file-position ,stream-sym
) (chunk-size ,chunk-sym
))))
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
))))
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
)
172 (formatting *debug-io
* "Reading trimesh chunk " :freshline
)
173 (format out
"~%(make-mesh ~A " (symbol-name (gensym *object-name
*))))
174 :after
(format out
")~%"))
176 (make-3ds-chunk-parser
177 (+OBJ_CAMERA
+ camera-chunk edit-chunk stream out
)
178 :before
(formatting *debug-io
* "Reading camera chunk " :freshline
))
180 (make-3ds-chunk-parser
181 (+OBJ_LIGHT
+ light-chunk edit-chunk stream out
)
182 :before
(formatting *debug-io
* "Reading light chunk " :freshline
))
185 (make-3ds-chunk-parser
186 (+TRI_VERTEXL
+ vertex-chunk trimesh-chunk stream out
)
187 :before
(progn (formatting *debug-io
* "Reading vertex list chunk " :freshline
)
188 (let ((vertex-count (read-value 'u16 stream
)))
189 (formatting *debug-io
* "Total vertices " :decimal vertex-count
)
190 (format out
"~&~T:vertices '( ")
192 (for index from
0 below vertex-count
)
193 (format out
"~%~T~T(~F ~F ~F)"
194 (read-value 'float32 stream
)
195 (read-value 'float32 stream
)
196 (read-value 'float32 stream
)))
199 (make-3ds-chunk-parser
200 (+TRI_FACEL1
+ face-chunk trimesh-chunk stream out
)
202 (formatting *debug-io
* "Reading face list chunk " :freshline
)
203 (let ((face-count (read-value 'u16 stream
)))
204 (formatting *debug-io
* "Total Faces " :decimal face-count
)
205 (format out
"~&~T:faces '( ")
207 (for index from
0 below face-count
)
208 (format out
"~&~T~T(~4D ~4D ~4D)"
209 (read-value 'u16 stream
)
210 (read-value 'u16 stream
)
211 (read-value 'u16 stream
))
212 (read-value 'u16 stream
))
215 (make-3ds-chunk-parser
216 (+TRI_MAPPINGCOORS
+ uv-chunk trimesh-chunk stream out
)
218 (formatting *debug-io
* "Reading Mapping list chunk " :freshline
)
219 (let ((uv-count (read-value 'u16 stream
)))
220 (formatting *debug-io
* "Total uvs " :decimal uv-count
)
221 (format out
"~&:texcoords '( ")
223 (for index from
0 below uv-count
)
224 (format out
"~T~&(~4D ~4D)"
225 (read-value 'float32 stream
)
226 (read-value 'float32 stream
)))
229 (make-3ds-chunk-parser
230 (+TRI_LOCAL
+ local-coord-chunk trimesh-chunk stream out
)
232 (formatting *debug-io
* "Reading Local coord sys " :freshline
)
233 (format *debug-io
* "X : ~4D ~4D ~4D ~%"
234 (read-value 'float32 stream
)
235 (read-value 'float32 stream
)
236 (read-value 'float32 stream
))
237 (format *debug-io
* "Y : ~4D ~4D ~4D ~%"
238 (read-value 'float32 stream
)
239 (read-value 'float32 stream
)
240 (read-value 'float32 stream
))
241 (format *debug-io
* "Z : ~4D ~4D ~4D ~%"
242 (read-value 'float32 stream
)
243 (read-value 'float32 stream
)
244 (read-value 'float32 stream
))
245 (format *debug-io
* "O : ~4D ~4D ~4D ~%"
246 (read-value 'float32 stream
)
247 (read-value 'float32 stream
)
248 (read-value 'float32 stream
))))
250 (make-3ds-chunk-parser
251 (+TRI_MATERIAL
+ face-material-chunk face-chunk stream out
)
253 (formatting *debug-io
* "Reading face material " :freshline
)
254 (let* ((material-name (read-value 'asciiz stream
))
255 (face-count (read-value 'u16 stream
))
257 (for i from
0 below face-count
)
258 (collect (read-value 'u16 stream
)))))
259 (format *debug-io
* "Name ~A ~%" material-name
)
260 ;;(format *debug-io* "Applied to ~A faces." faces)
263 (make-3ds-chunk-parser
264 (+EDIT_MATERIAL
+ material-chunk edit-chunk stream out
)
266 (formatting *debug-io
* "Reading material Chunk " :freshline
)))
268 (make-3ds-chunk-parser
269 (+MAT_NAME01
+ material-name-chunk material-chunk stream out
)
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
)
277 (formatting *debug-io
* "Reading ambient color hunk " :freshline
)))
280 (make-3ds-chunk-parser
281 (+MAT_DIFFUSE
+ diffuse-chunk material-chunk stream out
)
283 (formatting *debug-io
* "Reading diffuse color hunk " :freshline
)))
285 (make-3ds-chunk-parser
286 (+MAT_SPECULAR
+ specular-chunk material-chunk stream out
)
288 (formatting *debug-io
* "Reading specular color hunk " :freshline
)))
290 (make-3ds-chunk-parser ( +MAT_SHININESS
+ shiny-chunk material-chunk stream out
)
292 (formatting *debug-io
* "Reading shininess hunk " :freshline
)))
294 (make-3ds-chunk-parser ( +MAT_STRENGTH
+ strength-chunk material-chunk stream out
)
296 (formatting *debug-io
* "Reading shininess strength chunk " :freshline
)))
298 (make-3ds-chunk-parser
299 ( +MAT_FALLOFF
+ falloff-chunk material-chunk stream out
)
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
)
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
)
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 (defun parse-3ds-file (output-file)
327 (out-stream output-file
:if-exists
:overwrite
:direction
:output
)
329 (in-stream #P
"swimsuit.3DS" :element-type
'(unsigned-byte 8))
330 (parse-chunk (make-instance '3ds-chunk
:stream in-stream
) nil in-stream out-stream
))))