tinyswords/game.lisp

72 lines
2.2 KiB
Common Lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :cl-raylib))
(defpackage :raylib-user
(:use :cl :3d-vectors)
(:local-nicknames (:rl :raylib)))
(in-package :raylib-user)
(defparameter *move-speed* 2.0)
(defstruct game-state
(textures (make-hash-table))
(player-pos (vec 100 100)))
(defparameter *game-state* nil)
(defun bind-texture (state key path)
(setf (gethash key (game-state-textures state)) (rl:load-texture (uiop:native-namestring path))))
(defun game-init ()
(let ((state (make-game-state)))
(bind-texture state 'terrain "~/Development/tinyswords/assets/Terrain/Ground/Tilemap_Flat.png")
state))
(defun game-input (state)
(with-slots ((pos player-pos)) 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 (state) '())
(defun draw-tile (tilemap size col row)
(rl:draw-texture-rec
tilemap
(rl:make-rectangle :x (* size (mod col 5)) :y (* size (mod row 5)) :width size :height size)
(vec (* col size) (* row size))
:white))
(defun draw-ground ()
(let ((size 32)
(terrain-tex (gethash 'terrain (game-state-textures *game-state*))))
(loop for row from 0 to 16
do (loop for col from 0 to 32
do (draw-tile terrain-tex size col row)))))
(defun game-draw (state)
(rl:clear-background (rl:make-rgba 71 171 169 1))
(draw-ground)
;; (rl:draw-texture-v (gethash 'terrain (game-state-textures state)) (vec 50 50) :white)
(rl:draw-fps 10 5))
(defun main ()
(let* ((screen-width 900)
(screen-height 500))
(rl:with-window (screen-width screen-height "RTS")
(rl:set-target-fps 60)
(setf *game-state* (game-init))
(loop :until (rl:window-should-close)
:do (game-input *game-state*)
(game-update *game-state*)
(rl:with-drawing
(game-draw *game-state*)))
(loop for value being the hash-values of (game-state-textures *game-state*)
do (rl:unload-texture value)))))
(main)