altered to share tilesheet config, and to accomodate changed names

2 files changed, 70 insertions, 84 deletions

diff --git a/assets.lisp b/assets.lisp
index b57ace6..0d4848b 100644
--- a/assets.lisp
+++ b/assets.lisp
@@ -3,61 +3,35 @@
 (in-package #:the-price-of-a-cup-of-coffee)
 
 ;;; Utility Functions
-
-(defun make-source-rects (tile-defs)
-  "Accepts a TILE-DEFS list and adds an SDL2:RECT instance to each keyed to :RECT"
-  (mapcar
-   (lambda (tl)
-     (list* :rect
-            (sdl2:make-rect (getf tl :x)
-                            (getf tl :y)
-                            (getf tl :width)
-                            (getf tl :height))
-            tl))
-   tile-defs))
-
 (defun find-tile-rect (tile-defs name)
   "Return the rect for the tile with NAME in TILE-DEFS list."
   (let-when (tl (find name tile-defs
                       :key (lambda (tl) (getf tl :name))
                       :test #'string-equal))
-    (getf tl :rect)))
+    (sdl2:make-rect (getf tl :x)
+                    (getf tl :y)
+                    (getf tl :width)
+                    (getf tl :height))))
 
 (defun select-tile-rects (tile-defs &rest names)
   (map 'vector ($ #'find-tile-rect tile-defs _) names))
 
+(defstruct (sprite-faces (:conc-name ""))
+  facing-down walking-down facing-up walking-up
+  facing-left walking-left facing-right walking-right)
 
 (defun create-sprite-faces (defs)
-  (list :facing-down (select-tile-rects defs "front")
-        :walking-down (select-tile-rects defs "walkforward1" "front" "walkforward2" "front")
-        :facing-up (select-tile-rects defs "back")
-        :walking-up (select-tile-rects defs  "walkback1" "back" "walkback2" "back")
-        :facing-left (select-tile-rects defs "profileleft")
-        :walking-left (select-tile-rects defs "walkleft1" "profileleft" "walkleft2" "profileleft")
-        :facing-right (select-tile-rects defs "profileright")
-        :walking-right (select-tile-rects defs "walkright1" "profileright" "walkright1" "profileright")))
-
-;;; Nance Assets
-
-(defparameter +nance-sheet-image+ "assets/Nance.png")
-
-(defvar *nance-tile-defs*
-  '((:NAME "Back" :X 256 :Y 128 :WIDTH 64 :HEIGHT 128)
-    (:NAME "Front" :X 320 :Y 0 :WIDTH 64 :HEIGHT 128)
-    (:NAME "ProfileLeft" :X 192 :Y 128  :WIDTH 64 :HEIGHT 128)
-    (:NAME "ProfileRight" :X 256 :Y 0  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkBack1" :X 64 :Y 128  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkBack2" :X 128 :Y 128  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkForward1" :X 0 :Y 256  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkForward2" :X 192 :Y 0  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkLeft1" :X 128 :Y 0  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkLeft2" :X 0 :Y 128  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkRight1" :X 64 :Y 0  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkRight2" :X 0 :Y 0  :WIDTH 64 :HEIGHT 128)))
-
-(defparameter +suit-sheet-image+ "assets/Suit.png")
-
-(defvar *suit-tile-defs*
+  (make-sprite-faces
+   :facing-down (select-tile-rects defs "front")
+   :walking-down (select-tile-rects defs "walkforward1" "front" "walkforward2" "front")
+   :facing-up (select-tile-rects defs "back")
+   :walking-up (select-tile-rects defs  "walkback1" "back" "walkback2" "back")
+   :facing-left (select-tile-rects defs "leftprofile")
+   :walking-left (select-tile-rects defs "walkleft1" "leftprofile" "walkleft2" "leftprofile")
+   :facing-right (select-tile-rects defs "rightprofile")
+   :walking-right (select-tile-rects defs "walkright1" "rightprofile" "walkright1" "rightprofile")))
+
+(defparameter +tile-defs+
   '((:NAME "Back" :X 256 :Y 128  :WIDTH 64 :HEIGHT 128)
     (:NAME "Front" :X 320 :Y 0  :WIDTH 64 :HEIGHT 128)
     (:NAME "LeftProfile" :X 192 :Y 128  :WIDTH 64 :HEIGHT 128)
@@ -69,6 +43,18 @@
     (:NAME "WalkLeft1" :X 128 :Y 0  :WIDTH 64 :HEIGHT 128)
     (:NAME "WalkLeft2" :X 0 :Y 128  :WIDTH 64 :HEIGHT 128)
     (:NAME "WalkRight1" :X 64 :Y 0  :WIDTH 64 :HEIGHT 128)
-    (:NAME "WalkRight2" :X 0 :Y 0  :WIDTH 64 :HEIGHT 128)) 
+    (:NAME "WalkRight2" :X 0 :Y 0  :WIDTH 64 :HEIGHT 128)))
+
+(defparameter +shared-faces+
+  (create-sprite-faces +tile-defs+))
+
+(defparameter +nance-sheet-image+ "assets/Nance.png")
+(defparameter +suit-sheet-image+ "assets/Suit.png")
+
+(defvar *nance-texture*)
+(defvar *suit-texture*)
+
+
+
 
 
diff --git a/the-price-of-a-cup-of-coffee.lisp b/the-price-of-a-cup-of-coffee.lisp
index e30cc15..fbb5d29 100644
--- a/the-price-of-a-cup-of-coffee.lisp
+++ b/the-price-of-a-cup-of-coffee.lisp
@@ -2,20 +2,22 @@
 
 (in-package #:the-price-of-a-cup-of-coffee)
 
-
-
 (def-normal-class human ()
   (walk-vec (cons 0 0))
   pos
   sheet
-  faces
-  (face :facing-down)
+  (faces ((lambda () +shared-faces+)))
+  (face 'facing-down)
   (frame 0)
   (next-frame-at 0))
 
+(defun get-frame-rect (human)
+  (with-slots (faces face frame) human
+      (aref (funcall face faces) frame)))
+
 (defmethod initialize-instance :after ((human human) &key)
   (with-slots (faces pos) human
-    (let ((rect (aref (getf faces :facing-down) 0)))
+    (let ((rect (get-frame-rect human)))
       (setf pos
             (sdl2:make-rect 0 0
                             (sdl2:rect-width rect)
@@ -34,23 +36,22 @@
   (setf *human-frame-pause* (/ 1000 n)))
 
 
-
 (defmethod update ((human human) ticks)
   (with-slots (frame next-frame-at faces face walk-vec pos) human
-    (setf (sdl2:rect-x pos) (mod (+ (sdl2:rect-x pos) (car walk-vec)) 1024))
+    (setf (sdl2:rect-x pos) (mod (+ (sdl2:rect-x pos) (car walk-vec)) +window-width+))
     (setf (sdl2:rect-y pos)
           (clamp (+ (sdl2:rect-y pos) (cdr walk-vec))
                  +vert-min+ +vert-max+))
     (when (<= next-frame-at ticks)
       (setf next-frame-at (max (+ *human-frame-pause* next-frame-at) ticks))
-      (setf frame (mod (1+ frame) (length (getf faces face)))))))
+      (setf frame (mod (1+ frame) (length (funcall face faces)))))))
 
 
 (defmethod render ((human human) renderer)
   (with-slots (pos sheet faces face frame) human
     (sdl2:render-copy renderer sheet
                       :dest-rect pos
-                      :source-rect (aref (getf faces face) frame))))
+                      :source-rect (get-frame-rect human))))
 
 
 (def-normal-class hero (human)
@@ -71,16 +72,14 @@
 
 
 
-(defvar *nance* nil)
+(defvar *nance*)
 
-(defun boot-up (renderer)
-  (setf *nance-tile-defs* (make-source-rects *nance-tile-defs*))
 
+(defun boot-up (renderer)
   (with-surface-from-file (surf +nance-sheet-image+)
     (setf *nance*
           (make-instance 'hero
-                         :sheet (sdl2:create-texture-from-surface renderer surf)
-                         :faces (create-sprite-faces *nance-tile-defs*)))))
+                         :sheet (sdl2:create-texture-from-surface renderer surf)))))
 
 
 (defparameter +frame-delay+ (round (/ 1000 60)))
@@ -88,42 +87,43 @@
 (defparameter +action-key+ :scancode-space)
 
 (defun action-key-pressed ()
-  (if (eql *current-track* *looking-up-track*)
-      (play-track *cold-day-track*)
-      (play-track *looking-up-track*))
+  ;; (if (eql *current-track* *looking-up-track*)
+  ;;     (play-track *cold-day-track*)
+  ;;     (play-track *looking-up-track*))
   (print "Action"))
 
 (defun walking-face (dir)
   (case dir
-    (:left :walking-left)
-    (:right :walking-right)
-    (:up :walking-up)
-    (:down :walking-down)))
+    (:left 'walking-left)
+    (:right 'walking-right)
+    (:up 'walking-up)
+    (:down 'walking-down)))
 
 (defun standing-face (dir)
   (case dir
-    (:left :facing-left)
-    (:right :facing-right)
-    (:up :facing-up)
-    (:down :facing-down)))
+    (:left 'facing-left)
+    (:right 'facing-right)
+    (:up 'facing-up)
+    (:down 'facing-down)))
 
 (defun walk-hero (dir)
-  (unless (equal (walking-face dir) (face *nance*))
-    (setf (face *nance*) (walking-face dir))
-    (setf (frame *nance*) 0)
-    (setf (walk-vec *nance*)
-          (case dir
-            (:right (cons 6 0))
-            (:left (cons -6 0))
-            (:up (cons 0 -6))
-            (:down (cons 0 6))))))
+  (with-slots (face frame walk-vec) *nance*
+    (unless (eql (walking-face dir) face)
+      (setf face (walking-face dir))
+      (setf frame 0)
+      (case dir
+        (:right (setf (car walk-vec) 6))
+        (:left (setf (car walk-vec) -6))
+        (:up (setf (cdr walk-vec) -6))
+        (:down (setf (cdr walk-vec) 6))))))
 
-(defun stop-hero (dir)
-  (setf (face *nance*)
-        (standing-face dir))
-  (setf (frame *nance*) 0)
-  (setf (walk-vec *nance*) (cons 0 0)))
 
+(defun stop-hero (dir)
+  (with-slots (face frame walk-vec) *nance*
+    (setf face (standing-face dir))
+    (setf frame 0)
+    (setf (car walk-vec) 0)
+    (setf (cdr walk-vec) 0)))
 
 (defun handle-keydown (keysym)
   (let ((key (sdl2:scancode-value keysym)))