JosephFerano/tinyswords
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add livesupport, get x flipping and run anim working

Browse Source
This commit is contained in:
Joseph Ferano 2024-11-19 22:52:19 +07:00
parent 1c4b0d6bc7
commit ce9c7871aa
1 changed files with 50 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
game.lisp
View File

@ -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)))))