From 958751c93f909b56f5da726200f0127de638cc50 Mon Sep 17 00:00:00 2001 From: John Connors Date: Sun, 13 Jul 2008 08:46:45 +0100 Subject: [PATCH] Fixing more compilation errors --- file-3ds.lisp | 4 + file-md2.lisp | 625 +++++++++++++++++++++++++++-------------------------- lodematron-rw.lisp | 24 +- lodematron.asd | 8 +- 4 files changed, 345 insertions(+), 316 deletions(-) rewrite file-md2.lisp (66%) diff --git a/file-3ds.lisp b/file-3ds.lisp index 98b8d42..df2400c 100644 --- a/file-3ds.lisp +++ b/file-3ds.lisp @@ -93,6 +93,10 @@ ;; -- definition of 3ds chunk ----------------------------------------- +(defgeneric chunk-size (chunk)) + +(defgeneric parse-chunk (chunk parent-chunk in-stream out)) + (defclass 3ds-chunk () ((chunk-id :accessor chunk-id-of) (chunk-size :accessor chunk-size-of))) diff --git a/file-md2.lisp b/file-md2.lisp dissimilarity index 66% index a03e2fd..b2b500a 100644 --- a/file-md2.lisp +++ b/file-md2.lisp @@ -1,304 +1,321 @@ - -(in-package :lodematron) - -(defconstant +MD2-ANORMS+ - ( -0.525731 0.000000 0.850651 ) - ( -0.442863 0.238856 0.864188 ) - ( -0.295242 0.000000 0.955423 ) - ( -0.309017 0.500000 0.809017 ) - ( -0.162460 0.262866 0.951056 ) - ( 0.000000 0.000000 1.000000 ) - ( 0.000000 0.850651 0.525731 ) - ( -0.147621 0.716567 0.681718 ) - ( 0.147621 0.716567 0.681718 ) - ( 0.000000 0.525731 0.850651 ) - ( 0.309017 0.500000 0.809017 ) - ( 0.525731 0.000000 0.850651 ) - ( 0.295242 0.000000 0.955423 ) - ( 0.442863 0.238856 0.864188 ) - ( 0.162460 0.262866 0.951056 ) - ( -0.681718 0.147621 0.716567 ) - ( -0.809017 0.309017 0.500000 ) - ( -0.587785 0.425325 0.688191 ) - ( -0.850651 0.525731 0.000000 ) - ( -0.864188 0.442863 0.238856 ) - ( -0.716567 0.681718 0.147621 ) - ( -0.688191 0.587785 0.425325 ) - ( -0.500000 0.809017 0.309017 ) - ( -0.238856 0.864188 0.442863 ) - ( -0.425325 0.688191 0.587785 ) - ( -0.716567 0.681718 -0.147621 ) - ( -0.500000 0.809017 -0.309017 ) - ( -0.525731 0.850651 0.000000 ) - ( 0.000000 0.850651 -0.525731 ) - ( -0.238856 0.864188 -0.442863 ) - ( 0.000000 0.955423 -0.295242 ) - ( -0.262866 0.951056 -0.162460 ) - ( 0.000000 1.000000 0.000000 ) - ( 0.000000 0.955423 0.295242 ) - ( -0.262866 0.951056 0.162460 ) - ( 0.238856 0.864188 0.442863 ) - ( 0.262866 0.951056 0.162460 ) - ( 0.500000 0.809017 0.309017 ) - ( 0.238856 0.864188 -0.442863 ) - ( 0.262866 0.951056 -0.162460 ) - ( 0.500000 0.809017 -0.309017 ) - ( 0.850651 0.525731 0.000000 ) - ( 0.716567 0.681718 0.147621 ) - ( 0.716567 0.681718 -0.147621 ) - ( 0.525731 0.850651 0.000000 ) - ( 0.425325 0.688191 0.587785 ) - ( 0.864188 0.442863 0.238856 ) - ( 0.688191 0.587785 0.425325 ) - ( 0.809017 0.309017 0.500000 ) - ( 0.681718 0.147621 0.716567 ) - ( 0.587785 0.425325 0.688191 ) - ( 0.955423 0.295242 0.000000 ) - ( 1.000000 0.000000 0.000000 ) - ( 0.951056 0.162460 0.262866 ) - ( 0.850651 -0.525731 0.000000 ) - ( 0.955423 -0.295242 0.000000 ) - ( 0.864188 -0.442863 0.238856 ) - ( 0.951056 -0.162460 0.262866 ) - ( 0.809017 -0.309017 0.500000 ) - ( 0.681718 -0.147621 0.716567 ) - ( 0.850651 0.000000 0.525731 ) - ( 0.864188 0.442863 -0.238856 ) - ( 0.809017 0.309017 -0.500000 ) - ( 0.951056 0.162460 -0.262866 ) - ( 0.525731 0.000000 -0.850651 ) - ( 0.681718 0.147621 -0.716567 ) - ( 0.681718 -0.147621 -0.716567 ) - ( 0.850651 0.000000 -0.525731 ) - ( 0.809017 -0.309017 -0.500000 ) - ( 0.864188 -0.442863 -0.238856 ) - ( 0.951056 -0.162460 -0.262866 ) - ( 0.147621 0.716567 -0.681718 ) - ( 0.309017 0.500000 -0.809017 ) - ( 0.425325 0.688191 -0.587785 ) - ( 0.442863 0.238856 -0.864188 ) - ( 0.587785 0.425325 -0.688191 ) - ( 0.688191 0.587785 -0.425325 ) - ( -0.147621 0.716567 -0.681718 ) - ( -0.309017 0.500000 -0.809017 ) - ( 0.000000 0.525731 -0.850651 ) - ( -0.525731 0.000000 -0.850651 ) - ( -0.442863 0.238856 -0.864188 ) - ( -0.295242 0.000000 -0.955423 ) - ( -0.162460 0.262866 -0.951056 ) - ( 0.000000 0.000000 -1.000000 ) - ( 0.295242 0.000000 -0.955423 ) - ( 0.162460 0.262866 -0.951056 ) - ( -0.442863 -0.238856 -0.864188 ) - ( -0.309017 -0.500000 -0.809017 ) - ( -0.162460 -0.262866 -0.951056 ) - ( 0.000000 -0.850651 -0.525731 ) - ( -0.147621 -0.716567 -0.681718 ) - ( 0.147621 -0.716567 -0.681718 ) - ( 0.000000 -0.525731 -0.850651 ) - ( 0.309017 -0.500000 -0.809017 ) - ( 0.442863 -0.238856 -0.864188 ) - ( 0.162460 -0.262866 -0.951056 ) - ( 0.238856 -0.864188 -0.442863 ) - ( 0.500000 -0.809017 -0.309017 ) - ( 0.425325 -0.688191 -0.587785 ) - ( 0.716567 -0.681718 -0.147621 ) - ( 0.688191 -0.587785 -0.425325 ) - ( 0.587785 -0.425325 -0.688191 ) - ( 0.000000 -0.955423 -0.295242 ) - ( 0.000000 -1.000000 0.000000 ) - ( 0.262866 -0.951056 -0.162460 ) - ( 0.000000 -0.850651 0.525731 ) - ( 0.000000 -0.955423 0.295242 ) - ( 0.238856 -0.864188 0.442863 ) - ( 0.262866 -0.951056 0.162460 ) - ( 0.500000 -0.809017 0.309017 ) - ( 0.716567 -0.681718 0.147621 ) - ( 0.525731 -0.850651 0.000000 ) - ( -0.238856 -0.864188 -0.442863 ) - ( -0.500000 -0.809017 -0.309017 ) - ( -0.262866 -0.951056 -0.162460 ) - ( -0.850651 -0.525731 0.000000 ) - ( -0.716567 -0.681718 -0.147621 ) - ( -0.716567 -0.681718 0.147621 ) - ( -0.525731 -0.850651 0.000000 ) - ( -0.500000 -0.809017 0.309017 ) - ( -0.238856 -0.864188 0.442863 ) - ( -0.262866 -0.951056 0.162460 ) - ( -0.864188 -0.442863 0.238856 ) - ( -0.809017 -0.309017 0.500000 ) - ( -0.688191 -0.587785 0.425325 ) - ( -0.681718 -0.147621 0.716567 ) - ( -0.442863 -0.238856 0.864188 ) - ( -0.587785 -0.425325 0.688191 ) - ( -0.309017 -0.500000 0.809017 ) - ( -0.147621 -0.716567 0.681718 ) - ( -0.425325 -0.688191 0.587785 ) - ( -0.162460 -0.262866 0.951056 ) - ( 0.442863 -0.238856 0.864188 ) - ( 0.162460 -0.262866 0.951056 ) - ( 0.309017 -0.500000 0.809017 ) - ( 0.147621 -0.716567 0.681718 ) - ( 0.000000 -0.525731 0.850651 ) - ( 0.425325 -0.688191 0.587785 ) - ( 0.587785 -0.425325 0.688191 ) - ( 0.688191 -0.587785 0.425325 ) - ( -0.955423 0.295242 0.000000 ) - ( -0.951056 0.162460 0.262866 ) - ( -1.000000 0.000000 0.000000 ) - ( -0.850651 0.000000 0.525731 ) - ( -0.955423 -0.295242 0.000000 ) - ( -0.951056 -0.162460 0.262866 ) - ( -0.864188 0.442863 -0.238856 ) - ( -0.951056 0.162460 -0.262866 ) - ( -0.809017 0.309017 -0.500000 ) - ( -0.864188 -0.442863 -0.238856 ) - ( -0.951056 -0.162460 -0.262866 ) - ( -0.809017 -0.309017 -0.500000 ) - ( -0.681718 0.147621 -0.716567 ) - ( -0.681718 -0.147621 -0.716567 ) - ( -0.850651 0.000000 -0.525731 ) - ( -0.688191 0.587785 -0.425325 ) - ( -0.587785 0.425325 -0.688191 ) - ( -0.425325 0.688191 -0.587785 ) - ( -0.425325 -0.688191 -0.587785 ) - ( -0.587785 -0.425325 -0.688191 ) - ( -0.688191 -0.587785 -0.425325 )) - -(define-binary-class md2-header - ((ident :u32) - (version :u32) - (skinwidth :u32) - (skinheight :u32) - (framesize :u32) - (nskins :u32) - (nvertices :u32) - (nsts :u32) - (ntris :u32) - (nglcmds :u32) - (nframes :u32) - (skin-offset :u32) - (st-offset :u32) - (tris-offset :u32) - (frames-offset :u32) - (glcmds-offset :u32) - (end-offset :u32))) - -(define-binary-class md2-skin-name - ((name :u8 :array-size 64))) - -(define-binary-class md2-vector - ((x :float32) - (y :float32) - (z :float32))) - -(define-binary-class md2-st - ((s :s32) - (t :s32))) - -(define-binary-class md2-triangle - ( (vertex-indices :u32 :array-size 3) - (st-indices :u32 :array-size 3))) - -(define-binary-class md2-vertex - ((position :u8 :array-size 3) - (normal-index :u8))) - -(define-binary-class md2-frame-header - ((scale :md2-vector) - (translate :md2-vector) - (name :u8 :array-size 16))) - -(defun parse-md2-skin-names (offset n stream out) - (file-position stream offset) - (let ((result nil)) - (iterate - (for i from 0 below n) - (collecting (octets-to-string (read-value 'u8 stream :array-size 64)))))) - - -(defun parse-md2-sts (offset n stream out) - (file-position stream offset) - (let ((result (iterate - (for i from 0 below n) - (collecting (read-value 'md2-st stream))))) - result)) - -(defun parse-md2-triangles (offset n stream out) - (file-position stream offset) - (let ((result (iterate - (for i from 0 below n) - (collecting (read-value 'md2-triangle stream))))) - result)) - - -(defun parse-md2-frames (offset n nverts stream out) - (file-position stream offset) - (let ((frames - (iterate - (for i from 0 below n) - (collecting - (let ((header (read-value 'md2-frame-header stream)) - (vertices - (iterate - (for j from 0 below nverts) - (collecting (read-value 'md2-vertex))))) - (list header vertices)))))) - frames)) - -(defun process-vertices (scale translation vertices) - (iterate - (for vertex in vertices) - (collecting - (list - (+ (* (aref (position-of vertex) 0) (x-of scale)) (x-of translation)) - (+ (* (aref (position-of vertex) 1) (y-of scale)) (y-of translation)) - (+ (* (aref (position-of vertex) 1) (z-of scale)) (z-of translation)))))) - -(defun processs-normals (vertices) - (iterate - (for vertex in vertices) - (collecting (aref +MD2-ANORMS+ (normal-index-of vertex))))) - -(defun process-sts (sts swidth theight) - (for st in sts) - (collecting (/ (s-of st) swidth) - (/ (t-of st) theight)))) - -(defun process-faces (tris) - (iterate - (for tri in tris) - (collecting (list :vertices - (aref (vertex-indices-of tri) 0) - (aref (vertex-indices-of tri) 1) - (aref (vertex-indices-of tri) 2)) - (list :uvs - (aref (st-indices-of tri) 0) - (aref (st-indices-of tri) 1) - (aref (st-indices-of tri) 2))))) - - -(defun parse-md2-file (stream out) - (let* - ((header - (read-value 'md2-header stream))) - (format *debug-io* "~D Skins ~D Vertices ~D STS ~D Tris" (nskins-of header) (nvertices-of header) (nsts-of header) (ntris-of header)) - (let* - ((skins (parse-md2-skin-names (skin-offset-of header) (nskins-of header) stream out)) - (sts (parse-md2-sts (st-offset-of header) (nsts-of header) stream out)) - (tris (parse-md2-triangles (tris-offset-of header) (ntris-of header) stream out)) - (frames (parse-md2-frames (frames-offset-of header) (nframes-of header) stream out))) - (iterate - (for frame in frames) - (destructuring-bind (header vertices) - frame - - (format ":vertices ~A" - (process-vertices (scale-of header) (translation-of header))) - (format ":texcoords ~A" (process-sts sts - (coerce - (skinwidth-of header) 'single-float) - (coerce - (skinheight-of header) 'single-float))) - (format ":normals ~A" (process-normals vertices)) - (format ":faces ~A " (process-faces tris))))))) \ No newline at end of file + +(in-package :lodematron) + +(defparameter *MD2-ANORMS* + '#( + '( -0.525731 0.000000 0.850651 ) + '( -0.442863 0.238856 0.864188 ) + '( -0.295242 0.000000 0.955423 ) + '( -0.309017 0.500000 0.809017 ) + '( -0.162460 0.262866 0.951056 ) + '( 0.000000 0.000000 1.000000 ) + '( 0.000000 0.850651 0.525731 ) + '( -0.147621 0.716567 0.681718 ) + '( 0.147621 0.716567 0.681718 ) + '( 0.000000 0.525731 0.850651 ) + '( 0.309017 0.500000 0.809017 ) + '( 0.525731 0.000000 0.850651 ) + '( 0.295242 0.000000 0.955423 ) + '( 0.442863 0.238856 0.864188 ) + '( 0.162460 0.262866 0.951056 ) + '( -0.681718 0.147621 0.716567 ) + '( -0.809017 0.309017 0.500000 ) + '( -0.587785 0.425325 0.688191 ) + '( -0.850651 0.525731 0.000000 ) + '( -0.864188 0.442863 0.238856 ) + '( -0.716567 0.681718 0.147621 ) + '( -0.688191 0.587785 0.425325 ) + '( -0.500000 0.809017 0.309017 ) + '( -0.238856 0.864188 0.442863 ) + '( -0.425325 0.688191 0.587785 ) + '( -0.716567 0.681718 -0.147621 ) + '( -0.500000 0.809017 -0.309017 ) + '( -0.525731 0.850651 0.000000 ) + '( 0.000000 0.850651 -0.525731 ) + '( -0.238856 0.864188 -0.442863 ) + '( 0.000000 0.955423 -0.295242 ) + '( -0.262866 0.951056 -0.162460 ) + '( 0.000000 1.000000 0.000000 ) + '( 0.000000 0.955423 0.295242 ) + '( -0.262866 0.951056 0.162460 ) + '( 0.238856 0.864188 0.442863 ) + '( 0.262866 0.951056 0.162460 ) + '( 0.500000 0.809017 0.309017 ) + '( 0.238856 0.864188 -0.442863 ) + '( 0.262866 0.951056 -0.162460 ) + '( 0.500000 0.809017 -0.309017 ) + '( 0.850651 0.525731 0.000000 ) + '( 0.716567 0.681718 0.147621 ) + '( 0.716567 0.681718 -0.147621 ) + '( 0.525731 0.850651 0.000000 ) + '( 0.425325 0.688191 0.587785 ) + '( 0.864188 0.442863 0.238856 ) + '( 0.688191 0.587785 0.425325 ) + '( 0.809017 0.309017 0.500000 ) + '( 0.681718 0.147621 0.716567 ) + '( 0.587785 0.425325 0.688191 ) + '( 0.955423 0.295242 0.000000 ) + '( 1.000000 0.000000 0.000000 ) + '( 0.951056 0.162460 0.262866 ) + '( 0.850651 -0.525731 0.000000 ) + '( 0.955423 -0.295242 0.000000 ) + '( 0.864188 -0.442863 0.238856 ) + '( 0.951056 -0.162460 0.262866 ) + '( 0.809017 -0.309017 0.500000 ) + '( 0.681718 -0.147621 0.716567 ) + '( 0.850651 0.000000 0.525731 ) + '( 0.864188 0.442863 -0.238856 ) + '( 0.809017 0.309017 -0.500000 ) + '( 0.951056 0.162460 -0.262866 ) + '( 0.525731 0.000000 -0.850651 ) + '( 0.681718 0.147621 -0.716567 ) + '( 0.681718 -0.147621 -0.716567 ) + '( 0.850651 0.000000 -0.525731 ) + '( 0.809017 -0.309017 -0.500000 ) + '( 0.864188 -0.442863 -0.238856 ) + '( 0.951056 -0.162460 -0.262866 ) + '( 0.147621 0.716567 -0.681718 ) + '( 0.309017 0.500000 -0.809017 ) + '( 0.425325 0.688191 -0.587785 ) + '( 0.442863 0.238856 -0.864188 ) + '( 0.587785 0.425325 -0.688191 ) + '( 0.688191 0.587785 -0.425325 ) + '( -0.147621 0.716567 -0.681718 ) + '( -0.309017 0.500000 -0.809017 ) + '( 0.000000 0.525731 -0.850651 ) + '( -0.525731 0.000000 -0.850651 ) + '( -0.442863 0.238856 -0.864188 ) + '( -0.295242 0.000000 -0.955423 ) + '( -0.162460 0.262866 -0.951056 ) + '( 0.000000 0.000000 -1.000000 ) + '( 0.295242 0.000000 -0.955423 ) + '( 0.162460 0.262866 -0.951056 ) + '( -0.442863 -0.238856 -0.864188 ) + '( -0.309017 -0.500000 -0.809017 ) + '( -0.162460 -0.262866 -0.951056 ) + '( 0.000000 -0.850651 -0.525731 ) + '( -0.147621 -0.716567 -0.681718 ) + '( 0.147621 -0.716567 -0.681718 ) + '( 0.000000 -0.525731 -0.850651 ) + '( 0.309017 -0.500000 -0.809017 ) + '( 0.442863 -0.238856 -0.864188 ) + '( 0.162460 -0.262866 -0.951056 ) + '( 0.238856 -0.864188 -0.442863 ) + '( 0.500000 -0.809017 -0.309017 ) + '( 0.425325 -0.688191 -0.587785 ) + '( 0.716567 -0.681718 -0.147621 ) + '( 0.688191 -0.587785 -0.425325 ) + '( 0.587785 -0.425325 -0.688191 ) + '( 0.000000 -0.955423 -0.295242 ) + '( 0.000000 -1.000000 0.000000 ) + '( 0.262866 -0.951056 -0.162460 ) + '( 0.000000 -0.850651 0.525731 ) + '( 0.000000 -0.955423 0.295242 ) + '( 0.238856 -0.864188 0.442863 ) + '( 0.262866 -0.951056 0.162460 ) + '( 0.500000 -0.809017 0.309017 ) + '( 0.716567 -0.681718 0.147621 ) + '( 0.525731 -0.850651 0.000000 ) + '( -0.238856 -0.864188 -0.442863 ) + '( -0.500000 -0.809017 -0.309017 ) + '( -0.262866 -0.951056 -0.162460 ) + '( -0.850651 -0.525731 0.000000 ) + '( -0.716567 -0.681718 -0.147621 ) + '( -0.716567 -0.681718 0.147621 ) + '( -0.525731 -0.850651 0.000000 ) + '( -0.500000 -0.809017 0.309017 ) + '( -0.238856 -0.864188 0.442863 ) + '( -0.262866 -0.951056 0.162460 ) + '( -0.864188 -0.442863 0.238856 ) + '( -0.809017 -0.309017 0.500000 ) + '( -0.688191 -0.587785 0.425325 ) + '( -0.681718 -0.147621 0.716567 ) + '( -0.442863 -0.238856 0.864188 ) + '( -0.587785 -0.425325 0.688191 ) + '( -0.309017 -0.500000 0.809017 ) + '( -0.147621 -0.716567 0.681718 ) + '( -0.425325 -0.688191 0.587785 ) + '( -0.162460 -0.262866 0.951056 ) + '( 0.442863 -0.238856 0.864188 ) + '( 0.162460 -0.262866 0.951056 ) + '( 0.309017 -0.500000 0.809017 ) + '( 0.147621 -0.716567 0.681718 ) + '( 0.000000 -0.525731 0.850651 ) + '( 0.425325 -0.688191 0.587785 ) + '( 0.587785 -0.425325 0.688191 ) + '( 0.688191 -0.587785 0.425325 ) + '( -0.955423 0.295242 0.000000 ) + '( -0.951056 0.162460 0.262866 ) + '( -1.000000 0.000000 0.000000 ) + '( -0.850651 0.000000 0.525731 ) + '( -0.955423 -0.295242 0.000000 ) + '( -0.951056 -0.162460 0.262866 ) + '( -0.864188 0.442863 -0.238856 ) + '( -0.951056 0.162460 -0.262866 ) + '( -0.809017 0.309017 -0.500000 ) + '( -0.864188 -0.442863 -0.238856 ) + '( -0.951056 -0.162460 -0.262866 ) + '( -0.809017 -0.309017 -0.500000 ) + '( -0.681718 0.147621 -0.716567 ) + '( -0.681718 -0.147621 -0.716567 ) + '( -0.850651 0.000000 -0.525731 ) + '( -0.688191 0.587785 -0.425325 ) + '( -0.587785 0.425325 -0.688191 ) + '( -0.425325 0.688191 -0.587785 ) + '( -0.425325 -0.688191 -0.587785 ) + '( -0.587785 -0.425325 -0.688191 ) + '( -0.688191 -0.587785 -0.425325 ) ) + "Normal lookup table used by md2 normal quantizer" ) + +(define-binary-class md2-header + ((ident :u32) + (version :u32) + ;; don't rely on skin info in header - it's most likely balls + (skinwidth :u32) + (skinheight :u32) + (framesize :u32) + (nskins :u32) + (nvertices :u32) + (nuvs :u32) + (ntris :u32) + (nglcmds :u32) + (nframes :u32) + (skin-offset :u32) + (uv-offset :u32) + (tris-offset :u32) + (frames-offset :u32) + (glcmds-offset :u32) + (end-offset :u32))) + + +(define-binary-class md2-skin-name + ((name :u8 :array-size 64))) + +(define-binary-class md2-vector + ((x :float32) + (y :float32) + (z :float32))) + +(define-binary-class md2-uv + ((u :s32) + (v :s32))) + +(define-binary-class md2-triangle + ( (vertex-indices :u32 :array-size 3) + (uv-indices :u32 :array-size 3))) + +(define-binary-class md2-vertex + ((position :u8 :array-size 3) + (normal-index :u8))) + +(define-binary-class md2-frame-header + ((scale :md2-vector) + (translate :md2-vector) + (name :u8 :array-size 16))) + +;; we might need babel +(defun parse-md2-skin-names (offset n stream out) + (file-position stream offset) + (let ((result nil)) + (iterate + (for i from 0 below n) + (collecting (babel:octets-to-string (read-value 'u8 stream :array-size 64)))))) + + +(defun parse-md2-uvs (offset n stream out) + (file-position stream offset) + (let ((result (iterate + (for i from 0 below n) + (collecting (read-value 'md2-uv stream))))) + result)) + +(defun parse-md2-triangles (offset n stream out) + (file-position stream offset) + (let ((result (iterate + (for i from 0 below n) + (collecting (read-value 'md2-triangle stream))))) + result)) + + +(defun parse-md2-frames (offset n nverts stream out) + (file-position stream offset) + (let ((frames + (iterate + (for i from 0 below n) + (collecting + (let ((header (read-value 'md2-frame-header stream)) + (vertices + (iterate + (for j from 0 below nverts) + (collecting (read-value 'md2-vertex stream))))) + (list header vertices)))))) + frames)) + +(defun process-vertices (scale translation vertices) + (iterate + (for vertex in vertices) + (collecting + (list + (+ (* (aref (position-of vertex) 0) (x-of scale)) (x-of translation)) + (+ (* (aref (position-of vertex) 1) (y-of scale)) (y-of translation)) + (+ (* (aref (position-of vertex) 1) (z-of scale)) (z-of translation)))))) + +(defun processs-normals (vertices) + (iterate + (for vertex in vertices) + (collecting (aref *MD2-ANORMS* (normal-index-of vertex))))) + +(defun process-uvs (uvs swidth theight) + (iterate + (for uv in uvs) + (collecting (vector2d* (/ (u-of uv) swidth) (/ (v-of uv) theight))))) + +(defun process-faces (tris) + (iterate + (for tri in tris) + (collecting (list :vertices + (aref (vertex-indices-of tri) 0) + (aref (vertex-indices-of tri) 1) + (aref (vertex-indices-of tri) 2)) + (list :uvs + (aref (uv-indices-of tri) 0) + (aref (uv-indices-of tri) 1) + (aref (uv-indices-of tri) 2))))) + + +(defun parse-md2-file (stream out) + (let* + ((header + (read-value 'md2-header stream))) + (format *debug-io* "~D Skins ~D Vertices ~D UVS ~D Tris" (nskins-of header) (nvertices-of header) (nuvs-of header) (ntris-of header)) + (let* + ((skins (parse-md2-skin-names (skin-offset-of header) (nskins-of header) stream out)) + (uvs (parse-md2-uvs (uv-offset-of header) (nuvs-of header) stream out)) + (tris (parse-md2-triangles (tris-offset-of header) (ntris-of header) stream out)) + (frames (parse-md2-frames (frames-offset-of header) (nframes-of header) stream out))) + (iterate + (for frame in frames) + (destructuring-bind (header vertices) + frame + + (format ":vertices ~A" + (process-vertices (scale-of header) (translation-of header))) + (format ":texcoords ~A" (process-uvs uvs + (coerce + (skinwidth-of header) 'single-float) + (coerce + (skinheight-of header) 'single-float))) + (format ":normals ~A" (process-normals vertices)) + (format ":faces ~A " (process-faces tris))))))) + + +;; +;; test code +;; +(defparameter *md2-file* (open (merge-pathnames #P"dalekx/tris.md2") :direction :input :element-type '(unsigned-byte 8))) + +(defparameter *header* (read-value 'md2-header *md2-file*)) + +(format *debug-io* "~D Skins ~D Vertices ~D UVS ~D Tris" (nskins-of *header*) (nvertices-of *header*) (nuvs-of *header*) (ntris-of *header*)) + +(close *md2-file*) diff --git a/lodematron-rw.lisp b/lodematron-rw.lisp index 252d9a0..7d5e445 100755 --- a/lodematron-rw.lisp +++ b/lodematron-rw.lisp @@ -3,8 +3,7 @@ (in-package :lodematron) ;; define-binary-class ------------------------------------------------------ -;; Heavily influenced by (stolen, really) from Practical Common Lisp -;; thx Peter Seibel! +;; Heavily influenced by Practical Common Lisp by Peter Seibel (defun as-keyword (sym) (intern (string sym) :keyword)) @@ -42,14 +41,21 @@ (defclass ,name () ,(mapcar #'slot->defclass-slot slots)) ;; generate a method to read all slots - (defmethod read-value ((,typevar (eql ',name)) ,binary-data-var &key alignment) + (defmethod read-value ((,typevar (eql ',name)) ,binary-data-var &key (alignment 1) (array-size 0) (endian :little)) + (declare (ignore endian)) + (assert (= array-size 0)) (align-for-read ,binary-data-var alignment) (let ((,objectvar (make-instance ',name))) (with-slots ,(mapcar #'first slots) ,objectvar + ;; note - doesn't pass on endianness or allow alignment of slots yet -- to do ,@(mapcar #'(lambda (x) (slot->read-value x binary-data-var)) slots)) - ,objectvar))))) - -;; ;; generate a method to write all slots -;; (defmethod write-value ((,typevar (eql ',name)) ,binary-data-var ,objectvar &key) -;; (with-slots ,(mapcar #'first slots) ,objectvar -;; ,@(mapcar #'(lambda (x) (slot->write-value x binary-data-var)) slots)))))) + ,objectvar)) + ;; generate a method to write all slots + (defmethod write-value ((,typevar (eql ',name)) ,binary-data-var ,objectvar &key (alignment 1) (array-size 0) (endian :little)) + (declare (ignore endian)) + (assert (= array-size 0)) + (align-for-write ,binary-data-var alignment) + (with-slots ,(mapcar #'first slots) ,objectvar + ;; note - doesn't pass on endianness or allow alignment of slots yet -- to do + ,@(mapcar #'(lambda (x) (slot->write-value x binary-data-var)) slots)) + (values))))) diff --git a/lodematron.asd b/lodematron.asd index 482749c..41eb2aa 100644 --- a/lodematron.asd +++ b/lodematron.asd @@ -2,7 +2,7 @@ (in-package :asdf) (asdf:defsystem :lodematron - :depends-on ( :iterate :ieee-floats :mixamesh :alexandria :cl-tuples ) + :depends-on ( :iterate :ieee-floats :mixamesh ) :serial t :components ((:file "package") @@ -12,5 +12,7 @@ (:file "lodematron-write" ) (:file "lodematron-rw" ) (:file "file-3ds") - (:file "file-ifs") - (:file "file-lwo"))) +;; (:file "file-md2") +;; (:file "file-ifs") +;; (:file "file-lwo") +)) -- 2.11.4.GIT