;;;; wheelwork.lisp

(in-package #:wheelwork)

(defvar *application* nil
  "current application")

(defclass/std application ()
  ((title :with :std "Wheelwork App")
   (asset-root :ri :std #P"./" :doc "Directory under which assets are stored.")
   (asset-classifiers
    :std '(("png" texture))
    :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 :a :std 1.0)
   (width height :with :std 800)
   (projection :with :a :doc "The projection matrix for the scene. Orthographic by default.")
   (window :with :a)
   (display-root :doc "A list of objects to display, the root of a tree")
   (refocus-on-mousedown-p :std t)
   (focus last-motion-target :with :a)
   (frame-wait :std (/ 1000 30) :doc "Frames Per Second" :a)))

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

(defmethod (setf closer-mop:slot-value-using-class) :after
    (new-value class (app application) slot)
  (when (member (closer-mop:slot-definition-name slot)
                '(scale width height))
    (set-projection app)))


(defgeneric boot (app)
  (:documentation "Specialized for each subclass of
  APPLICATION. Responsble for setting the app up once the system
  resoruces are avaialble.")
  (:method ((app application)) nil))

(defgeneric cleanup (thing)
  (:documentation "Clean up applications, textures, and so on.")
  (:method ((any t)) nil))

(defun start (app &key (x :centered) (y :centered))
  (sdl2:with-init (:everything)
    (sdl2:with-window (window
                       :flags '(:shown :opengl)
                       :title (application-title app)
                       :w (application-width app)
                       :h (application-height app)
                       :x x :y y)
      (setf (application-window app) window)
      (sdl2:with-gl-context (ctx window)
        (sdl2:gl-make-current window ctx)
        (gl:viewport 0 0 (application-width app) (application-height app))
        (let ((*application* app)) 
          (boot app)
          (eventloop app)
          (cleanup app))))))

(defun eventloop (app)
  (sdl2:with-event-loop (:method :poll)
    (:quit () t)))



;; (defun get-focus (&optional (app *application*))
;;   (or (application-focus app)
;;       (display-root app)))

;; (defun get-projection (&optional (app *application*))
;;   (application-projection app))

;; (defun application-width (&optional (app *application*))
;;   (multiple-value-bind (w h) (sdl2:get-window-size (application-window app))
;;     (declare (ignore h))
;;     w))

;; (defun application-height (&optional (app *application*))
;;   (multiple-value-bind (w h) (sdl2:get-window-size (application-window app))
;;     (declare (ignore w))
;;     h))

;; (defun asset-class-for (asset-id &optional (app *application*))
;;   "Given an asset-id (see GET-ASSET), retrieve the symbol name of a
;; the class that will be used to instantiate the asset object. That
;; class should be a subclass of ASSET.  Additional clases can be added
;; to the application's ASSET-CLASSIFIERS association list."
;;   (second (assoc (pathname-type asset-id) (asset-classifiers app) :test #'string-equal)))

;; (defun get-asset (asset-id &optional (app *application*))
;;   "ASSET-ID is a pathname namestring relative to the application's
;; ASSET-ROOT. GET-ASSET retrieves an already-available asset from the
;; application's ASSETS table, or, if not available, loads the asset from
;; disk."
;;   (or (gethash asset-id (application-assets app))
;;       (setf (gethash asset-id (application-assets app))
;;             (initialize
;;              (make-instance (asset-class-for asset-id)
;;                             :path (uiop:merge-pathnames* asset-id (asset-root app)))))))

;; (defclass/std event-handler ()
;;   ((event-type handler-function :ri)))

;; (defclass/std listener ()
;;   ((keydown keyup mousedown mouseup mousemove mousewheel focus blur perframe
;;             :r :with :type event-handler)
;;    (keydown-table
;;     keyup-table
;;     mousedown-table
;;     mouseup-table
;;     mousemove-table
;;     mousewheel-table
;;     focus-table
;;     blur-table
;;     perframe-table
;;     :static
;;     :std (make-hash-table)
;;     :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if handler is defined for unit."))
;;   (:documentation "Event handlers per object. The static hash tables
;;   are keyed by UNIT and hold Event-Handler instances."))

;; (defclass/std display-unit ()
;;   ((x y width height rotation :a :with :std 0.0 :type float :doc "Geometric properties")
;;    (cached-model cached-real-model container listener :a :doc "Internal use.")
;;    (focusablep :doc "T indicates it cannot be made the object of focus.")
;;    (opacity :std 1.0 :doc "0.0 indicates it will not be rendred.")))