aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/application.lisp
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-06-29 11:54:24 -0500
committerColin Okay <colin@cicadas.surf>2022-06-29 11:54:24 -0500
commit82f71b0d13788b1cff9a24c5b652effd11631523 (patch)
treef0ec127b2f10f46029983ee95b6c72ef29bc504c /src/application.lisp
parent4d1ee56c96ce254134b692f0e3b3271c87a42b54 (diff)
[refactor] [structure] modularized project file structure
Diffstat (limited to 'src/application.lisp')
-rw-r--r--src/application.lisp108
1 files changed, 108 insertions, 0 deletions
diff --git a/src/application.lisp b/src/application.lisp
new file mode 100644
index 0000000..5d8135e
--- /dev/null
+++ b/src/application.lisp
@@ -0,0 +1,108 @@
+;;;; application
+
+(in-package #:wheelwork)
+
+(defvar *application* nil
+ "current application")
+
+(defclass/std application (container interactive)
+ ((title :with :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)
+ (width height :with :std 800)
+ (projection :with :a :doc "The projection matrix for the scene. Orthographic by default.")
+ (window :with :a)
+ (refocus-on-mousedown-p :std t)
+ (focus last-motion-target :with :a)
+ (fps :with :std 30 :doc "Frames Per Second")
+ (frame-wait :r)))
+
+(defun fps (&optional (app *application*))
+ (application-fps app))
+
+(defun (setf fps) (new-val &optional (app *application*))
+ (setf (application-fps app) new-val))
+
+(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)
+ (setf (listener app) (make-instance 'listener)))
+
+(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 after-added-table before-added-table
+ before-dropped-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))))
+ (call-next-method))
+
+(defun run-perframe (app)
+ "Runs all of the handlers objects listening for perframe events, if
+those objects are currently part of the scene tree."
+ (let ((table (perframe-table (listener app)))
+ (time (get-universal-time)))
+ (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-container 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 )
+ (dolist (thing (container-units app))
+ (render thing))
+ (sdl2:gl-swap-window (application-window app))
+ (sleep (frame-wait app)))