[refactor] [structure] modularized project file structure

20 files changed, 1218 insertions, 1129 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)))
diff --git a/src/assets/asset.lisp b/src/assets/asset.lisp
new file mode 100644
index 0000000..5f847da
--- /dev/null
+++ b/src/assets/asset.lisp
@@ -0,0 +1,18 @@
+;;;; asset.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std asset ()
+  ((path :with :ri :std (error "An asset requires a path"))
+   (loadedp :with :a)))
+
+(defmethod cleanup :around ((asset asset))
+  (when (asset-loadedp asset)
+    (call-next-method))
+  (setf (asset-loadedp asset) nil))
+
+(defmethod ensure-loaded :around ((thing asset))
+  (unless (asset-loadedp thing) 
+    (call-next-method)
+    (setf (asset-loadedp thing) t))
+  thing) 
diff --git a/src/assets/font.lisp b/src/assets/font.lisp
new file mode 100644
index 0000000..3ff29d5
--- /dev/null
+++ b/src/assets/font.lisp
@@ -0,0 +1,17 @@
+;;;; asset/font.lisp
+
+(in-package #:wheelwork)
+
+(define-symbol-macro +standard-font-chars+
+  " 
+ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'"  )
+
+(defclass/std font (asset)
+  ((characters :i :std +standard-font-chars+)
+   (oversample :i :doc "ovesampling factor to pass to cl-fond:make-font")
+   (object :with :r :doc "The font as returned from cl-fond:make-font")))
+
+(defmethod ensure-loaded ((font font))
+  (with-slots (path characters oversample object) font
+    (setf object (cl-fond:make-font path characters :oversample oversample))))
+
diff --git a/src/assets/png.lisp b/src/assets/png.lisp
new file mode 100644
index 0000000..aa259f0
--- /dev/null
+++ b/src/assets/png.lisp
@@ -0,0 +1,31 @@
+;;;; png.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std png (asset texture) ())
+
+(defmethod ensure-loaded ((png png))
+  (with-slots
+        (width height id wrap-s wrap-t min-filter mag-filter internal-format image-format)
+      png
+    (pngload:with-png-in-static-vector (data (asset-path png) :flip-y t)
+      (setf width (pngload:width data)
+            height (pngload:height data)
+            id (gl:gen-texture))
+      (gl:bind-texture :texture-2d id)
+      (gl:tex-parameter :texture-2d :texture-wrap-s wrap-s)
+      (gl:tex-parameter :texture-2d :texture-wrap-t wrap-t)
+      (gl:tex-parameter :texture-2d :texture-min-filter min-filter)
+      (gl:tex-parameter :texture-2d :texture-mag-filter mag-filter)
+      (gl:tex-image-2d :texture-2d
+                       0
+                       internal-format
+                       width
+                       height
+                       0
+                       image-format
+                       :unsigned-byte
+                       (pngload:data data))
+      (gl:bind-texture :texture-2d 0)
+      (when (texture-mipmap png)
+        (gl:generate-mipmap :texture-2d)))))
diff --git a/src/core-units/container.lisp b/src/core-units/container.lisp
new file mode 100644
index 0000000..afa68b3
--- /dev/null
+++ b/src/core-units/container.lisp
@@ -0,0 +1,32 @@
+;;;; units/container.lisp
+
+(in-package #:wheelwork)
+
+
+(defclass/std container ()
+  ((units :with :a))
+  (:documentation "Just a list of units. Made into a class so that
+  transformation affine transformations methods can be specialzied on
+  whole groups of units"))
+
+(defmethod drop-unit ((unit unit))
+  "Removes a unit from its container. Returns T if the unit actually was removed."
+  (when-let (container (unit-container unit))
+    (setf
+     (container-units container) (delete unit (container-units container))
+     (unit-container unit) nil)
+    t))
+
+(defmethod add-unit ((container container) (unit unit))
+  "Adds a unit to the end of a container (thus affecting render
+order). Makes sure to remove the unit from its current container if
+necessary."
+  (when (unit-container unit)
+    (drop-unit unit))
+  (push unit  (container-units container))
+  (setf (unit-container unit) container)
+  unit)
+
+(defmethod cleanup ((container container))
+  (dolist (u (container-units container))
+    (cleanup u)))
diff --git a/src/core-units/unit.lisp b/src/core-units/unit.lisp
new file mode 100644
index 0000000..939293b
--- /dev/null
+++ b/src/core-units/unit.lisp
@@ -0,0 +1,71 @@
+;;;; units/unit.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std unit ()
+  ((cached-model cached-projected-matrix :a)
+   (container :with :a)
+   (base-width base-height :r :std 1.0 :doc "Determined by content.")
+   (scale-x scale-y :with :std 1.0)
+   (rotation x y :with :std 0.0)
+   (opacity :std 1.0 :doc "0.0 indicates it will not be rendred.")))
+
+
+(defun scale-by (unit amount)
+  (with-slots (scale-x scale-y) unit
+    (setf scale-x (* amount scale-x)
+          scale-y (* amount scale-y))))
+
+(defun set-width-preserve-aspect (unit new-width)
+  (scale-by unit (/ new-width (unit-width unit))))
+
+(defun set-height-preserve-aspect (unit new-height)
+  (scale-by unit (/ new-height (unit-height unit) )))
+
+(defmethod unit-width ((unit unit))
+  (with-slots (scale-x base-width) unit
+    (* scale-x base-width)))
+
+(defmethod unit-height ((unit unit))
+  (with-slots (scale-y base-height) unit
+    (* scale-y base-height)))
+
+(defmethod (setf unit-width) (newval (unit unit))
+  (with-slots (scale-x base-width) unit
+    (setf scale-x (coerce (/ newval base-width) 'single-float))))
+
+(defmethod (setf unit-height) (newval (unit unit))
+  (with-slots (scale-y base-height) unit
+    (setf scale-y (coerce (/ newval base-height) 'single-float))))
+
+(defmethod (setf closer-mop:slot-value-using-class) :after
+    (newval class (unit unit) slot)
+  (case (closer-mop:slot-definition-name slot)
+    ((x y scale-x scale-y rotation)
+     (setf (cached-model unit) nil
+           (cached-projected-matrix unit) nil))))
+
+(defmethod model-matrix :around ((u unit))
+  (or (cached-model u)
+      (setf (cached-model u)
+            (call-next-method))))
+
+(defmethod model-matrix ((u unit))
+  (let ((m (mat:meye 4)))
+    (with-slots (x y base-width scale-x base-height scale-y rotation) u 
+      (let ((uw (* base-width scale-x))
+            (uh (* base-height scale-y)))
+        (mat:nmtranslate m (vec:vec x y 0.0))
+
+        (mat:nmtranslate m (vec:v* 0.5 (vec:vec uw uh 0.0)))
+        (mat:nmrotate  m vec:+vz+ rotation)
+        (mat:nmtranslate m (vec:v* -0.5 (vec:vec uw uh 0.0)))
+        
+        (mat:nmscale m (vec:vec uw uh 1.0))))
+    m))
+
+(defmethod projected-matrix ((thing unit))
+  (or (cached-projected-matrix thing)
+      (setf (cached-projected-matrix thing)
+            (mat:marr (mat:m* (application-projection *application*)
+                              (model-matrix thing))))))
diff --git a/src/events/event-handler.lisp b/src/events/event-handler.lisp
new file mode 100644
index 0000000..bd40849
--- /dev/null
+++ b/src/events/event-handler.lisp
@@ -0,0 +1,260 @@
+;;;; event-handler.lisp
+
+(in-package #:wheelwork)
+
+
+(defclass/std event-handler ()
+  ((event-type handler-function :ri))
+  (:metaclass closer-mop:funcallable-standard-class))
+
+(defmethod initialize-instance :after ((eh event-handler) &key)
+  (with-slots (handler-function) eh
+    (closer-mop:set-funcallable-instance-function eh handler-function)))
+
+
+(defmacro defhandler (name handler)
+  "Defines a handler - binds (FDEFINITION NAME) to HANDLER, which
+should be an expression that evaluates to an instance of
+EVENT-HANDLER, which is funcallable.  It is define such that handlers
+can be redefined using this form to support interactive development."
+  (let ((handler-var (gensym)))
+    `(let ((,handler-var ,handler))
+       (if-let (extant (and (fboundp ',name)
+                            (fdefinition ',name)))
+         (closer-mop:set-funcallable-instance-function extant (handler-function ,handler-var))
+         (setf (fdefinition ',name) ,handler-var)))))
+
+
+(defmacro on-perframe
+    ((&optional (target 'target) (time 'time)) &body body)
+  "Creates a handler for 'PERFRAME events"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::perframe
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name time)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(time (intern (symbol-name time)))))
+                        ,@body)))
+
+(defmacro on-keydown
+    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
+  "Creates a lambda suitable for the value of a keydown event
+  handler. The function accepts two positional arguments TARGET and
+  SCANCODE and one &REST argument MODIFIERS.
+
+  SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ...
+
+  The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::keydown
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name scancode))
+                               &rest ,(intern (symbol-name modifiers)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name scancode))
+                                            ,(intern (symbol-name modifiers))))
+                        ,@body)))
+
+(defmacro on-keyup
+    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
+  "Creates a lambda suitable for the value of a keyup event
+  handler. The function accepts two positional arguments TARGET and
+  SCANCODE and one &REST argument MODIFIERS.
+
+  SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ...
+
+  The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::keyup
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name scancode))
+                               &rest ,(intern (symbol-name modifiers)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name scancode))
+                                            ,(intern (symbol-name modifiers))))
+                        ,@body)))
+
+(defmacro on-mousemotion
+    ((&optional
+        (target 'target)
+        (x 'x) (y 'y)
+        (xrel 'xrel) (yrel 'yrel)
+        (state 'state)
+        (win-x 'win-x) (win-y 'win-y)
+        (win-xrel 'win-xrel) (win-yrel 'win-yrel))
+     &body body)
+  "Creates a handler for MOUSEMOTION events"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::mousemotion
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name xrel))
+                               ,(intern (symbol-name yrel))
+                               ,(intern (symbol-name state))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y))
+                               ,(intern (symbol-name win-xrel))
+                               ,(intern (symbol-name win-yrel)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name xrel))
+                                            ,(intern (symbol-name yrel))
+                                            ,(intern (symbol-name state))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))
+                                            ,(intern (symbol-name win-xrel))
+                                            ,(intern (symbol-name win-yrel))))
+                        ,@body)))
+
+(defmacro on-mousedown
+    ((&optional (target 'target)
+        (x 'x) (y 'y)
+        (clicks 'clicks) (button 'button)
+        (win-x 'win-x) (win-y 'win-y))
+     &body body)
+  "Creates a handler for MOUSEDOWN events"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::mousedown
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name clicks))
+                               ,(intern (symbol-name button))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name clicks))
+                                            ,(intern (symbol-name button))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))))
+                        ,@body)))
+
+(defmacro on-mouseup
+    ((&optional (target 'target)
+        (x 'x) (y 'y)
+        (clicks 'clicks) (button 'button)
+        (win-x 'win-x) (win-y 'win-y))
+     &body body)
+  "Creates a handler for MOUSEUP events"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::mouseup
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name clicks))
+                               ,(intern (symbol-name button))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name clicks))
+                                            ,(intern (symbol-name button))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))))
+                        ,@body)))
+
+(defmacro on-mousewheel
+    ((&optional (target 'target) (horiz 'horiz) (vert 'vert) (dir 'dir)) &body body)
+  "Creates a handler for MOUSEWHEEL events"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::mousewheel
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name horiz))
+                               ,(intern (symbol-name vert))
+                               ,(intern (symbol-name dir)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name horiz))
+                                            ,(intern (symbol-name vert))
+                                            ,(intern (symbol-name dir))))
+                        ,@body)))
+
+(defmacro on-blur
+    ((&optional (target 'target)) &body body)
+  "Creates a handler for BLUR events. BLUR is a psuedo event that
+fires whenever an object loses focus."
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::blur
+    :handler-function (lambda
+                          (,(intern (symbol-name target)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))))
+                        ,@body)))
+
+(defmacro on-focus
+    ((&optional (target 'target)) &body body)
+  "Creates a handler for a FOCUS event. FOCUS is a pusedo event that
+fires when the FOCUS slot of the current APPLICATION instance is changed.
+"
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::focus
+    :handler-function (lambda
+                          (,(intern (symbol-name target)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))))
+                        ,@body)))
+
+(defmacro on-before-dropped
+    ((&optional (target 'target)) &body body)
+  "Creates a handler for BEFORE-DROPPED events, which fire before a
+  unit is removed from its container."
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::before-dropped
+    :handler-function (lambda
+                          (,(intern (symbol-name target)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))))
+                        ,@body)))
+
+(defmacro on-before-added
+    ((&optional (container 'container) (target 'target)) &body body)
+  "Creates a handler for BEFORE-ADDED events, which fire before a unit
+  is added to a container."
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::before-added
+    :handler-function (lambda
+                          (,(intern (symbol-name container))
+                           ,(intern (symbol-name target)))
+                        (declare
+                         (ignorable
+                          ,(intern (symbol-name container))
+                          ,(intern (symbol-name target))))
+                        ,@body)))
+
+
+(defmacro on-after-added
+    ((&optional (container 'container) (target 'target)) &body body)
+  "Creates a handler for AFTER-ADDED events, which fire after a unit
+  is added to a container."
+  `(make-instance
+    'event-handler
+    :event-type 'wheelwork::after-added
+    :handler-function (lambda
+                          (,(intern (symbol-name container))
+                           ,(intern (symbol-name target)))
+                        (declare
+                         (ignorable
+                          ,(intern (symbol-name container))
+                          ,(intern (symbol-name target))))
+                        ,@body)))
diff --git a/src/events/listener-and-interactive.lisp b/src/events/listener-and-interactive.lisp
new file mode 100644
index 0000000..fdfe7b3
--- /dev/null
+++ b/src/events/listener-and-interactive.lisp
@@ -0,0 +1,108 @@
+;;;; listener.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std listener ()
+  ((keydown
+    keyup
+    mousedown
+    mouseup
+    mousemotion
+    mousewheel
+    focus
+    blur
+    perframe
+    after-added
+    before-added
+    before-dropped
+    :r :with :type (or null event-handler) :std nil)
+   (keydown-table
+    keyup-table
+    mousedown-table
+    mouseup-table
+    mousemotion-table
+    mousewheel-table
+    focus-table
+    blur-table
+    perframe-table
+    after-added-table
+    before-added-table
+    before-dropped-table
+    :static
+    :std (make-hash-table :synchronized t)
+    :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."))
+
+(defun listener-table-for (listener event-type)
+  (ecase event-type
+    (keydown (keydown-table listener))
+    (keyup   (keyup-table listener))
+    (mousedown (mousewheel-table listener))
+    (mouseup (mouseup-table listener))
+    (mousemotion (mousemotion-table listener))
+    (mousewheel (mousewheel-table listener))
+    (focus (focus-table listener))
+    (blur (blur-table listener))
+    (perframe (perframe-table listener))
+    (after-added (after-added-table listener))
+    (before-added (before-added-table listener))
+    (after-dropped (after-dropped-table listener))
+    (before-dropped (before-dropped-table listener))))
+
+(defun should-listen-for-p (event-type &optional (app *application*))
+  (plusp (hash-table-count (listener-table-for (listener app) event-type))))
+
+(defclass/std interactive ()
+  ((listener :type (or null listener) :std nil :a)
+   (focusablep :std t :doc "Whether or not this object can receive application focus."))
+  (:documentation "Supplies an object with a listener slot."))
+
+(defun add-handler (interactive handler)
+  (when (null (listener interactive))
+    (setf (listener interactive) (make-instance 'listener)))
+  (pushnew handler (slot-value (listener interactive) (event-type handler)) :test #'eq)
+  (setf
+   (gethash interactive (listener-table-for (listener interactive) (event-type handler)))
+   t))
+
+
+(defun remove-handler (interactive handler-or-event-type)
+  "Handler can be an instance of EVENT-HANDLER or can be a symbol
+  whose name is an event type.  If is an event handler, only that
+  handler will be removed. If it is an event type, all events of that
+  type name are removed from the object."
+  (when (listener interactive)
+    (let ((event-type (etypecase handler-or-event-type
+                        (keyword (intern (symbol-name handler-or-event-type) :wheelwork))
+                        (symbol (intern (symbol-name handler-or-event-type) :wheelwork))
+                        (event-handler (event-type handler-or-event-type)))))
+      (setf (slot-value (listener interactive) event-type)
+            (if (symbolp handler-or-event-type)
+                ;; remove everything if a symbol
+                nil
+                ;; delete just the handler
+                (delete handler-or-event-type
+                        (slot-value (listener interactive) event-type)
+                        :test #'eq)))
+      ;; remove from from the global table unless any listeners remain on this event
+      (unless (slot-value (listener interactive) event-type)
+        (remhash interactive (listener-table-for (listener interactive) event-type))))))
+
+
+(defmethod drop-unit :before ((unit interactive))
+  (when (unit-container unit) 
+    (when-let (handlers (get-handlers-for unit 'before-dropped))
+      (dolist (handler handlers) 
+        (funcall handler unit)))))
+
+(defmethod add-unit :before ((container container) (unit interactive))
+  (when-let (handlers (get-handlers-for unit 'before-added))
+    (dolist (handler handlers) 
+      (funcall handler container unit))))
+
+(defmethod add-unit :after ((container container) (unit interactive))
+  (when-let (handlers (get-handlers-for unit 'after-added))
+    (dolist (handler handlers) 
+      (funcall handler container unit))))
diff --git a/src/events/listener.lisp b/src/events/listener.lisp
new file mode 100644
index 0000000..2876c40
--- /dev/null
+++ b/src/events/listener.lisp
@@ -0,0 +1,4 @@
+;;;; listener.lisp
+
+(in-package #:wheelwork)
+
diff --git a/src/gl/shader.lisp b/src/gl/shader.lisp
new file mode 100644
index 0000000..4bba7b8
--- /dev/null
+++ b/src/gl/shader.lisp
@@ -0,0 +1,42 @@
+;;;; shader.lisp
+
+(in-package #:wheelwork)
+
+(defun shader-by-type (type)
+  (case type
+    (:vertex :vertex-shader)
+    (:geometry :geometry-shader)
+    (:fragment :fragment-shader)))
+
+(defun gl-shader (type stage)
+  (let ((shader (gl:create-shader type)))
+    (gl:shader-source shader (varjo:glsl-code stage))
+    (gl:compile-shader shader)
+    (unless (gl:get-shader shader :compile-status)
+      (error "failed to compile ~a shader:~%~a~%"
+             type (gl:get-shader-info-log shader)))
+    shader))
+
+(defun create-shader (&rest sources)
+  (let* ((stages
+          (varjo:rolling-translate
+           (mapcar (lambda (source)
+                     (destructuring-bind (type inputs uniforms code) source
+                       (varjo:make-stage type inputs uniforms '(:330) code)))
+                   sources)))
+         (shaders
+          (loop
+             :for stage :in stages
+             :for source :in sources
+             :collect (gl-shader (shader-by-type (car source))
+                                 stage)))
+         (program (gl:create-program)))
+    (dolist (shader shaders) (gl:attach-shader program shader))
+    (gl:link-program program)
+    (unless (gl:get-program program :link-status)
+      (error "failed to link program: ~%~a~%"
+             (gl:get-program-info-log program)))
+    (dolist (shader shaders)
+      (gl:detach-shader program shader)
+      (gl:delete-shader shader))
+    program))
diff --git a/src/gl/texture.lisp b/src/gl/texture.lisp
new file mode 100644
index 0000000..ad753a1
--- /dev/null
+++ b/src/gl/texture.lisp
@@ -0,0 +1,12 @@
+;;;; texture.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std texture ()
+  ((width height id mipmap :with :r)
+   (internal-format image-format :ri :with :std :rgba)
+   (wrap-s wrap-t :ri :with :std :repeat)
+   (min-filter mag-filter :ri :with :std :nearest)))
+
+(defmethod cleanup ((texture texture))
+  (gl:delete-texture (texture-id texture)))
diff --git a/src/gl/util.lisp b/src/gl/util.lisp
new file mode 100644
index 0000000..bff2f88
--- /dev/null
+++ b/src/gl/util.lisp
@@ -0,0 +1,19 @@
+;;;; gl/util.lisp
+
+(in-package #:wheelwork)
+
+(define-symbol-macro +float-size+
+    (cffi:foreign-type-size :float))
+
+(defun gl-array (type &rest contents)
+  (let ((array (gl:alloc-gl-array type (length contents))))
+    (dotimes (i (length contents) array)
+      (setf (gl:glaref array i) (elt contents i)))))
+
+(defmacro with-gl-array ((var type &rest contents) &body body)
+  `(let ((,var (gl-array ,type ,@contents))) 
+     (unwind-protect (progn ,@body)
+       (gl:free-gl-array ,var))))
+
+
+
diff --git a/src/interactive-units/bitmap.lisp b/src/interactive-units/bitmap.lisp
new file mode 100644
index 0000000..95dfff5
--- /dev/null
+++ b/src/interactive-units/bitmap.lisp
@@ -0,0 +1,71 @@
+;;;; bitmap.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std bitmap (unit interactive)
+  ((texture :ri :std (error "A bitmap requires a texture."))
+   (vao shader :with :r :static)))
+
+(defmethod initialize-instance :after ((bitmap bitmap) &key)
+  (with-slots (vao shader base-width base-height texture) bitmap
+    (setf base-height (texture-height texture)
+          base-width (texture-width texture))
+    (unless shader
+      (setf shader
+            (create-shader
+             '(:vertex
+               ((vert :vec2))
+               ((transform :mat4))
+               ((values
+                 (* transform (vari:vec4 vert 0.0 1.0))
+                 vert))) ;color
+             '(:fragment
+               ((tc :vec2))
+               ((tex :sampler-2d))
+               ((let ((frag  (vari:texture tex tc)))
+                  (if (< (aref frag 3) 0.01)
+                      (vari:discard)
+                      frag))))))
+      (gl:program-uniformi
+       shader
+       (gl:get-uniform-location shader "TEX")
+       0))
+    (unless vao
+      (setf vao (gl:gen-vertex-array))
+      (gl:bind-vertex-array vao)
+      (let ((vbo (gl:gen-buffer)))
+        (with-gl-array (verts :float
+                              0.0 1.0 
+                              1.0 0.0 
+                              0.0 0.0 
+                              
+                              0.0 1.0 
+                              1.0 1.0 
+                              1.0 0.0 )
+          (gl:bind-buffer :array-buffer vbo)
+          (gl:buffer-data :array-buffer :static-draw verts)))
+      (gl:enable-vertex-attrib-array 0)
+      (gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0)
+      (gl:bind-buffer :array-buffer 0)
+      (gl:bind-vertex-array 0))))
+
+(defmethod cleanup ((bitmap bitmap))
+  (with-slots (vao shader) bitmap
+    (when vao
+      (gl:delete-vertex-arrays (list vao)))
+    (when shader
+      (gl:delete-program shader))
+    (setf vao nil
+          shader nil)))
+(defmethod render ((bitmap bitmap))
+  (with-slots (texture vao shader) bitmap
+    (gl:active-texture 0)
+    (gl:bind-texture :texture-2d (texture-id texture))
+    (gl:use-program shader)
+    (gl:program-uniform-matrix-4fv
+     shader
+     (gl:get-uniform-location shader "TRANSFORM")
+     (projected-matrix bitmap))
+    (gl:bind-vertex-array vao)    
+    (gl:draw-arrays :triangles 0 6)
+    (gl:bind-vertex-array 0)))
diff --git a/src/interactive-units/text.lisp b/src/interactive-units/text.lisp
new file mode 100644
index 0000000..f439621
--- /dev/null
+++ b/src/interactive-units/text.lisp
@@ -0,0 +1,91 @@
+;;;; units/text.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std text (unit interactive)
+  ((font :with :ri :std (error "A font is required") :type font)
+   (content :with :ri :std "")
+   (color :with :std #(1.0 1.0 1.0 1.0))
+   (vao elem-count newlines :r)
+   (shader :with :static :r)))
+
+(defmethod model-matrix ((text text))
+  (let ((m (mat:meye 4)))
+    (with-slots (font newlines x y base-width base-height scale-x scale-y rotation) text 
+      (let* ((text-height
+               (cl-fond:text-height (font-object font)))
+             (baseline-offset
+              (* newlines text-height))
+             (rotation-baseline-offset
+               (* 2 newlines text-height )))
+        (mat:nmtranslate m (vec:vec x
+                                    (+ y
+                                       (*
+                                        scale-y
+                                        baseline-offset))
+                                    0.0))
+
+        (mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width)
+                                                (* scale-y (- base-height rotation-baseline-offset) )
+                                                0.0)))
+        (mat:nmrotate  m vec:+vz+ rotation)
+        (mat:nmtranslate m (vec:v* -0.5 (vec:vec (* scale-x base-width )
+                                                 (* scale-y (- base-height rotation-baseline-offset))
+                                                 0.0))))
+      
+      (mat:nmscale m (vec:vec scale-x scale-y 1.0))
+      m)))
+
+(defmethod initialize-instance :after ((text text) &key)
+  (with-slots (content newlines font vao elem-count shader base-width base-height scale-x scale-y) text
+    (unless shader
+      (setf shader
+            (create-shader
+             '(:vertex
+               ((vert :vec2) (col :vec2))
+               ((transform :mat4))
+               ((values
+                 (* transform (vari:vec4 vert 0.0 1.0))
+                 col)))
+             '(:fragment
+               ((tc :vec2))
+               ((tex :sampler-2d)
+                (color :vec4))
+               ((* color (aref (vari:texture tex tc) 0)))))))
+    (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
+      (setf vao vao%
+            elem-count count%))
+    (setf newlines (count #\newline content))
+    (hq:with-plist (l r) (cl-fond:compute-extent (font-object font) content)
+      (setf base-width (- r l)
+            base-height (* (cl-fond:text-height (font-object font))
+                           (1+ newlines))))))
+
+(defmethod cleanup ((text text))
+  (with-slots (vao shader) text
+    (gl:delete-vertex-arrays (list vao))
+    (when shader
+      (gl:delete-program shader))
+    (setf vao nil
+          shader nil)))
+
+(defmethod render ((text text))
+  (with-slots (shader font vao elem-count color) text
+    (gl:use-program shader)
+    (gl:active-texture 0)
+    (gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
+    (gl:program-uniform-matrix-4fv
+     shader
+     (gl:get-uniform-location shader "TRANSFORM")
+     (projected-matrix text))
+    (gl:program-uniformi
+     shader
+     (gl:get-uniform-location shader "TEX")
+     0)
+    (gl:program-uniformfv
+     shader
+     (gl:get-uniform-location shader "COLOR")
+     color)
+    (gl:bind-vertex-array vao)
+    (%gl:draw-elements :triangles elem-count :unsigned-int 0)
+    (gl:bind-vertex-array 0)))
diff --git a/package.lisp b/src/package.lisp
index 74c9477..74c9477 100644
--- a/package.lisp
+++ b/src/package.lisp
diff --git a/src/protocol.lisp b/src/protocol.lisp
new file mode 100644
index 0000000..52d2525
--- /dev/null
+++ b/src/protocol.lisp
@@ -0,0 +1,45 @@
+;;;; protocol.lisp
+
+(in-package #:wheelwork)
+
+(defgeneric boot (app)
+  (:documentation "Specialized for each subclass of
+  APPLICATION. Responsble for setting the app up once the system
+  resoruces are avaialble."))
+
+(defgeneric shutdown (app)
+  (:documentation "Specialzied for each subclass of
+  APPLICATION. Called just before cleanup.")
+  (:method ((any t)) nil))
+
+(defgeneric cleanup (thing)
+  (:documentation "Clean up applications, textures, and other foreign
+  resources. Called after shutodown.")
+  (:method ((any t)) nil))
+
+(defgeneric drop-unit (unit)
+  (:documentation "Removes a unit from a container."))
+(defgeneric add-unit (container unit)
+  (:documentation "Adds a unit to a container, removing it from its
+  current container first, if necessary."))
+
+(defgeneric unit-width (unit))
+(defgeneric unit-height (unit)) 
+(defgeneric (setf unit-width) (newval unit))
+(defgeneric (setf unit-height) (newval unit))
+
+(defgeneric render (thing)
+  (:documentation "Renders thing for visual display."))
+
+(defgeneric model-matrix (thing)
+  (:documentation "Returns the model matrix for THING, representing
+  its position, scale, and orientation in the scene"))
+
+(defgeneric projected-matrix (thing)
+  (:documentation "Returns the raw array of the model matrix after it
+  has been prjected by the application's projecion matrix. Used to
+  pass to GLSL shader programs."))
+
+(defgeneric ensure-loaded (asset)
+  (:documentation "Ensures that the asset is loaded into memory and
+  ready for use. Returns the asset."))
diff --git a/src/utils.lisp b/src/utils.lisp
new file mode 100644
index 0000000..e0f6dcd
--- /dev/null
+++ b/src/utils.lisp
@@ -0,0 +1,9 @@
+;;;; utils.lisp
+
+(in-package #:wheelwork)
+
+(define-symbol-macro +pi-over-180+ 0.017453292519943295d0)
+
+(defun radians (degrees)
+  "Converse DEGREES to radians"
+  (* degrees +pi-over-180+))
diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp
new file mode 100644
index 0000000..15975fc
--- /dev/null
+++ b/src/wheelwork.lisp
@@ -0,0 +1,259 @@
+;;;; wheelwork.lisp
+
+(in-package #:wheelwork)
+
+(defun start (app &key (x :centered) (y :centered))
+  (sdl2:with-init (:everything)
+    (sdl2:gl-set-attr :context-major-version 3)
+    (sdl2:gl-set-attr :context-minor-version 3)
+    (sdl2:gl-set-attr :context-profile-mask
+                      sdl2-ffi:+sdl-gl-context-profile-core+)
+    (sdl2:gl-set-attr :doublebuffer 1)
+
+    (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))
+        ;(gl:enable :depth-test)
+        (let ((*application* app)) 
+          (unwind-protect
+               (progn 
+                 (boot app)
+                 (eventloop app)
+                 (shutdown app))
+            (cleanup app)))))))
+
+
+(defun refocus-on (target &optional (app *application*))
+  "Sets focus of application to TARGET. This works whether or not
+TARGET is FOCUSABLEP"
+  (setf (application-focus app) target))
+
+(defun get-focus (&optional (app *application*))
+  (or (application-focus app) app))
+
+(defun get-handlers-for (unit event-type)
+  "EVENT-TYPE must be one of the slot value names for WHEELWORK::LISTENER."
+  (?> (unit) listener #$(slot-value $listener event-type)))
+
+(defun eventloop-keydown (app sdl-keysym)
+  (let ((target (get-focus app))) 
+    (when-let (handlers (get-handlers-for target 'keydown)) 
+      (dolist (handler handlers) 
+        (apply handler
+               target
+               (sdl2:scancode sdl-keysym)
+               (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
+
+(defun eventloop-keyup (app sdl-keysym)
+  (let ((target (get-focus app))) 
+    (when-let (handlers (get-handlers-for target 'keyup)) 
+      (dolist (handler handlers) 
+        (apply handler
+               target
+               (sdl2:scancode sdl-keysym)
+               (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
+
+(defun get-rect (unit)
+  "Returns a list of vectors representing the path of the smallest
+rectangle that encloses the unit. The rectangle is scaled and rotated."
+  (with-accessors ((x unit-x) (y unit-y) (w unit-width) (h unit-height) (r unit-rotation)) unit
+    (let ((m
+            (mat:meye 4))
+          (tr
+            (vec:vec (+ x (* 0.5 w)) (+ y (* 0.5 h)) 0.0)))
+      (mat:nmtranslate m tr)
+      (mat:nmrotate  m vec:+vz+ r)
+      (mat:nmtranslate m (vec:v* -1.0 tr))
+
+      (list (mat:m* m (vec:vec x y 0.0 1.0))
+            (mat:m* m (vec:vec x (+ y h) 0.0 1.0))
+            (mat:m* m (vec:vec (+ x w) (+ y h) 0.0 1.0))
+            (mat:m* m (vec:vec (+ x w) y 0.0 1.0))
+            (mat:m* m (vec:vec x y 0.0 1.0))))))
+
+(defun counterclockwisep (a b c)
+  (> (* (- (vec:vx b) (vec:vx a))
+        (- (vec:vy c) (vec:vy a)))
+     (* (- (vec:vy b) (vec:vy a))
+        (- (vec:vx c) (vec:vx a)))))
+
+
+(defun intersectp (a b c d)
+  (or (vec:v= a c) (vec:v= a d) (vec:v= b c) (vec:v= b d)
+      (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
+           (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))
+
+(defun path-bounds (path)
+  "Path is a list of vectors representing 2d points. Returns the
+bounds and width and height as a plist of the form 
+
+(:top N :left N :right N :bottom N :width N :height N)
+
+This is the smallest UNROTATED RECTANGLE that contains the points in
+the path."
+  (loop
+    with max-x = nil
+    and max-y = nil
+    and min-x = nil
+    and min-y = nil
+    for vec in path
+    for x = (vec:vx vec)
+    for y = (vec:vy vec)
+    when (or (null max-x) (< max-x x))
+      do (setf max-x x)
+    when (or (null min-x) (< x min-x))
+      do (setf min-x x)
+    when (or (null max-y) (< max-y y))
+      do (setf max-y y)
+    when (or (null min-y) (< y min-y))
+      do (setf min-y y)
+    finally
+       (return (list :top max-y :left min-x :right max-x :bottom min-y
+                     :width (- max-x min-x)
+                     :height (- max-y min-y)))))
+
+(defun contains-point-p (unit px py)
+  (let* ((pt
+           (vec:vec px py 0.0 1.0))
+         (poly
+           (get-rect unit))
+         (bounds
+           (path-bounds poly))
+         (corner
+           ;; creating a point guaranteed to be outside of poly
+           (vec:vec (- (getf bounds :left) (getf bounds :width))
+                    (- (getf bounds :bottom) (getf bounds :height))
+                    0.0 1.0)))
+    (loop for (p1 p2 . more) on poly
+          while p2
+          when (intersectp p1 p2 pt corner)
+            count 1 into intersection-count
+          finally
+             (progn
+               (return (oddp intersection-count))))))
+
+(defun unit-under (app x y)
+  (labels
+      ((finder (thing)
+         (etypecase thing
+           (container
+            (find-if #'finder (container-units thing) :from-end t))
+           (unit
+            (when (contains-point-p thing x y)
+              (return-from unit-under thing))))))
+    (finder app)))
+
+(defun screen-to-world (x y &optional (app *application*))
+  (with-slots (height scale) app
+    (list (/ x scale) (/ (- height y) scale))))
+
+(defun eventloop-mousebuttondown (app wx wy clicks button)
+  "Searches for a handler to handle applies it if found.
+
+Additionally, if the APPLICATION's REFOCUS-ON-MOUSEDOWN-P is T, try to
+give focus to whatever was clicked."
+  (destructuring-bind (x y) (screen-to-world wx wy)
+    (let ((target
+            (or (unit-under app x y)    ; if no unit is under the mouse,
+                app)))                  ; then target the app itself
+      (when (and (refocus-on-mousedown-p app) (focusablep target))
+        (refocus-on target))              
+      (when-let (handlers (get-handlers-for target 'mousedown))
+        (dolist (handler handlers) 
+          (funcall handler target x y clicks button wx wy))))))
+
+(defun eventloop-mousebuttonup (app wx wy clicks button)
+  (when (should-listen-for-p 'mouseup app)
+    (destructuring-bind (x y) (screen-to-world wx wy)
+      (when-let* ((target (or (unit-under app x y)
+                              app))
+                  (handlers (get-handlers-for target 'mouseup)))
+        (dolist (handler handlers) 
+          (funcall handler target x y clicks button wx wy))))))
+
+(defun eventloop-mousemotion (app wx wy wxrel wyrel state)
+  (when (should-listen-for-p 'mousemotion app)
+    (destructuring-bind (x y) (screen-to-world wx wy)
+      (destructuring-bind (xrel yrel) (screen-to-world wxrel wyrel)
+        (when-let* ((target (or (unit-under app x y)
+                                app))
+                    (handlers (get-handlers-for target 'mousemotion)))
+          (dolist (handler handlers) 
+            (funcall handler target x y xrel yrel state wx wy wxrel wyrel)))))))
+
+(defun eventloop-mousewheel (app wx wy dir)
+  (when (should-listen-for-p 'mousewheel app)
+    (when-let* ((focus (get-focus app))
+                (handlers (get-handlers-for focus 'mousewheel)))
+      (dolist (handler handlers) 
+        (funcall handler focus wx wy dir)))))
+
+
+(defun eventloop (app)
+  (sdl2:with-event-loop (:method :poll)
+    (:mousebuttondown
+     (:x x :y y :clicks clicks :button button)
+     (eventloop-mousebuttondown app x y clicks button))
+    (:mousemotion
+     (:x x :y y :xrel xrel :yrel yrel :state state)
+     (eventloop-mousemotion app x y xrel yrel state))
+    (:mousebuttonup
+     (:x x :y y :clicks clicks :button button)
+     (eventloop-mousebuttonup app x y clicks button))
+    (:keydown
+     (:keysym keysym)
+     (eventloop-keydown app keysym))
+    (:keyup
+     (:keysym keysym)
+     (eventloop-keyup app keysym))
+    (:mousewheel
+     (:x x :y y :direction dir)
+     (eventloop-mousewheel app x y dir))
+    (:idle () (render app))
+    (:quit () t)))
+
+
+(defclass/std animation (unit interactive)
+  ((frames :with :doc "A 2d array of TEXTURE instances. Its dimensiosn are (set-index texture-index)")
+   (framesets :with :i :r :type integer :std 1 :doc "The number of sets")
+   (current-frameset current-frame :std 0 :a)
+   (fps :with :std 1)
+   (last-frame :with :std (get-universal-time) :a :doc "Time of last frame advance")))
+
+
+(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 &key (app *application*) asset-args)
+  "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.
+
+ASSET-ARGS is a plist to pass to make-instance for the given resource.
+"
+  (or (gethash asset-id (application-assets app))
+      (setf (gethash asset-id (application-assets app))
+            (ensure-loaded
+             (apply 'make-instance
+                    (asset-class-for asset-id)
+                    :path (uiop:merge-pathnames* asset-id (asset-root app))
+                    asset-args)))))
+
+
+
+
+
+
+
diff --git a/wheelwork.asd b/wheelwork.asd
index b1fd2d5..ef3a1a3 100644
--- a/wheelwork.asd
+++ b/wheelwork.asd
@@ -17,5 +17,26 @@
                #:closer-mop
                #:lambda-riffs
                #:cl-fond)
+  :pathname "src/"
   :components ((:file "package")
+               (:file "protocol")
+               (:file "utils")
+               (:module "gl"
+                :components ((:file "util")
+                             (:file "texture")
+                             (:file "shader")))
+               (:module "assets"
+                :components ((:file "asset")
+                             (:file "png")
+                             (:file "font")))
+               (:module "core-units"
+                :components ((:file "unit")
+                             (:file "container")))
+               (:module "events"
+                :components ((:file "event-handler")
+                             (:file "listener-and-interactive")))
+               (:module "interactive-units"
+                :components ((:file "bitmap")
+                             (:file "text")))
+               (:file "application")
                (:file "wheelwork")))
diff --git a/wheelwork.lisp b/wheelwork.lisp
deleted file mode 100644
index 25b4695..0000000
--- a/wheelwork.lisp
+++ /dev/null
@@ -1,1129 +0,0 @@
-;;;; wheelwork.lisp
-
-(in-package #:wheelwork)
-
-(defvar *application* nil
-  "current application")
-
-(defclass/std unit ()
-  ((cached-model cached-projected-matrix :a)
-   (container :with :a)
-   (base-width base-height :r :std 1.0 :doc "Determined by content.")
-   (scale-x scale-y :with :std 1.0)
-   (rotation x y :with :std 0.0)
-   (opacity :std 1.0 :doc "0.0 indicates it will not be rendred.")))
-
-(defgeneric unit-width (unit))
-(defgeneric unit-height (unit)) 
-(defgeneric (setf unit-width) (newval unit))
-(defgeneric (setf unit-height) (newval unit))
-
-(defun scale-by (unit amount)
-  (with-slots (scale-x scale-y) unit
-    (setf scale-x (* amount scale-x)
-          scale-y (* amount scale-y))))
-
-(defun set-width-preserve-aspect (unit new-width)
-  (scale-by unit (/ new-width (unit-width unit))))
-
-(defun set-height-preserve-aspect (unit new-height)
-  (scale-by unit (/ new-height (unit-height unit) )))
-
-(defmethod unit-width ((unit unit))
-  (with-slots (scale-x base-width) unit
-    (* scale-x base-width)))
-
-(defmethod unit-height ((unit unit))
-  (with-slots (scale-y base-height) unit
-    (* scale-y base-height)))
-
-(defmethod (setf unit-width) (newval (unit unit))
-  (with-slots (scale-x base-width) unit
-    (setf scale-x (coerce (/ newval base-width) 'single-float))))
-
-(defmethod (setf unit-height) (newval (unit unit))
-  (with-slots (scale-y base-height) unit
-    (setf scale-y (coerce (/ newval base-height) 'single-float))))
-
-(defmethod (setf closer-mop:slot-value-using-class) :after
-    (newval class (unit unit) slot)
-  (case (closer-mop:slot-definition-name slot)
-    ((x y scale-x scale-y rotation)
-     (setf (cached-model unit) nil
-           (cached-projected-matrix unit) nil))))
-
-(defclass/std container ()
-  ((units :with :a))
-  (:documentation "Just a list of units. Made into a class so that
-  transformation affine transformations methods can be specialzied on
-  whole groups of units"))
-
-(defgeneric drop-unit (unit))
-(defgeneric add-unit (container unit))
-
-(defmethod drop-unit ((unit unit))
-  "Removes a unit from its container. Returns T if the unit actually was removed."
-  (when-let (container (unit-container unit))
-    (setf
-     (container-units container) (delete unit (container-units container))
-     (unit-container unit) nil)
-    t))
-
-(defmethod add-unit ((container container) (unit unit))
-  "Adds a unit to the end of a container (thus affecting render
-order). Makes sure to remove the unit from its current container if
-necessary."
-  (when (unit-container unit)
-    (drop-unit unit))
-  (push unit  (container-units container))
-  (setf (unit-container unit) container)
-  unit)
-
-
-(defclass/std event-handler ()
-  ((event-type handler-function :ri))
-  (:metaclass closer-mop:funcallable-standard-class))
-
-(defmethod initialize-instance :after ((eh event-handler) &key)
-  (with-slots (handler-function) eh
-    (closer-mop:set-funcallable-instance-function eh handler-function)))
-
-(defclass/std listener ()
-  ((keydown
-    keyup
-    mousedown
-    mouseup
-    mousemotion
-    mousewheel
-    focus
-    blur
-    perframe
-    after-added
-    before-added
-    before-dropped
-    :r :with :type (or null event-handler) :std nil)
-   (keydown-table
-    keyup-table
-    mousedown-table
-    mouseup-table
-    mousemotion-table
-    mousewheel-table
-    focus-table
-    blur-table
-    perframe-table
-    after-added-table
-    before-added-table
-    before-dropped-table
-    :static
-    :std (make-hash-table :synchronized t)
-    :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 interactive ()
-  ((listener :type (or null listener) :std nil :a)
-   (focusablep :std t :doc "Whether or not this object can receive application focus."))
-  (:documentation "Supplies an object with a listener slot."))
-
-(defmethod drop-unit :before ((unit interactive))
-  (when (unit-container unit) 
-    (when-let (handlers (get-handlers-for unit 'before-dropped))
-      (dolist (handler handlers) 
-        (funcall handler unit)))))
-
-(defmethod add-unit :before ((container container) (unit interactive))
-  (when-let (handlers (get-handlers-for unit 'before-added))
-    (dolist (handler handlers) 
-      (funcall handler container unit))))
-
-(defmethod add-unit :after ((container container) (unit interactive))
-  (when-let (handlers (get-handlers-for unit 'after-added))
-    (dolist (handler handlers) 
-      (funcall handler container unit))))
-
-(defun listener-table-for (listener event-type)
-  (ecase event-type
-    (keydown (keydown-table listener))
-    (keyup   (keyup-table listener))
-    (mousedown (mousewheel-table listener))
-    (mouseup (mouseup-table listener))
-    (mousemotion (mousemotion-table listener))
-    (mousewheel (mousewheel-table listener))
-    (focus (focus-table listener))
-    (blur (blur-table listener))
-    (perframe (perframe-table listener))
-    (after-added (after-added-table listener))
-    (before-added (before-added-table listener))
-    (after-dropped (after-dropped-table listener))
-    (before-dropped (before-dropped-table listener))))
-
-(defun add-handler (interactive handler)
-  (when (null (listener interactive))
-    (setf (listener interactive) (make-instance 'listener)))
-  (pushnew handler (slot-value (listener interactive) (event-type handler)) :test #'eq)
-  (setf
-   (gethash interactive (listener-table-for (listener interactive) (event-type handler)))
-   t))
-
-
-(defun remove-handler (interactive handler-or-event-type)
-  "Handler can be an instance of EVENT-HANDLER or can be a symbol
-  whose name is an event type.  If is an event handler, only that
-  handler will be removed. If it is an event type, all events of that
-  type name are removed from the object."
-  (when (listener interactive)
-    (let ((event-type (etypecase handler-or-event-type
-                        (keyword (intern (symbol-name handler-or-event-type) :wheelwork))
-                        (symbol (intern (symbol-name handler-or-event-type) :wheelwork))
-                        (event-handler (event-type handler-or-event-type)))))
-      (setf (slot-value (listener interactive) event-type)
-            (if (symbolp handler-or-event-type)
-                ;; remove everything if a symbol
-                nil
-                ;; delete just the handler
-                (delete handler-or-event-type
-                        (slot-value (listener interactive) event-type)
-                        :test #'eq)))
-      ;; remove from from the global table unless any listeners remain on this event
-      (unless (slot-value (listener interactive) event-type)
-        (remhash interactive (listener-table-for (listener interactive) event-type))))))
-
-
-
-(defun should-listen-for-p (event-type &optional (app *application*))
-  (plusp (hash-table-count (listener-table-for (listener app) event-type))))
-
-
-(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)))))
-
-
-(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 shutdown (app)
-  (:documentation "Specialzied for each subclass of
-  APPLICATION. Called just before cleanup.")
-  (:method ((app application)) nil))
-
-
-(defgeneric cleanup (thing)
-  (:documentation "Clean up applications, textures, and so on.")
-  (:method ((any t)) nil))
-
-(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))
-
-(defmethod cleanup ((container container))
-  (dolist (u (container-units container))
-    (cleanup u)))
-
-(defun start (app &key (x :centered) (y :centered))
-  (sdl2:with-init (:everything)
-    (sdl2:gl-set-attr :context-major-version 3)
-    (sdl2:gl-set-attr :context-minor-version 3)
-    (sdl2:gl-set-attr :context-profile-mask
-                      sdl2-ffi:+sdl-gl-context-profile-core+)
-    (sdl2:gl-set-attr :doublebuffer 1)
-
-    (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))
-        ;(gl:enable :depth-test)
-        (let ((*application* app)) 
-          (unwind-protect
-               (progn 
-                 (boot app)
-                 (eventloop app)
-                 (shutdown app))
-            (cleanup app)))))))
-
-(defun run-perframe (app)
-  (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)))))
-
-(defgeneric render (thing))
-(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)))
-
-(defgeneric model-matrix (thing)
-  (:documentation "Returns the model matrix"))
-
-(defgeneric projected-matrix (thing)
-  (:documentation "Returns the raw array of the model matrix after it
-  has been prjected by the application's projecion matrix"))
-
-(defmethod model-matrix :around ((u unit))
-  (or (cached-model u)
-      (setf (cached-model u)
-            (call-next-method))))
-
-(defmethod model-matrix ((u unit))
-  (let ((m (mat:meye 4)))
-    (with-slots (x y base-width scale-x base-height scale-y rotation) u 
-      (let ((uw (* base-width scale-x))
-            (uh (* base-height scale-y)))
-        (mat:nmtranslate m (vec:vec x y 0.0))
-
-        (mat:nmtranslate m (vec:v* 0.5 (vec:vec uw uh 0.0)))
-        (mat:nmrotate  m vec:+vz+ rotation)
-        (mat:nmtranslate m (vec:v* -0.5 (vec:vec uw uh 0.0)))
-        
-        (mat:nmscale m (vec:vec uw uh 1.0))))
-    m))
-
-(defmethod projected-matrix ((thing unit))
-  (or (cached-projected-matrix thing)
-      (setf (cached-projected-matrix thing)
-            (mat:marr (mat:m* (application-projection *application*)
-                              (model-matrix thing))))))
-
-(defgeneric ensure-loaded (asset)
-  (:documentation "Ensures that the asset is loaded into memory and ready for use. Returns the asset."))
-
-(defclass/std asset ()
-  ((path :with :ri :std (error "An asset requires a path"))
-   (loadedp :with :a)))
-
-(defmethod cleanup :around ((asset asset))
-  (when (asset-loadedp asset)
-    (call-next-method))
-  (setf (asset-loadedp asset) nil))
-
-(defmethod ensure-loaded :around ((thing asset))
-  (unless (asset-loadedp thing) 
-    (call-next-method)
-    (setf (asset-loadedp thing) t))
-  thing) 
-
-(defclass/std texture ()
-  ((width height id mipmap :with :r)
-   (internal-format image-format :ri :with :std :rgba)
-   (wrap-s wrap-t :ri :with :std :repeat)
-   (min-filter mag-filter :ri :with :std :nearest)))
-
-(defmethod cleanup ((texture texture))
-  (gl:delete-texture (texture-id texture)))
-
-(defclass/std png (asset texture) ())
-
-(defmethod ensure-loaded ((png png))
-  (with-slots
-        (width height id wrap-s wrap-t min-filter mag-filter internal-format image-format)
-      png
-    (pngload:with-png-in-static-vector (data (asset-path png) :flip-y t)
-      (setf width (pngload:width data)
-            height (pngload:height data)
-            id (gl:gen-texture))
-      (gl:bind-texture :texture-2d id)
-      (gl:tex-parameter :texture-2d :texture-wrap-s wrap-s)
-      (gl:tex-parameter :texture-2d :texture-wrap-t wrap-t)
-      (gl:tex-parameter :texture-2d :texture-min-filter min-filter)
-      (gl:tex-parameter :texture-2d :texture-mag-filter mag-filter)
-      (gl:tex-image-2d :texture-2d
-                       0
-                       internal-format
-                       width
-                       height
-                       0
-                       image-format
-                       :unsigned-byte
-                       (pngload:data data))
-      (gl:bind-texture :texture-2d 0)
-      (when (texture-mipmap png)
-        (gl:generate-mipmap :texture-2d)))))
-
-
-(defun refocus-on (target &optional (app *application*))
-  "Sets focus of application to TARGET. This works whether or not
-TARGET is FOCUSABLEP"
-  (setf (application-focus app) target))
-
-(defun get-focus (&optional (app *application*))
-  (or (application-focus app) app))
-
-(defun get-handlers-for (unit event-type)
-  "EVENT-TYPE must be one of the slot value names for WHEELWORK::LISTENER."
-  (?> (unit) listener #$(slot-value $listener event-type)))
-
-(defun eventloop-keydown (app sdl-keysym)
-  (let ((target (get-focus app))) 
-    (when-let (handlers (get-handlers-for target 'keydown)) 
-      (dolist (handler handlers) 
-        (apply handler
-               target
-               (sdl2:scancode sdl-keysym)
-               (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
-
-(defun eventloop-keyup (app sdl-keysym)
-  (let ((target (get-focus app))) 
-    (when-let (handlers (get-handlers-for target 'keyup)) 
-      (dolist (handler handlers) 
-        (apply handler
-               target
-               (sdl2:scancode sdl-keysym)
-               (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
-
-(defun get-rect (unit)
-  "Returns a list of vectors representing the path of the smallest
-rectangle that encloses the unit. The rectangle is scaled and rotated."
-  (with-accessors ((x unit-x) (y unit-y) (w unit-width) (h unit-height) (r unit-rotation)) unit
-    (let ((m
-            (mat:meye 4))
-          (tr
-            (vec:vec (+ x (* 0.5 w)) (+ y (* 0.5 h)) 0.0)))
-      (mat:nmtranslate m tr)
-      (mat:nmrotate  m vec:+vz+ r)
-      (mat:nmtranslate m (vec:v* -1.0 tr))
-
-      (list (mat:m* m (vec:vec x y 0.0 1.0))
-            (mat:m* m (vec:vec x (+ y h) 0.0 1.0))
-            (mat:m* m (vec:vec (+ x w) (+ y h) 0.0 1.0))
-            (mat:m* m (vec:vec (+ x w) y 0.0 1.0))
-            (mat:m* m (vec:vec x y 0.0 1.0))))))
-
-(defun counterclockwisep (a b c)
-  (> (* (- (vec:vx b) (vec:vx a))
-        (- (vec:vy c) (vec:vy a)))
-     (* (- (vec:vy b) (vec:vy a))
-        (- (vec:vx c) (vec:vx a)))))
-
-
-(defun intersectp (a b c d)
-  (or (vec:v= a c) (vec:v= a d) (vec:v= b c) (vec:v= b d)
-      (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
-           (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))
-
-(defun path-bounds (path)
-  "Path is a list of vectors representing 2d points. Returns the
-bounds and width and height as a plist of the form 
-
-(:top N :left N :right N :bottom N :width N :height N)
-
-This is the smallest UNROTATED RECTANGLE that contains the points in
-the path."
-  (loop
-    with max-x = nil
-    and max-y = nil
-    and min-x = nil
-    and min-y = nil
-    for vec in path
-    for x = (vec:vx vec)
-    for y = (vec:vy vec)
-    when (or (null max-x) (< max-x x))
-      do (setf max-x x)
-    when (or (null min-x) (< x min-x))
-      do (setf min-x x)
-    when (or (null max-y) (< max-y y))
-      do (setf max-y y)
-    when (or (null min-y) (< y min-y))
-      do (setf min-y y)
-    finally
-       (return (list :top max-y :left min-x :right max-x :bottom min-y
-                     :width (- max-x min-x)
-                     :height (- max-y min-y)))))
-
-(defun contains-point-p (unit px py)
-  (let* ((pt
-           (vec:vec px py 0.0 1.0))
-         (poly
-           (get-rect unit))
-         (bounds
-           (path-bounds poly))
-         (corner
-           ;; creating a point guaranteed to be outside of poly
-           (vec:vec (- (getf bounds :left) (getf bounds :width))
-                    (- (getf bounds :bottom) (getf bounds :height))
-                    0.0 1.0)))
-    (loop for (p1 p2 . more) on poly
-          while p2
-          when (intersectp p1 p2 pt corner)
-            count 1 into intersection-count
-          finally
-             (progn
-               (return (oddp intersection-count))))))
-
-(defun unit-under (app x y)
-  (labels
-      ((finder (thing)
-         (etypecase thing
-           (container
-            (find-if #'finder (container-units thing) :from-end t))
-           (unit
-            (when (contains-point-p thing x y)
-              (return-from unit-under thing))))))
-    (finder app)))
-
-(defun screen-to-world (x y &optional (app *application*))
-  (with-slots (height scale) app
-    (list (/ x scale) (/ (- height y) scale))))
-
-(defun eventloop-mousebuttondown (app wx wy clicks button)
-  "Searches for a handler to handle applies it if found.
-
-Additionally, if the APPLICATION's REFOCUS-ON-MOUSEDOWN-P is T, try to
-give focus to whatever was clicked."
-  (destructuring-bind (x y) (screen-to-world wx wy)
-    (let ((target
-            (or (unit-under app x y)    ; if no unit is under the mouse,
-                app)))                  ; then target the app itself
-      (when (and (refocus-on-mousedown-p app) (focusablep target))
-        (refocus-on target))              
-      (when-let (handlers (get-handlers-for target 'mousedown))
-        (dolist (handler handlers) 
-          (funcall handler target x y clicks button wx wy))))))
-
-(defun eventloop-mousebuttonup (app wx wy clicks button)
-  (when (should-listen-for-p 'mouseup app)
-    (destructuring-bind (x y) (screen-to-world wx wy)
-      (when-let* ((target (or (unit-under app x y)
-                              app))
-                  (handlers (get-handlers-for target 'mouseup)))
-        (dolist (handler handlers) 
-          (funcall handler target x y clicks button wx wy))))))
-
-(defun eventloop-mousemotion (app wx wy wxrel wyrel state)
-  (when (should-listen-for-p 'mousemotion app)
-    (destructuring-bind (x y) (screen-to-world wx wy)
-      (destructuring-bind (xrel yrel) (screen-to-world wxrel wyrel)
-        (when-let* ((target (or (unit-under app x y)
-                                app))
-                    (handlers (get-handlers-for target 'mousemotion)))
-          (dolist (handler handlers) 
-            (funcall handler target x y xrel yrel state wx wy wxrel wyrel)))))))
-
-(defun eventloop-mousewheel (app wx wy dir)
-  (when (should-listen-for-p 'mousewheel app)
-    (when-let* ((focus (get-focus app))
-                (handlers (get-handlers-for focus 'mousewheel)))
-      (dolist (handler handlers) 
-        (funcall handler focus wx wy dir)))))
-
-
-(defun eventloop (app)
-  (sdl2:with-event-loop (:method :poll)
-    (:mousebuttondown
-     (:x x :y y :clicks clicks :button button)
-     (eventloop-mousebuttondown app x y clicks button))
-    (:mousemotion
-     (:x x :y y :xrel xrel :yrel yrel :state state)
-     (eventloop-mousemotion app x y xrel yrel state))
-    (:mousebuttonup
-     (:x x :y y :clicks clicks :button button)
-     (eventloop-mousebuttonup app x y clicks button))
-    (:keydown
-     (:keysym keysym)
-     (eventloop-keydown app keysym))
-    (:keyup
-     (:keysym keysym)
-     (eventloop-keyup app keysym))
-    (:mousewheel
-     (:x x :y y :direction dir)
-     (eventloop-mousewheel app x y dir))
-    (:idle () (render app))
-    (:quit () t)))
-
-(defclass/std bitmap (unit interactive)
-  ((texture :ri :std (error "A bitmap requires a texture."))
-   (vao shader :with :r :static)))
-
-(defmethod cleanup ((bitmap bitmap))
-  (with-slots (vao shader) bitmap
-    (when vao
-      (gl:delete-vertex-arrays (list vao)))
-    (when shader
-      (gl:delete-program shader))
-    (setf vao nil
-          shader nil)))
-
-(defun shader-by-type (type)
-  (case type
-    (:vertex :vertex-shader)
-    (:geometry :geometry-shader)
-    (:fragment :fragment-shader)))
-
-(defun gl-shader (type stage)
-  (let ((shader (gl:create-shader type)))
-    (gl:shader-source shader (varjo:glsl-code stage))
-    (gl:compile-shader shader)
-    (unless (gl:get-shader shader :compile-status)
-      (error "failed to compile ~a shader:~%~a~%"
-             type (gl:get-shader-info-log shader)))
-    shader))
-
-(defun create-shader (&rest sources)
-  (let* ((stages
-          (varjo:rolling-translate
-           (mapcar (lambda (source)
-                     (destructuring-bind (type inputs uniforms code) source
-                       (varjo:make-stage type inputs uniforms '(:330) code)))
-                   sources)))
-         (shaders
-          (loop
-             :for stage :in stages
-             :for source :in sources
-             :collect (gl-shader (shader-by-type (car source))
-                                 stage)))
-         (program (gl:create-program)))
-    (dolist (shader shaders) (gl:attach-shader program shader))
-    (gl:link-program program)
-    (unless (gl:get-program program :link-status)
-      (error "failed to link program: ~%~a~%"
-             (gl:get-program-info-log program)))
-    (dolist (shader shaders)
-      (gl:detach-shader program shader)
-      (gl:delete-shader shader))
-    program))
-
-
-(defun gl-array (type &rest contents)
-  (let ((array (gl:alloc-gl-array type (length contents))))
-    (dotimes (i (length contents) array)
-      (setf (gl:glaref array i) (elt contents i)))))
-
-(defmacro with-gl-array ((var type &rest contents) &body body)
-  `(let ((,var (gl-array ,type ,@contents))) 
-     (unwind-protect (progn ,@body)
-       (gl:free-gl-array ,var))))
-
-
-(define-symbol-macro +float-size+
-    (cffi:foreign-type-size :float))
-
-(defmethod initialize-instance :after ((bitmap bitmap) &key)
-  (with-slots (vao shader base-width base-height texture) bitmap
-    (setf base-height (texture-height texture)
-          base-width (texture-width texture))
-    (unless shader
-      (setf shader
-            (create-shader
-             '(:vertex
-               ((vert :vec2))
-               ((transform :mat4))
-               ((values
-                 (* transform (vari:vec4 vert 0.0 1.0))
-                 vert))) ;color
-             '(:fragment
-               ((tc :vec2))
-               ((tex :sampler-2d))
-               ((let ((frag  (vari:texture tex tc)))
-                  (if (< (aref frag 3) 0.01)
-                      (vari:discard)
-                      frag))))))
-      (gl:program-uniformi
-       shader
-       (gl:get-uniform-location shader "TEX")
-       0))
-    (unless vao
-      (setf vao (gl:gen-vertex-array))
-      (gl:bind-vertex-array vao)
-      (let ((vbo (gl:gen-buffer)))
-        (with-gl-array (verts :float
-                              0.0 1.0 
-                              1.0 0.0 
-                              0.0 0.0 
-                              
-                              0.0 1.0 
-                              1.0 1.0 
-                              1.0 0.0 )
-          (gl:bind-buffer :array-buffer vbo)
-          (gl:buffer-data :array-buffer :static-draw verts)))
-      (gl:enable-vertex-attrib-array 0)
-      (gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0)
-      (gl:bind-buffer :array-buffer 0)
-      (gl:bind-vertex-array 0))))
-
-(defmethod render ((bitmap bitmap))
-  (with-slots (texture vao shader) bitmap
-    (gl:active-texture 0)
-    (gl:bind-texture :texture-2d (texture-id texture))
-    (gl:use-program shader)
-    (gl:program-uniform-matrix-4fv
-     shader
-     (gl:get-uniform-location shader "TRANSFORM")
-     (projected-matrix bitmap))
-    (gl:bind-vertex-array vao)    
-    (gl:draw-arrays :triangles 0 6)
-    (gl:bind-vertex-array 0)))
-
-
-(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 &key (app *application*) asset-args)
-  "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.
-
-ASSET-ARGS is a plist to pass to make-instance for the given resource.
-"
-  (or (gethash asset-id (application-assets app))
-      (setf (gethash asset-id (application-assets app))
-            (ensure-loaded
-             (apply 'make-instance
-                    (asset-class-for asset-id)
-                    :path (uiop:merge-pathnames* asset-id (asset-root app))
-                    asset-args)))))
-
-(define-symbol-macro +standard-font-chars+
-  " 
-ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'"  )
-
-(defclass/std font (asset)
-  ((characters :i :std +standard-font-chars+)
-   (oversample :i :doc "ovesampling factor to pass to cl-fond:make-font")
-   (object :with :r :doc "The font as returned from cl-fond:make-font")))
-
-(defmethod ensure-loaded ((font font))
-  (with-slots (path characters oversample object) font
-    (setf object (cl-fond:make-font path characters :oversample oversample))))
-
-
-(defclass/std text (unit interactive)
-  ((font :with :ri :std (error "A font is required") :type font)
-   (content :with :ri :std "")
-   (color :with :std #(1.0 1.0 1.0 1.0))
-   (vao elem-count newlines :r)
-   (shader :with :static :r)))
-
-(defmethod model-matrix ((text text))
-  (let ((m (mat:meye 4)))
-    (with-slots (font newlines x y base-width base-height scale-x scale-y rotation) text 
-      (let* ((text-height
-               (cl-fond:text-height (font-object font)))
-             (baseline-offset
-              (* newlines text-height))
-             (rotation-baseline-offset
-               (* 2 newlines text-height )))
-        (mat:nmtranslate m (vec:vec x
-                                    (+ y
-                                       (*
-                                        scale-y
-                                        baseline-offset))
-                                    0.0))
-
-        (mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width)
-                                                (* scale-y (- base-height rotation-baseline-offset) )
-                                                0.0)))
-        (mat:nmrotate  m vec:+vz+ rotation)
-        (mat:nmtranslate m (vec:v* -0.5 (vec:vec (* scale-x base-width )
-                                                 (* scale-y (- base-height rotation-baseline-offset))
-                                                 0.0))))
-      
-      (mat:nmscale m (vec:vec scale-x scale-y 1.0))
-      m)))
-
-(defmethod initialize-instance :after ((text text) &key)
-  (with-slots (content newlines font vao elem-count shader base-width base-height scale-x scale-y) text
-    (unless shader
-      (setf shader
-            (create-shader
-             '(:vertex
-               ((vert :vec2) (col :vec2))
-               ((transform :mat4))
-               ((values
-                 (* transform (vari:vec4 vert 0.0 1.0))
-                 col)))
-             '(:fragment
-               ((tc :vec2))
-               ((tex :sampler-2d)
-                (color :vec4))
-               ((* color (aref (vari:texture tex tc) 0)))))))
-    (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
-      (setf vao vao%
-            elem-count count%))
-    (setf newlines (count #\newline content))
-    (hq:with-plist (l r) (cl-fond:compute-extent (font-object font) content)
-      (setf base-width (- r l)
-            base-height (* (cl-fond:text-height (font-object font))
-                           (1+ newlines))))))
-
-(defmethod cleanup ((text text))
-  (with-slots (vao shader) text
-    (gl:delete-vertex-arrays (list vao))
-    (when shader
-      (gl:delete-program shader))
-    (setf vao nil
-          shader nil)))
-
-(defmethod render ((text text))
-  (with-slots (shader font vao elem-count color) text
-    (gl:use-program shader)
-    (gl:active-texture 0)
-    (gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
-    (gl:program-uniform-matrix-4fv
-     shader
-     (gl:get-uniform-location shader "TRANSFORM")
-     (projected-matrix text))
-    (gl:program-uniformi
-     shader
-     (gl:get-uniform-location shader "TEX")
-     0)
-    (gl:program-uniformfv
-     shader
-     (gl:get-uniform-location shader "COLOR")
-     color)
-    (gl:bind-vertex-array vao)
-    (%gl:draw-elements :triangles elem-count :unsigned-int 0)
-    (gl:bind-vertex-array 0)))
-
-
-
-
-(defmacro defhandler (name handler)
-  "Defines a handler - binds (FDEFINITION NAME) to HANDLER, which
-should be an expression that evaluates to an instance of
-EVENT-HANDLER, which is funcallable.  It is define such that handlers
-can be redefined using this form to support interactive development."
-  (let ((handler-var (gensym)))
-    `(let ((,handler-var ,handler))
-       (if-let (extant (and (fboundp ',name)
-                            (fdefinition ',name)))
-         (closer-mop:set-funcallable-instance-function extant (handler-function ,handler-var))
-         (setf (fdefinition ',name) ,handler-var)))))
-
-
-(defmacro on-perframe
-    ((&optional (target 'target) (time 'time)) &body body)
-  "Creates a handler for 'PERFRAME events"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::perframe
-    :handler-function (lambda (,(intern (symbol-name target))
-                               ,(intern (symbol-name time)))
-                        (declare (ignorable ,(intern (symbol-name target))
-                                            ,(time (intern (symbol-name time)))))
-                        ,@body)))
-
-(defmacro on-keydown
-    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
-  "Creates a lambda suitable for the value of a keydown event
-  handler. The function accepts two positional arguments TARGET and
-  SCANCODE and one &REST argument MODIFIERS.
-
-  SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ...
-
-  The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::keydown
-    :handler-function (lambda (,(intern (symbol-name target))
-                               ,(intern (symbol-name scancode))
-                               &rest ,(intern (symbol-name modifiers)))
-                        (declare (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name scancode))
-                                            ,(intern (symbol-name modifiers))))
-                        ,@body)))
-
-(defmacro on-keyup
-    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
-  "Creates a lambda suitable for the value of a keyup event
-  handler. The function accepts two positional arguments TARGET and
-  SCANCODE and one &REST argument MODIFIERS.
-
-  SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ...
-
-  The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::keyup
-    :handler-function (lambda (,(intern (symbol-name target))
-                               ,(intern (symbol-name scancode))
-                               &rest ,(intern (symbol-name modifiers)))
-                        (declare (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name scancode))
-                                            ,(intern (symbol-name modifiers))))
-                        ,@body)))
-
-(defmacro on-mousemotion
-    ((&optional
-        (target 'target)
-        (x 'x) (y 'y)
-        (xrel 'xrel) (yrel 'yrel)
-        (state 'state)
-        (win-x 'win-x) (win-y 'win-y)
-        (win-xrel 'win-xrel) (win-yrel 'win-yrel))
-     &body body)
-  "Creates a handler for MOUSEMOTION events"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::mousemotion
-    :handler-function (lambda (,(intern (symbol-name target))
-                               ,(intern (symbol-name x))
-                               ,(intern (symbol-name y))
-                               ,(intern (symbol-name xrel))
-                               ,(intern (symbol-name yrel))
-                               ,(intern (symbol-name state))
-                               ,(intern (symbol-name win-x))
-                               ,(intern (symbol-name win-y))
-                               ,(intern (symbol-name win-xrel))
-                               ,(intern (symbol-name win-yrel)))
-                        (declare (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name x))
-                                            ,(intern (symbol-name y))
-                                            ,(intern (symbol-name xrel))
-                                            ,(intern (symbol-name yrel))
-                                            ,(intern (symbol-name state))
-                                            ,(intern (symbol-name win-x))
-                                            ,(intern (symbol-name win-y))
-                                            ,(intern (symbol-name win-xrel))
-                                            ,(intern (symbol-name win-yrel))))
-                        ,@body)))
-
-(defmacro on-mousedown
-    ((&optional (target 'target)
-        (x 'x) (y 'y)
-        (clicks 'clicks) (button 'button)
-        (win-x 'win-x) (win-y 'win-y))
-     &body body)
-  "Creates a handler for MOUSEDOWN events"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::mousedown
-    :handler-function (lambda
-                          (,(intern (symbol-name target))
-                               ,(intern (symbol-name x))
-                               ,(intern (symbol-name y))
-                               ,(intern (symbol-name clicks))
-                               ,(intern (symbol-name button))
-                               ,(intern (symbol-name win-x))
-                               ,(intern (symbol-name win-y)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name x))
-                                            ,(intern (symbol-name y))
-                                            ,(intern (symbol-name clicks))
-                                            ,(intern (symbol-name button))
-                                            ,(intern (symbol-name win-x))
-                                            ,(intern (symbol-name win-y))))
-                        ,@body)))
-
-(defmacro on-mouseup
-    ((&optional (target 'target)
-        (x 'x) (y 'y)
-        (clicks 'clicks) (button 'button)
-        (win-x 'win-x) (win-y 'win-y))
-     &body body)
-  "Creates a handler for MOUSEUP events"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::mouseup
-    :handler-function (lambda
-                          (,(intern (symbol-name target))
-                               ,(intern (symbol-name x))
-                               ,(intern (symbol-name y))
-                               ,(intern (symbol-name clicks))
-                               ,(intern (symbol-name button))
-                               ,(intern (symbol-name win-x))
-                               ,(intern (symbol-name win-y)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name x))
-                                            ,(intern (symbol-name y))
-                                            ,(intern (symbol-name clicks))
-                                            ,(intern (symbol-name button))
-                                            ,(intern (symbol-name win-x))
-                                            ,(intern (symbol-name win-y))))
-                        ,@body)))
-
-(defmacro on-mousewheel
-    ((&optional (target 'target) (horiz 'horiz) (vert 'vert) (dir 'dir)) &body body)
-  "Creates a handler for MOUSEWHEEL events"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::mousewheel
-    :handler-function (lambda
-                          (,(intern (symbol-name target))
-                               ,(intern (symbol-name horiz))
-                               ,(intern (symbol-name vert))
-                               ,(intern (symbol-name dir)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))
-                                            ,(intern (symbol-name horiz))
-                                            ,(intern (symbol-name vert))
-                                            ,(intern (symbol-name dir))))
-                        ,@body)))
-
-(defmacro on-blur
-    ((&optional (target 'target)) &body body)
-  "Creates a handler for BLUR events. BLUR is a psuedo event that
-fires whenever an object loses focus."
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::blur
-    :handler-function (lambda
-                          (,(intern (symbol-name target)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))))
-                        ,@body)))
-
-(defmacro on-focus
-    ((&optional (target 'target)) &body body)
-  "Creates a handler for a FOCUS event. FOCUS is a pusedo event that
-fires when the FOCUS slot of the current APPLICATION instance is changed.
-"
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::focus
-    :handler-function (lambda
-                          (,(intern (symbol-name target)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))))
-                        ,@body)))
-
-(defmacro on-before-dropped
-    ((&optional (target 'target)) &body body)
-  "Creates a handler for BEFORE-DROPPED events, which fire before a
-  unit is removed from its container."
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::before-dropped
-    :handler-function (lambda
-                          (,(intern (symbol-name target)))
-                        (declare
-                         (ignorable ,(intern (symbol-name target))))
-                        ,@body)))
-
-(defmacro on-before-added
-    ((&optional (container 'container) (target 'target)) &body body)
-  "Creates a handler for BEFORE-ADDED events, which fire before a unit
-  is added to a container."
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::before-added
-    :handler-function (lambda
-                          (,(intern (symbol-name container))
-                           ,(intern (symbol-name target)))
-                        (declare
-                         (ignorable
-                          ,(intern (symbol-name container))
-                          ,(intern (symbol-name target))))
-                        ,@body)))
-
-
-(defmacro on-after-added
-    ((&optional (container 'container) (target 'target)) &body body)
-  "Creates a handler for AFTER-ADDED events, which fire after a unit
-  is added to a container."
-  `(make-instance
-    'event-handler
-    :event-type 'wheelwork::after-added
-    :handler-function (lambda
-                          (,(intern (symbol-name container))
-                           ,(intern (symbol-name target)))
-                        (declare
-                         (ignorable
-                          ,(intern (symbol-name container))
-                          ,(intern (symbol-name target))))
-                        ,@body)))
-
-;;; Utility
-
-(define-symbol-macro +pi-over-180+ 0.017453292519943295d0)
-
-(defun radians (degrees)
-  "Converse DEGREES to radians"
-  (* degrees +pi-over-180+))
-