;;;; application

(in-package #:wheelwork)

(defclass/std application (region interactive)
  ((title :with :ri :std "Wheelwork App")
   (asset-root :ri :std #P"./" :doc "Directory under which assets are stored.")
   (asset-classifiers
    :std '(("png" png) ("ttf" font))
    :doc "ALIST of (EXT CLASS). EXT is a string, file estension. CLASS is a symbol, class name.")
   (assets :with :a :std (make-hash-table :test 'equal)
           :doc "maps asset names to asset instances.")
   (scale :with :std 1.0
                :doc "Scale factor applied before all
                rendering. Affects sizes of all object as well as the
                coordinates of mouse events.")
   (width height :with :std 800 :doc "Window dimensions in real pixels.")
   (projection :with :a :doc "The projection matrix for the scene. Orthographic by default.")
   (window :with :a)
   (refocus-on-mousedown-p
    :std t
    :doc "When T, clicking on a visible object will set the
    application focus to that object.")
   (mouse-button-events-bubble-p
    mouse-motion-events-bubble-p
    :std nil
    :doc "determines whether the search for event handlers stops at
    the first visible unit under the xy position of the mouse or
    not. ")
   (scene focus last-motion-target :with :a)
   (fps :std 30 :doc "Frames Per Second")
   (frame-wait :r))
  (:documentation "The application contains the information and data
  structures necessary for creating a window, adding display units to
  it, handling events, and loading resources.  You should sublcass
  this and write your own BOOT method."))

(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)))