(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)
(defparameter *tower-pos* (vec 80 150))
(defparameter *tower-center* (vec 64 220))
(defparameter *assets-path* "~/Development/tinyswords/assets/")
(defparameter *camera* (rl:make-camera2d :offset (vec 0 0) :target (vec 0 0) :rotation 0.0 :zoom 1.0))

(defparameter *mouse-drag-start-pos* (vec 0 0))
(defparameter *camera-drag-start-pos* (vec 0 0))
(defparameter *unit-select-drag-start-pos* (vec 0 0))
(defparameter *camera-dragging?* nil)
(defparameter *unit-select-dragging?* nil)
(defparameter *selection-rect* (rl:make-rectangle :x 0.0 :y 0.0 :width 0.0 :height 0.0))

(defparameter *selected-units* (make-array 64 :adjustable t :fill-pointer 0))

(defparameter *game-state* nil)
(defparameter *textures* (make-hash-table))

(defmacro rsetf (rect &key x y width height)
  "Set rectangle fields using keywords"
  `(progn
     ,@(when x `((setf (raylib:rectangle-x ,rect) ,x)))
     ,@(when y `((setf (raylib:rectangle-y ,rect) ,y)))
     ,@(when width `((setf (raylib:rectangle-width ,rect) ,width)))
     ,@(when height `((setf (raylib:rectangle-height ,rect) ,height)))))

(defun set-selection-rect ()
  (let* ((start-x (vx *mouse-drag-start-pos*))
         (start-y (vy *mouse-drag-start-pos*))
         (end-x (rl:get-mouse-x))
         (end-y (rl:get-mouse-y))
         (x (min start-x end-x))
         (y (min start-y end-y)))
    (rsetf *selection-rect* :x x :y y :width (abs (- end-x start-x)) :height (abs (- end-y start-y)))))

(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)
   (entity-type :initarg :entity-type :initform nil :accessor entity-type)
   (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
   :entity-type ':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
   :entity-type :archer
   :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 *goblin*
  (make-instance
   'soldier
   :entity-type :goblin
   :pos (vec 445.0 300.0)
   :sprite (make-instance
            'sprite-class
            :texture-key 'goblin
            :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)))

(defun bind-texture (key path)
  (setf (gethash key *textures*) (rl:load-texture (uiop:native-namestring (merge-pathnames path *assets-path*)))))

(defun game-init ()
  (setf *game-state* (make-instance 'game-state))
  (setf (entities *game-state*) (list *knight* *archer* *goblin*))
  ;; (add-component (knight *game-state*) (make-instance 'transform))
  (bind-texture 'terrain "Terrain/Ground/Tilemap_Flat.png")
  (bind-texture 'knight  "Factions/Knights/Troops/Warrior/Blue/Warrior_Blue.png")
  (bind-texture 'archer  "Factions/Knights/Troops/Archer/Blue/Archer_Blue.png")
  (bind-texture 'tower   "Factions/Knights/Buildings/Tower/Tower_Blue.png")
  (bind-texture 'goblin  "Factions/Goblins/Troops/Torch/Red/Torch_Red.png"))

(defun game-input ()
  (when (rl:is-mouse-button-pressed 0)
    (if (rl:is-key-down :key-left-control)
        (progn
          (setf *camera-dragging?* t)
          (v<- *camera-drag-start-pos* (rl:camera2d-target *camera*)))
        (progn
          (setf *unit-select-dragging?* t)
          (v<- *unit-select-drag-start-pos* (rl:camera2d-target *camera*))))
    (v<- *mouse-drag-start-pos* (rl:get-mouse-position)))
  ;; (princ (rl:get-mouse-wheel-move))
  (setf (rl:camera2d-zoom *camera*)
          (alexandria:clamp (exp (+ (log (rl:camera2d-zoom *camera*))
                                    (* (rl:get-mouse-wheel-move) 0.1)))
                            1.0 2.0))
  (when (rl:is-mouse-button-released 0)
    (setf *camera-dragging?* nil)
    (setf *unit-select-dragging?* nil))
  (when (rl:is-key-down :key-r) (setf (rl:camera2d-target *camera*) (vec 0 0))))

;; (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 goblin-fsm ()
  (dolist (entity (entities *game-state*))
    (when (eq (entity-type entity) :goblin)
      (let* ((target-dist (v- (v+ *tower-pos* *tower-center*) (pos entity)))
             (dir (vunit* target-dist)))
        (setf (anim-idx (sprite entity)) 1)
        (setf (pos entity) (v+ (pos entity) (v* dir 1)))))))

(defun calculate-camera-drag ()
  (let* ((target-pos (v- (rl:get-mouse-position)
                         *mouse-drag-start-pos*)))
    (setf (rl:camera2d-target *camera*) (v+ *camera-drag-start-pos* (v* -1 target-pos)))))

(defun game-update ()
  (when *camera-dragging?*
    (calculate-camera-drag))
  (when *unit-select-dragging?*
    (setf (fill-pointer *selected-units*) 0)
    (set-selection-rect)
    (vector-push-extend *knight* *selected-units* ))
  (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) 240.0) (vunit* dist))))
                (setf (anim-idx (sprite *knight*)) 1)
                (setf (velocity *knight*) vel)
                (setf kpos (v+ kpos vel))))))))
  (goblin-fsm)
  (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))
  (rl:with-mode-2d (*camera*)
    (draw-ground)
    (rl:draw-texture-v (gethash 'tower *textures*) *tower-pos* :white)
    (dolist (entity (entities *game-state*))
      (draw-sprite (sprite entity) (pos entity))))
  (when *unit-select-dragging?*
    (rl:draw-rectangle-lines-ex *selection-rect* 2.0 :raywhite))
  (rl:draw-fps 10 10))

(defun game ()
  (let* ((screen-width 1600)
         (screen-height 900))
    (rl:with-window (screen-width screen-height "RTS")
      (rl:set-target-fps 60)
      (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)
