(defpackage :fwoar.bodge-like
   (:use :cl )
   (:export ))
 (in-package :fwoar.bodge-like)
 
 (defclass feature ()
   ((%sym :reader sym :initarg sym)))
 
 (defclass monster (feature)
   ((%position :accessor pos :initform (gamekit:vec2 (random 12)
                                                     (random 12)))))
 
 (defclass dog (monster)
   ()
   (:default-initargs sym "d"))
 
 (defun monster (sym)
   (make-instance 'monster 'sym sym))
 
 (defclass player (feature)
   ((%position :accessor pos :initform (gamekit:vec2 0 0)))
   (:default-initargs sym "@"))
 
 (defparameter *white* (gamekit:vec4 1 1 1 1))
 (defparameter *black* (gamekit:vec4 0 0 0 0.8))
 (defparameter *tile-size* 32)
 
 (gamekit:defgame bodgelike ()
   ((%player :reader player :initform (make-instance 'player))
    (%monsters :accessor monsters :initform ()))
   (:viewport-title "@")
   (:viewport-height (* 12 *tile-size*))
   (:viewport-width (* 12 *tile-size*)))
 
 (defun draw-tile (row col &optional (size *tile-size*))
   (gamekit:draw-rect (gamekit:vec2 (* row size)
                                    (* col size))
                      size size
                      :fill-paint *black*))
 
 (defvar *my-font*)
 (defun draw-feature (feature &optional pos (tile-size *tile-size*))
   (let* ((pos (if pos
                   pos
                   (pos feature)))
          (row (gamekit:x pos))
          (col (gamekit:y pos))
          (tile-origin (gamekit:vec2 (* row tile-size)
                                     (* col tile-size)))
          (feature-text (etypecase feature
                          (string feature)
                          (feature (sym feature)))))
     (multiple-value-bind (text-origin text-width text-height)
         (gamekit:calc-text-bounds feature-text *my-font*)
       (let ((text-origin
               (gamekit:add tile-origin
                            (gamekit:mult -1 text-origin)
                            (gamekit:mult 0.5
                                          (gamekit:subt (gamekit:vec2 tile-size tile-size)
                                                        (gamekit:vec2 text-width text-height))))))
         (gamekit:draw-text feature-text text-origin
                            :fill-color *white*
                            :font *my-font*)))))
 
 
 (gamekit:define-font :fantasy "/tmp/foo/font.ttf")
 
 
 (defgeneric interact2 (game obj1 obj2)
   (:method (game obj1 obj2) nil)
   (:method (game obj1 obj2) t)
   (:method (game (obj1 player) (obj2 dog))
     (format t "~&Ruff! ~s~%" (gamekit:subt (pos obj2)
                                            (pos obj1)))
     (setf (pos obj2)
           (gamekit:add (pos obj2)
                        (gamekit:subt (pos obj2)
                                      (pos obj1))))
     nil))
 
 (defun find-in-space (pos obj-list)
   (find pos obj-list 
         :key 'pos 
         :test 'bodge-math:vec=))
 
 (defun update (thing fun &rest args)
   (apply fun thing args))
 
 (define-modify-macro updatef (fun &rest args)
   update)
 
 (defun move-handler (delta)
   (lambda (game player)
     (updatef (pos player)
              (lambda (old-pos)
                (let* ((new-pos (gamekit:add old-pos delta))
                       (feature-in-space (find-in-space new-pos (monsters game))))
                  (if (and feature-in-space (interact2 game player feature-in-space))
                      old-pos
                      new-pos))))) )
 
 (defun move-left (game player)
   (let ((handler (move-handler (gamekit:vec2 -1 0))))
     (lambda ()
       (funcall handler game player))))
 
 (defun move-right (game player)
   (let ((handler (move-handler (gamekit:vec2 1 0)))) 
     (lambda ()
       (funcall handler game player))))
 
 (defun move-up (game player)
   (let ((handler (move-handler (gamekit:vec2 0 1)))) 
     (lambda ()
       (funcall handler game player))))
 
 (defun move-down (game player)
   (let ((handler (move-handler (gamekit:vec2 0 -1)))) 
     (lambda ()
       (funcall handler game player))))
 
 
 (defmethod gamekit:post-initialize ((game bodgelike))
   (gamekit:bind-button :h :pressed
                        (move-left game (player game)))
   (gamekit:bind-button :j :pressed
                        (move-down game (player game)))
   (gamekit:bind-button :k :pressed
                        (move-up game (player game)))
   (gamekit:bind-button :l :pressed
                        (move-right game (player game))))
 
 (defmethod style )
 
 (defmethod gamekit:draw ((system bodgelike))
   (dotimes (row 16)
     (dotimes (col 16)
       (draw-tile row col)))
   (let ((*my-font* (gamekit:make-font :fantasy (* 0.8 *tile-size*))))
     (mapcar 'draw-feature
             (monsters system))
     (draw-feature (player system))))