file-md2.lisp

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