(eval-when (:compile-toplevel :load-toplevel :execute) (load "~/.local/share/quicklisp/setup.lisp") (ql:quickload :cl-raylib) (ql:quickload :livesupport)) (defpackage :raylib-user (:use :cl :3d-vectors) (:local-nicknames (:rl :raylib))) (in-package :raylib-user) (defparameter *move-speed* 5.0) (defclass health () ((current-amount :initform 100.0 :accessor current-amount) (max-amount :initform 100.0 :accessor max-amount))) (defclass animation () ((current-amount :initform 100.0 :accessor current-amount) (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 () ((pos :initarg :pos :initform (vec 0 0) :accessor pos) (anim-state :initform 0 :accessor anim-state) (sprite :initarg :sprite :initform (make-instance 'sprite-class) :accessor sprite) (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 *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 (setf h (- h damage)))) ;; (mapcar (lambda (go) (deal-damage go 10)) (list knight1 archer1 goblin1)) (defclass game-state () ((click-pos :initform nil :accessor click-pos) (entities :initform '() :accessor entities))) (defparameter *game-state* nil) (defparameter *textures* (make-hash-table)) (defun bind-texture (key path) (setf (gethash key *textures*) (rl:load-texture (uiop:native-namestring path)))) (defun game-init () (setf *game-state* (make-instance 'game-state)) (setf (entities *game-state*) (list *knight* *archer*)) ;; (add-component (knight *game-state*) (make-instance 'transform)) (bind-texture 'terrain "~/Development/tinyswords/assets/Terrain/Ground/Tilemap_Flat.png") (bind-texture 'knight "~/Development/tinyswords/assets/Factions/Knights/Troops/Warrior/Blue/Warrior_Blue.png") (bind-texture 'archer "~/Development/tinyswords/assets/Factions/Knights/Troops/Archer/Blue/Archer_Blue.png") (bind-texture 'tower "~/Development/tinyswords/assets/Factions/Knights/Buildings/Tower/Tower_Blue.png")) (defun game-input () (when (rl:is-mouse-button-pressed 0) (setf (click-pos *game-state*) (print (rl:get-mouse-position)))) (when (rl:is-mouse-button-pressed 1) (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 (with-accessors ((kpos pos)) *knight* (let* ((dist (v- click-pos kpos)) (mag (vsqrlength dist))) (if (<= mag 10.0) (progn (setf (anim-idx (sprite *knight*)) 0) (setf kpos click-pos) ;; (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) (< (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) (let* ((tile-count 6)) (rl:draw-texture-rec tilemap (rl:make-rectangle :x (* size (get-tile-wrapped col tile-count)) :y (* size (get-tile-wrapped row tile-count)) :width size :height size) (v+ (vec -15 150) (vec (* col size) (* row size))) :white))) (defun draw-ground () (let ((size 32) (terrain-tex (gethash 'terrain *textures*))) (loop for row from 0 to 16 do (loop for col from 0 to 32 do (draw-tile terrain-tex size col row))))) (defun animate-sprite (tex-key row pos vel) (let ((time-interval (coerce (mod (truncate (/ (rl:get-time) 0.1)) 6) 'single-float)) (side (if (< (vx vel) 0) -1 1))) (rl:draw-texture-pro (gethash tex-key *textures*) (rl:make-rectangle :x (* time-interval 192.0) :y (* row 192) :width (* side 192.0) :height 192.0) (rl:make-rectangle :x (vx pos) :y (vy pos) :width 192.0 :height 192.0) (vec 95.0 128.0) 0.0 :white))) (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 (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)) (draw-ground) (rl:draw-texture-v (gethash 'tower *textures*) (vec 80 150) :white) (dolist (entity (entities *game-state*)) (draw-sprite (sprite entity) (pos entity))) (rl:draw-fps 10 10)) (defun game () (let* ((screen-width 900) (screen-height 500)) (rl:with-window (screen-width screen-height "RTS") (rl:set-target-fps 240) (game-init) (loop :until (rl:window-should-close) :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))))) (game)