file-md2.lisp

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