[refactor] represent scene as a vector; [refactor] shared text shader

3 files changed, 64 insertions, 45 deletions

diff --git a/src/application.lisp b/src/application.lisp
index 3b531c9..62849c9 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -48,12 +48,13 @@
 
 (defmethod initialize-instance :after ((app application) &key)
   (set-projection app)
-  (with-slots (listener left right top bottom scale width height) app
+  (with-slots (listener left right top bottom scale width height scene ) app
   (setf listener (make-instance 'listener)
         left 0
         bottom 0
         top (/ height scale)
-        right (/ width scale))))
+        right (/ width scale)
+        scene (make-array 0 :adjustable t :fill-pointer t :initial-element nil))))
 
 (defun fire-blur-event-on (thing)
   (when-let (blur-handlers (and thing (get-handlers-for thing 'blur)))
@@ -93,14 +94,14 @@
   (let ((listener (listener app))) 
     (dolist (table +listener-table-slot-names+)
       (setf (slot-value listener table) (make-hash-table :synchronized t))))
-  (dolist (unit (application-scene app))
-    (drop-unit unit)
-    (cleanup unit))
+  (loop for unit across (application-scene app)
+        do
+           (drop-unit unit)
+           (cleanup unit))
   (pre-exit-hooks))
 
 (defun run-perframe (app)
-  "Runs all of the handlers objects listening for perframe events, if
-those objects are currently part of the scene tree."
+  "Runs all of the handlers objects listening for perframe events if they are in the scene."
   (let ((table (perframe-table (listener app)))
         (time (sdl2:get-ticks)))
     (loop for target being the hash-key of table
@@ -116,8 +117,9 @@ those objects are currently part of the scene tree."
   (gl:clear :color-buffer-bit)
   (gl:enable :blend)
   (gl:blend-func :src-alpha :one-minus-src-alpha )
-  (dolist (unit (reverse (application-scene app)))
-    (render unit))
+  (with-slots (scene) app 
+    (when (plusp (length scene)) 
+      (loop for unit across scene do (render unit))))
   (sdl2:gl-swap-window (application-window app))
   (sleep (frame-wait app)))
 
diff --git a/src/interactive/text.lisp b/src/interactive/text.lisp
index dd99653..d79f7bf 100644
--- a/src/interactive/text.lisp
+++ b/src/interactive/text.lisp
@@ -9,6 +9,7 @@
    (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 
@@ -36,22 +37,34 @@
       (mat:nmscale m (vec:vec scale-x scale-y 1.0))
       m)))
 
+(defvar *text-shader-program* nil)
+
+(defun make-shared-text-gpu-objects ()
+  (unless *text-shader-program*
+    (setf *text-shader-program*
+          (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)))))))
+  (unless (pre-exit-hook-exists-p :text-gpu-resources)
+    (pre-exit-hook
+     :text-gpu-resources
+     (lambda ()
+       (when *text-shader-program*
+         (gl:delete-program *text-shader-program*)
+         (setf *text-shader-program* nil))))))
+
 (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)))))))
+  (with-slots (content newlines font vao elem-count base-width base-height scale-x scale-y) text
+    (make-shared-text-gpu-objects)
     (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
       (setf vao vao%
             elem-count count%))
@@ -67,29 +80,27 @@
                            (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)))
+  (with-slots (vao) text
+    (when vao 
+      (gl:delete-vertex-arrays (list vao)))
+    (setf vao nil)))
 
 (defmethod render ((text text))
-  (with-slots (shader font vao elem-count color) text
-    (gl:use-program shader)
+  (with-slots (font vao elem-count color) text
+    (gl:use-program *text-shader-program*)
     (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")
+     *text-shader-program* 
+     (gl:get-uniform-location *text-shader-program* "TRANSFORM")
      (projected-matrix text))
     (gl:program-uniformi
-     shader
-     (gl:get-uniform-location shader "TEX")
+     *text-shader-program*
+     (gl:get-uniform-location *text-shader-program* "TEX")
      0)
     (gl:program-uniformfv
-     shader
-     (gl:get-uniform-location shader "COLOR")
+     *text-shader-program*
+     (gl:get-uniform-location *text-shader-program* "COLOR")
      color)
     (gl:bind-vertex-array vao)
     (%gl:draw-elements :triangles elem-count :unsigned-int 0)
diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp
index 8a534ed..ab432d5 100644
--- a/src/wheelwork.lisp
+++ b/src/wheelwork.lisp
@@ -10,7 +10,7 @@
 (defmethod add-unit ((unit unit))
   "Adds a unit to the display."
   (assert *application*)
-  (push unit (application-scene *application*))
+  (vector-push-extend unit (application-scene *application*) (1+ (length (application-scene *application*))))
   (setf (unit-in-scene-p unit) t))
 
 (defgeneric drop-unit (unit))
@@ -109,15 +109,21 @@ position.  The list always contains the app itself as the last element."
 (defun unit-under (app x y)
   "Finds the visible unit that contains the point x y, returns it as a
 single elemtn list, or nil if none found"
-  (loop for u in (application-scene app)
-        when (unit-visibly-contains-p u x y)
-          return (list u)))
+  (with-slots (scene) app 
+    (loop
+      for idx from (1- (length scene)) downto 0 
+      for u = (elt scene idx)
+      when (unit-visibly-contains-p u x y)
+        return (list u))))
 
 (defun all-units-under (app x y)
   "Finds all units under the point x y"
-  (loop for u in (application-scene app)
-        when (unit-visibly-contains-p u x y)
-          collect u))
+  (with-slots (scene) app 
+    (loop
+      for idx from (1- (length scene)) downto 0 
+      for u = (elt scene idx)
+      when (unit-visibly-contains-p u x y)
+        collect u)))
 
 (defvar *event-still-bubbling-p* nil
   "Controls whether an event is bubbling")