diff --git a/game.lisp b/game.lisp index 4903ba4..3371d02 100644 --- a/game.lisp +++ b/game.lisp @@ -1,6 +1,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (load "~/.local/share/quicklisp/setup.lisp") - (ql:quickload :cl-raylib)) + (ql:quickload :cl-raylib) + (ql:quickload :livesupport)) (defpackage :raylib-user (:use :cl :3d-vectors) @@ -19,8 +20,10 @@ (max-amount :initform 100.0 :accessor max-amount))) (defclass sprite-class () + ;; I don't like this at all, we shoudn't be using a rectangle we modify ((src-rect :initarg :src-rect :initform (rl:make-rectangle :x 0 :y 0 :width 0 :height 0) :accessor src-rect) (texture-key :initarg :texture-key :accessor texture-key) + (anim-idx :initform 0 :accessor anim-idx) (origin :initarg :origin :initform (vec 0 0) :accessor origin))) (defclass soldier () @@ -30,19 +33,25 @@ (velocity :initform (vec 0 0) :accessor velocity) (health :initarg :health :initform (make-instance 'health) :accessor health))) -(defparameter *knight* (make-instance 'soldier - :pos (vec 270 360) - :sprite (make-instance 'sprite-class - :texture-key 'knight - :src-rect (rl:make-rectangle :x 0.0 :y 0.0 :width 192.0 :height 192.0) - :origin (vec 95.0 128.0)))) +(defparameter *knight* + (make-instance + 'soldier + :pos (vec 270 360) + :sprite (make-instance + 'sprite-class + :texture-key 'knight + :src-rect (rl:make-rectangle :x 0.0 :y 0.0 :width 192.0 :height 192.0) + :origin (vec 95.0 128.0)))) -(defparameter *archer* (make-instance 'soldier - :pos (vec 145.0 253.0) - :sprite (make-instance 'sprite-class - :texture-key 'archer - :src-rect (rl:make-rectangle :x 0.0 :y 0.0 :width 192.0 :height 192.0) - :origin (vec 95.0 128.0)))) +(defparameter *archer* + (make-instance + 'soldier + :pos (vec 145.0 253.0) + :sprite (make-instance + 'sprite-class + :texture-key 'archer + :src-rect (rl:make-rectangle :x 0.0 :y 0.0 :width 192.0 :height 192.0) + :origin (vec 95.0 128.0)))) (defun deal-damage (obj damage) (with-accessors ((h health)) obj @@ -71,35 +80,35 @@ (defun game-input () (when (rl:is-mouse-button-pressed 0) - (print (rl:get-mouse-position)) - (setf (click-pos *game-state*) (rl:get-mouse-position)))) - ;; (with-slots ((pos archer-pos) (kpos knight-pos)) *game-state* - ;; (let ((dx 0.0) (dy 0.0)) - ;; (when (rl:is-key-down :key-right) (incf dx 1)) - ;; (when (rl:is-key-down :key-left) (decf dx 1)) - ;; (when (rl:is-key-down :key-up) (decf dy 1)) - ;; (when (rl:is-key-down :key-down) (incf dy 1)) - ;; (setf pos (v+ pos (v* (vunit* (vec dx dy)) *move-speed*)))))) + (setf (click-pos *game-state*) (print (rl:get-mouse-position))))) +;; (with-slots ((pos archer-pos) (kpos knight-pos)) *game-state* +;; (let ((dx 0.0) (dy 0.0)) +;; (when (rl:is-key-down :key-right) (incf dx 1)) +;; (when (rl:is-key-down :key-left) (decf dx 1)) +;; (when (rl:is-key-down :key-up) (decf dy 1)) +;; (when (rl:is-key-down :key-down) (incf dy 1)) +;; (setf pos (v+ pos (v* (vunit* (vec dx dy)) *move-speed*)))))) (defun game-update () (with-accessors ((click-pos click-pos)) *game-state* (when click-pos - (setf (anim-state *knight*) 1) (with-accessors ((kpos pos)) *knight* (let* ((dist (v- click-pos kpos)) (mag (vsqrlength dist))) (if (<= mag 10.0) (progn - ;; (setf (anim-state *knight*) 0) + (setf (anim-idx (sprite *knight*)) 0) (setf kpos click-pos) - (setf (velocity *knight*) (vec 0 0)) + ;; (setf (velocity *knight*) (vec 0 0)) (setf click-pos nil)) (let ((vel (v* (* (rl:get-frame-time) 150.0) (vunit* dist)))) + (setf (anim-idx (sprite *knight*)) 1) (setf (velocity *knight*) vel) (setf kpos (v+ kpos vel)))))))) (dolist (entity (entities *game-state*)) - (tick-sprite-animation (sprite entity)))) + (tick-sprite-animation (sprite entity) (< (vx (velocity entity)) 0.0)))) +;; (livesupport:peek (sprite *knight*)) (defun get-tile-wrapped (n wrap-count) (if (> n 0) (1+ (mod (1- n) (- wrap-count 2))) 0)) (defun draw-tile (tilemap size col row) @@ -131,23 +140,20 @@ 0.0 :white))) -(defun update-sprite-anim (sprite &key (row 0 row-p) (col 0 col-p)) - (with-slots (src-rect) sprite - (when row-p - (setf (rl:rectangle-y src-rect) (* row (rl:rectangle-height src-rect)))) - (when col-p - (setf (rl:rectangle-x src-rect) (* col (rl:rectangle-width src-rect)))))) - -(defun tick-sprite-animation (sprite) - (with-slots (src-rect) sprite - (update-sprite-anim sprite :col (coerce (mod (truncate (/ (rl:get-time) 0.1)) 6) 'single-float)))) +(defun tick-sprite-animation (sprite flip) + (with-slots (src-rect anim-idx) sprite + (with-accessors ((y rl:rectangle-y) (x rl:rectangle-x) (width rl:rectangle-width) (height rl:rectangle-height)) src-rect + (let ((col (coerce (mod (truncate (/ (rl:get-time) 0.1)) 6) 'single-float))) + (setf x (* col (abs width))) + (setf y (* anim-idx (abs height))) + (setf width (* (if flip -1 1) (abs width))))))) (defun draw-sprite (sprite pos) (with-slots (texture-key src-rect origin) sprite - (let ((dst-rec (rl:make-rectangle :x (vx pos) :y (vy pos) - :width (rl:rectangle-width src-rect) - :height (rl:rectangle-height src-rect)))) - (rl:draw-texture-pro (gethash texture-key *textures*) src-rect dst-rec origin 0.0 :white)))) + (let ((dst-rec (rl:make-rectangle :x (vx pos) :y (vy pos) + :width (abs (rl:rectangle-width src-rect)) + :height (abs (rl:rectangle-height src-rect))))) + (rl:draw-texture-pro (gethash texture-key *textures*) src-rect dst-rec origin 0.0 :white)))) (defun game-draw () (rl:clear-background (rl:make-rgba 71 171 169 1)) @@ -164,10 +170,10 @@ (rl:set-target-fps 120) (game-init) (loop :until (rl:window-should-close) - :do (game-input) - (game-update) - (rl:with-drawing - (game-draw))) + :do (livesupport:continuable (game-input) + (game-update) + (rl:with-drawing + (game-draw)))) (loop for value being the hash-values of *textures* do (rl:unload-texture value)))))