;;;; application

(in-package #:wheelwork)

(def:class application (region interactive)
  (title :prefix :ro :type string :initform "Wheelwork App")
  ((asset-root "Directory underwhich assets are stored.")
   :ro :type pathname :initform #P"./")
  ((asset-classifiers "ALIST of (FILE-EXTENSION CLASS-NAME) pairs.")
   :initform '(("png" png) ("ttf" font)))
  ((assets "Map of asset names to asset instances")
   :prefix :noarg :initform (make-hash-table :test 'equal))
  ((scale "Scale factor applied to all rendering and to all event targeting.")
   :prefix :type float :initform 1.0)
  ((width "pixel width")
   (height "pixel height")
   :prefix :type fixnum :initform 800)
  ((projection "Scene projection matrix. Orthographic by default.")
   :prefix :noarg)
  ((window "SDL2 application window.")
   :prefix :noarg)
  ((refocus-on-mousedown-p "Clicking a visbile unit will set focus to that unit.")
   :type boolean :initform t)
  (mouse-button-events-bubble-p
   mouse-motion-events-bubble-p
   :type boolean :initform nil
   :documentation "If T, handler search doesn't stop at first visble event target.")
  ((scene "Vector of objects to be displayed")
   :prefix :noarg :type (vector unit))
  ((focus "Unit with current focus.")
   (last-motion-target "Unit that last receved a mouse motion event.")
   :prefix :noarg :type (or null unit) :initform nil)
  ((fps "Frames per second")
   :type fixnum :initform 30)
  ((frame-wait "Pause between frames, in seconds")
   :type number :ro :noarg))

(defun can-set-projection-p (app)
  (and (slot-boundp app 'width)
       (slot-boundp app 'height)
       (slot-boundp app 'scale)))

(defun set-projection (app)
  (when (can-set-projection-p app)
    (with-slots (projection scale width height) app 
      ;; set projection matrix
      (setf projection (mat:mortho 0.0 (/ width scale) 0 (/ height scale) -1.0 1.0)))))

(defmethod initialize-instance :after ((app application) &key)
  (set-projection app)
  (with-slots (listener left right top bottom scale width height scene ) app
  (setf listener (make-instance 'listener)
        left 0
        bottom 0
        top (/ height scale)
        right (/ width scale)
        scene (make-array 0 :adjustable t :fill-pointer t :initial-element nil))))

(defun fire-blur-event-on (thing)
  (when-let (blur-handlers (and thing (get-handlers-for thing 'blur)))
    (dolist (handler blur-handlers) 
      (funcall handler thing))))

(defun fire-focus-event-on (thing)
  (when-let (focus-handlers (and thing (get-handlers-for thing 'focus)))
    (dolist (handler focus-handlers)
      (funcall handler thing))))

(defmethod (setf closer-mop:slot-value-using-class ) :before
    (new-value class (app application) slot)
  (case (closer-mop:slot-definition-name slot)
    (focus
     (when (slot-boundp app 'focus) 
       (unless (eq new-value (slot-value app 'focus)) 
         (fire-blur-event-on (slot-value app 'focus))
         (fire-focus-event-on new-value))))))

(defmethod (setf closer-mop:slot-value-using-class) :after
    (new-value class (app application) slot)
  (case (closer-mop:slot-definition-name slot)
    ((scale width height)
     (set-projection app))
    (fps
     (setf (slot-value app 'frame-wait) (/ 1.0 new-value)))))

(defparameter +listener-table-slot-names+
  '(keydown-table keyup-table mousedown-table  mouseup-table  mousemotion-table
    focus-table blur-table perframe-table))

(defmethod cleanup ((app application))
  (loop for asset being the hash-value of (application-assets app)
        do (cleanup asset))
  ;; drop all current handlers
  (let ((listener (listener app))) 
    (dolist (table +listener-table-slot-names+)
      (setf (slot-value listener table) (make-hash-table :synchronized t))))
  (loop for unit across (application-scene app)
        do
           (drop-unit unit)
           (cleanup unit))
  (pre-exit-hooks))

(defun run-perframe (app)
  "Runs all of the handlers objects listening for perframe events if they are in the scene."
  (let ((table (perframe-table (listener app)))
        (time (sdl2:get-ticks)))
    (loop for target being the hash-key of table
          for handlers = (slot-value (listener target) 'perframe)
          ;; only fire perframe when target is in scene
          when (or (eq app target) (unit-in-scene-p target)) 
            do (loop for handler in handlers do (funcall handler target time)))))

(defmethod render ((app application))
  (run-perframe app)
  (gl:clear-color 0.0 0.0 0.0 1.0)
  ;(gl:clear :depth-buffer-bit :color-buffer-bit)
  (gl:clear :color-buffer-bit)
  (gl:enable :blend)
  (gl:blend-func :src-alpha :one-minus-src-alpha )
  (with-slots (scene) app 
    (when (plusp (length scene)) 
      (loop for unit across scene do (render unit))))
  (sdl2:gl-swap-window (application-window app))
  (sleep (frame-wait app)))