file-md2.lisp

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