From a364073f98d8f3a40d68a84a14d811ef12ac1974 Mon Sep 17 00:00:00 2001
From: John Connors <johnc@yagc.ndo.co.uk>
Date: Sun, 24 Aug 2008 20:16:41 +0100
Subject: [PATCH] More md2 improvements

---
 file-md2.lisp        | 40 +++++++++++++++++++++++++++-------------
 lodematron-test.lisp | 13 +++++++++----
 2 files changed, 36 insertions(+), 17 deletions(-)

diff --git a/file-md2.lisp b/file-md2.lisp
index 43b9066..2f4ccb4 100644
--- a/file-md2.lisp
+++ b/file-md2.lisp
@@ -316,21 +316,26 @@
   ((sts :accessor sts-of :initarg :sts)
    (frames :accessor frames-of :initarg :frames)
    (tris :accessor tris-of :initarg :tris)
-   (skins :accessor skins-of :initform (make-hash-table :test 'equal))))
+   (filename :reader filename-of :initarg :fname)
+   (skins :accessor skins-of :initarg :skins)))
 
   
-(defun parse-md2-file (stream)
+(defun parse-md2-file (filename)
   "Read in an md2 file from the stream"
-  (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*
-        ((result (make-instance 'md2 
-                  :frames (parse-md2-frames (frames-offset-of header) (nframes-of header) (framesize-of header) (nvertices-of header) stream)
-                  :sts (parse-md2-uvs (uv-offset-of header) (nuvs-of header) stream)
-                  :tris (parse-md2-triangles (tris-offset-of header) (ntris-of header) stream))))
-      result)))
+  (with-open-file (stream (merge-pathnames filename)   :direction :input :element-type '(unsigned-byte 8)) 
+    (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))
+      (with-accessors ((frames-offset frames-offset-of) (nframes nframes-of) (framesize framesize-of) (nvertices nvertices-of)) header
+        (let*
+            ((result (make-instance 'md2 
+                                    :fname (merge-pathnames filename)
+                                    :frames (parse-md2-frames frames-offset nframes framesize nvertices stream)
+                                    :sts (parse-md2-uvs (uv-offset-of header) (nuvs-of header) stream)
+                                    :tris (parse-md2-triangles (tris-offset-of header) (ntris-of header) stream)
+                                    :skins (parse-md2-skins (merge-pathnames (directory-namestring  (merge-pathnames #P"dalekx/tris.md2")))))))
+          result)))))
 
 ;; skins --
 (defun is-pcx (x)
@@ -343,9 +348,18 @@
         (directory-list (cl-fad:list-directory (merge-pathnames directory-name))))
     (mapcar #'(lambda (x) 
                 (let ((name (namestring x)))
-                  (subseq (namestring name) directory-name-length (- (length name) 4))))
+                  (cons 
+                   x
+                   (subseq (namestring name) directory-name-length (- (length name) 4)))))
             (remove-if-not #'is-pcx directory-list))))
     
+(defun parse-md2-skins (directory)
+  (let ((result (make-hash-table :test 'equal)))
+    (mapcar #'(lambda (x)
+                (setf (gethash (cdr x) result) (parse-pcx-file (car x)))) 
+            (directory-scan directory))
+    result))
+
 ;; animation --
 (defmethod pose ((model md2) (mesh simple-mesh) frame-name skin-name)
   "Set the pose of  mesh based on an md2 frame"
diff --git a/lodematron-test.lisp b/lodematron-test.lisp
index a68c8dc..7f9aa60 100644
--- a/lodematron-test.lisp
+++ b/lodematron-test.lisp
@@ -40,10 +40,15 @@
 
 (close *md2-file*)
 
-(defparameter *pcx-file* (open (merge-pathnames #P"dalekx/brit.PCX")
-                               :direction :input 
-                               :element-type '(unsigned-byte 8)))
+(defparameter *pcx-file* )
+
+(defparameter *pcx-header* (read-value :pcx-header *pcx-file*))
+
+(defparameter *pcx-data* (decode-8bit *pcx-file* (bytes-per-line-of *pcx-header*) (- (ymax-of *pcx-header*) (ymin-of *pcx-header*))))
+
+(defparameter *pcx-palette* (extract-palette *pcx-file*))
 
 (parse-pcx-file *pcx-file*)
 
-(close *pcx-file*)
\ No newline at end of file
+(close *pcx-file*)
+
-- 
2.11.4.GIT