diff options
| -rw-r--r-- | the-price-of-a-cup-of-coffee.lisp | 83 |
1 files changed, 73 insertions, 10 deletions
diff --git a/the-price-of-a-cup-of-coffee.lisp b/the-price-of-a-cup-of-coffee.lisp index 2a12ffe..56c3152 100644 --- a/the-price-of-a-cup-of-coffee.lisp +++ b/the-price-of-a-cup-of-coffee.lisp @@ -2,6 +2,71 @@ (in-package #:the-price-of-a-cup-of-coffee) + +(defparameter +window-width+ 1024) +(defparameter +window-height+ 600) +(defparameter +meter-bar-height+ 32) + + +(defgeneric render (sprite renderer)) +(defgeneric update (thing time)) + +(def-normal-class status-meter () + (color (list 0 0 0 255)) + shape + filled-shape + max-width + percent) + +(defmethod render ((meter status-meter) renderer) + (with-slots (color shape filled-shape) meter + (destructuring-bind (r g b a) color + (sdl2:set-render-draw-color renderer r g b 100) + (sdl2:render-fill-rect renderer shape) + (sdl2:set-render-draw-color renderer r g b a) + (sdl2:render-fill-rect renderer filled-shape) + (sdl2:set-render-draw-color renderer 255 255 255 255) + (sdl2:render-draw-rect renderer shape)))) + + +(defmethod (setf percent) :after (new-val (meter status-meter)) + (with-slots (filled-shape max-width percent) meter + (setf percent (clamp new-val 0.0 1.0)) + (setf (sdl2:rect-width filled-shape) (round (* max-width percent))))) + +(let* ((padding 8) + (measure (round (/ +window-width+ 5))) + (width (- measure (* 2 padding))) + (double-width (- (* measure) (* 2 padding)))) + + (defvar *money-meter* + (make-instance 'status-meter + :color (list 0 200 50 200) + :filled-shape (sdl2:make-rect padding padding 1 +meter-bar-height+) + :shape (sdl2:make-rect padding padding double-width +meter-bar-height+) + :percent 0.0 + :max-width double-width)) + + (defvar *stress-meter* + (make-instance 'status-meter + :color (list 200 20 20 200) + :filled-shape (sdl2:make-rect (+ padding (* 3 measure)) padding + 1 +meter-bar-height+) + + :shape (sdl2:make-rect (+ padding (* 3 measure)) padding + width +meter-bar-height+) + :percent 0.0 + :max-width width)) + + (defvar *cold-meter* + (make-instance 'status-meter + :color (list 0 20 200 200) + :filled-shape (sdl2:make-rect (+ padding (* 4 measure)) padding 1 +meter-bar-height+) + :shape (sdl2:make-rect (+ padding (* 4 measure)) padding width +meter-bar-height+) + :percent 0.0 + :max-width width))) + + (def-normal-class human () (walk-vec (cons 0 0)) (walk-speed 6) @@ -38,11 +103,6 @@ (sdl2:rect-width rect) (sdl2:rect-height rect)))))) -(defgeneric render (sprite renderer)) -(defgeneric update (thing time)) - -(defparameter +window-width+ 1024) -(defparameter +window-height+ 600) (defparameter +vert-min+ 16) (defparameter +vert-max+ (- +window-height+ 128 10)) @@ -102,7 +162,7 @@ (with-surface-from-file (surf +suit-sheet-image+) (setf *suit-texture* (sdl2:create-texture-from-surface renderer surf))) - (setf *nance* (make-instance 'hero :sheet *suit-texture*))) + (setf *nance* (make-instance 'hero :sheet *nance-texture*))) (defparameter +frame-delay+ (round (/ 1000 60))) @@ -111,9 +171,6 @@ (defun action-key-pressed () (print "Action")) - - - (defun any-p (arg &rest preds) (and preds (or (funcall (car preds) arg) @@ -268,9 +325,15 @@ (defmethod render ((game (eql :game)) renderer) - (sdl2:set-render-draw-color renderer 255 255 255 255) + (sdl2:set-render-draw-color renderer 80 80 80 255) (sdl2:render-clear renderer) (render *nance* renderer) + + (sdl2:set-render-draw-blend-mode renderer sdl2-ffi:+sdl-blendmode-blend+) + (render *money-meter* renderer) + (render *stress-meter* renderer) + (render *cold-meter* renderer) + (sdl2:render-present renderer)) (defvar *harmony-initialized-p* nil) |