From 29e24f346dfe3c80b35436d1371f09f6c9c29492 Mon Sep 17 00:00:00 2001
From: John Connors <johnc@yagc.ndo.co.uk>
Date: Sat, 2 Aug 2008 16:47:36 +0100
Subject: [PATCH] Posing an md2 works

---
 file-md2.lisp        | 68 +++++++++++++++++++++++++---------------------------
 lodematron-test.lisp | 35 +++++++++++++++++++++++++++
 package.lisp         |  1 -
 3 files changed, 68 insertions(+), 36 deletions(-)

diff --git a/file-md2.lisp b/file-md2.lisp
index 1c2008d..ffce993 100644
--- a/file-md2.lisp
+++ b/file-md2.lisp
@@ -2,6 +2,7 @@
 (in-package :lodematron)
 
 (defun null-terminate (vector)
+  "Return the given sequence stripped of trailing zeros"
   (let 
       ((zeroat (position 0 vector)))
     (if zeroat
@@ -217,7 +218,7 @@
 
 (define-binary-class md2-frame-header
     ((scale :md2-vector)
-     (translate :md2-vector)
+     (translation :md2-vector)
      (name :u8 :array-size 16)))
 
 
@@ -246,28 +247,35 @@
 
 
 (defun parse-md2-frames (offset n size nverts stream)
+  "Return a hash table that maps a set of frame names to vertices"
   (file-position stream offset)
-  (let ((frames
+  (let ((frames (make-hash-table :test 'equal :size n)))
           (iterate 
             (for i from 0 below n)
             (file-position stream (+ offset (* i size)))
-            (collecting 
-             (let ((header (read-value 'md2-frame-header stream)))
-                       (let ((vertices 
-                              (iterate 
-                                (for j from 0 below nverts)
-                                (collecting (read-value 'md2-vertex stream)))))
-                         (cons header vertices)))))))
-    frames))
+            (let* ((header (read-value 'md2-frame-header stream))
+                   (vertices (make-array (list nverts)))
+                   (name (babel:octets-to-string (null-terminate  (name-of header)))))
+              (format t "Parsing header ~A~%" name)
+              (iterate 
+                (for j from 0 below nverts)
+                (setf (aref vertices  j) (read-value 'md2-vertex stream)))
+                      (setf (gethash name frames) (cons 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))))))
+  "Return an array of vertices using the given frames scale and translation"
+  (let ((result (make-vertex3d-array (length vertices)))) 
+    (iterate
+      (for index from 0 below (length vertices))
+      (for vertex in-vector vertices)
+      (setf (vertex3d-aref result index)
+            (vertex3d* 
+             (+ (* (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))
+             1.0)))
+    result))
 
 (defun processs-normals (vertices)
   (iterate
@@ -313,26 +321,16 @@
       result)))
 
 
-;; (defmethod pose ((mesh md2-mesh) frame-name skin-name)
+(defmethod pose ((model md2) (mesh simple-mesh) frame-name skin-name)
+  (let ((frame (gethash frame-name (frames-of model))))
+    (when frame
+      (let ((header (car frame))
+            (vertices (cdr frame)))
+       (setf (vertices-of mesh) (process-vertices (scale-of header) (translation-of header) vertices))))))
+ 
+;;  (let ((
 ;;   (mesh :clear-vertices)
 ;;   (let ((pose-frame (get-frame-of mesh)))
 ;;     (iterate 
 ;;       (for vertex in (cdr frame)
 
-;;
-;; 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*))
-
-;; (defparameter *uvs* (parse-md2-uvs (uv-offset-of *header*) (nuvs-of *header*) *md2-file*))
-
-;; (defparameter *tris* (parse-md2-triangles (tris-offset-of *header*) (ntris-of *header*) *md2-file*))
-
-;; (defparameter *frames* (parse-md2-frames (frames-offset-of *header*) (nframes-of *header*) (framesize-of *header*) (nvertices-of *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-test.lisp b/lodematron-test.lisp
index 16e9b0d..1030371 100644
--- a/lodematron-test.lisp
+++ b/lodematron-test.lisp
@@ -3,3 +3,38 @@
 (asdf:oos 'asdf:load-op 'lodematron)
 
 (in-package :lodematron)
+
+
+;; 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*))
+
+(defparameter *uvs* (parse-md2-uvs (uv-offset-of *header*) (nuvs-of *header*) *md2-file*))
+
+(defparameter *tris* (parse-md2-triangles (tris-offset-of *header*) (ntris-of *header*) *md2-file*))
+
+(defparameter *frames* (parse-md2-frames (frames-offset-of *header*) 
+                                         (nframes-of *header*) 
+                                         (framesize-of *header*) 
+                                         (nvertices-of *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*))
+
+(defparameter *test-mesh* (make-instance 'simple-mesh))
+
+(defparameter *test-md2* (parse-md2-file *md2-file*))
+
+
+(pose *test-md2* *test-mesh* "dalek042" "someskin")
+
+
+(close *md2-file*)
diff --git a/package.lisp b/package.lisp
index de440f1..ce6c13d 100644
--- a/package.lisp
+++ b/package.lisp
@@ -5,4 +5,3 @@
   (:use :cl :cl-tuples :mixamesh :ieee-floats :iterate))
 
 (in-package :lodematron)
-
-- 
2.11.4.GIT