diff options
| -rw-r--r-- | assets.lisp | 76 | ||||
| -rw-r--r-- | the-price-of-a-cup-of-coffee.lisp | 78 |
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))) |