aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--examples/01-click-and-drag-image.lisp2
-rw-r--r--examples/09-ghoulspree.lisp12
-rw-r--r--src/application.lisp20
-rw-r--r--src/interactive/text.lisp69
-rw-r--r--src/wheelwork.lisp20
-rw-r--r--wheelwork-examples.asd2
6 files changed, 77 insertions, 48 deletions
diff --git a/examples/01-click-and-drag-image.lisp b/examples/01-click-and-drag-image.lisp
index e895d24..da6a12f 100644
--- a/examples/01-click-and-drag-image.lisp
+++ b/examples/01-click-and-drag-image.lisp
@@ -11,7 +11,7 @@
(ww::defhandler dragging-unit
(ww::on-mousemotion (app x y)
(let ((unit
- (first (ww::application-scene app))))
+ (elt (ww::application-scene app) 0)))
(setf (ww:x unit) x
(ww:y unit) y))))
diff --git a/examples/09-ghoulspree.lisp b/examples/09-ghoulspree.lisp
index b3c0106..a92299a 100644
--- a/examples/09-ghoulspree.lisp
+++ b/examples/09-ghoulspree.lisp
@@ -58,6 +58,16 @@ on which boundary VAL is outside of."
`(loop for (,a . ,more-a) on ,ls do
(loop for ,b in ,more-a do (progn ,@body)) )))
+(defmacro with-pairs ((a b) vector &rest body)
+ (alexandria:with-gensyms (idxa idxb vec)
+ `(loop
+ with ,vec = ,vector
+ for ,idxa from 0 to (- (length ,vec) 2)
+ for ,a = (aref ,vec ,idxa) do
+ (loop for ,idxb from (1+ ,idxa) to (1- (length ,vec))
+ for ,b = (aref ,vec ,idxb) do
+ (progn ,@body)))))
+
(defun handle-collision (g1 g2 &optional (friction 0.99))
(with-slots ((dx1 dx) (dy1 dy) (dr1 dr)) g1
(with-slots ((dx2 dx) (dy2 dy) (dr2 dr)) g2
@@ -93,7 +103,7 @@ on which boundary VAL is outside of."
(gravity-on-p app))
(accelleration
(/ 9.8 (ww:fps app))))
- (loop for ghoul in (ww::application-scene app)
+ (loop for ghoul across (ww::application-scene app)
do (advance-pos ghoul)
when gravity
do (apply-gravity-to ghoul accelleration)
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")
diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd
index 75d7ef4..81fb76d 100644
--- a/wheelwork-examples.asd
+++ b/wheelwork-examples.asd
@@ -7,7 +7,7 @@
:depends-on (#:wheelwork #:wheelwork-gui)
:pathname "examples/"
:components ((:file "01-click-and-drag-image")
- (:file "02-moving-bitmp")
+ (:file "02-image-transforms-and-events")
(:file "03-font-render")
(:file "04-a-button")
(:file "05-frameset-animation")