diff options
| -rw-r--r-- | examples/01-click-and-drag-image.lisp | 2 | ||||
| -rw-r--r-- | examples/09-ghoulspree.lisp | 12 | ||||
| -rw-r--r-- | src/application.lisp | 20 | ||||
| -rw-r--r-- | src/interactive/text.lisp | 69 | ||||
| -rw-r--r-- | src/wheelwork.lisp | 20 | ||||
| -rw-r--r-- | wheelwork-examples.asd | 2 |
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") |