aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-27 12:07:10 -0500
committerColin Okay <colin@cicadas.surf>2022-07-27 12:07:10 -0500
commit11f8d6dad0078464ccbc29cab57908a0923ca447 (patch)
treeff56d4daf1c2d7cb657587a9fcacdeedfef36307 /src
parent0b743b90752bacf31923171af9af0e5ff1f08095 (diff)
[refactor] represent scene as a vector; [refactor] shared text shader
Diffstat (limited to 'src')
-rw-r--r--src/application.lisp20
-rw-r--r--src/interactive/text.lisp69
-rw-r--r--src/wheelwork.lisp20
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")