diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-22 11:58:16 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-22 11:58:16 -0500 |
commit | 00841605110612f6e7f3bbfc054ceff980bf25be (patch) | |
tree | 1f16b86d5c555eea22e60cb2d36f88682bd9023b /src | |
parent | 6d9b8b48423dba99ecdba004f260c30e6717b6a6 (diff) |
[version] [refactor] [redesign] removed containers
Diffstat (limited to 'src')
-rw-r--r-- | src/application.lisp | 17 | ||||
-rw-r--r-- | src/core/affine.lisp | 92 | ||||
-rw-r--r-- | src/core/container.lisp | 81 | ||||
-rw-r--r-- | src/core/unit.lisp | 116 | ||||
-rw-r--r-- | src/events/event-handler.lisp | 65 | ||||
-rw-r--r-- | src/interactive/canvas.lisp | 2 | ||||
-rw-r--r-- | src/interactive/frameset.lisp | 2 | ||||
-rw-r--r-- | src/interactive/image.lisp | 2 | ||||
-rw-r--r-- | src/interactive/interactive.lisp | 15 | ||||
-rw-r--r-- | src/interactive/sprite.lisp | 2 | ||||
-rw-r--r-- | src/interactive/text.lisp | 2 | ||||
-rw-r--r-- | src/package.lisp | 8 | ||||
-rw-r--r-- | src/protocol.lisp | 6 | ||||
-rw-r--r-- | src/region.lisp | 6 | ||||
-rw-r--r-- | src/wheelwork.lisp | 55 |
15 files changed, 145 insertions, 326 deletions
diff --git a/src/application.lisp b/src/application.lisp index ef5e92f..ea37525 100644 --- a/src/application.lisp +++ b/src/application.lisp @@ -2,8 +2,7 @@ (in-package #:wheelwork) - -(defclass/std application (container interactive) +(defclass/std application (region interactive) ((title :with :ri :std "Wheelwork App") (asset-root :ri :std #P"./" :doc "Directory under which assets are stored.") (asset-classifiers @@ -28,7 +27,7 @@ :doc "determines whether the search for event handlers stops at the first visible unit under the xy position of the mouse or not. ") - (focus last-motion-target :with :a) + (scene focus last-motion-target :with :a) (fps :std 30 :doc "Frames Per Second") (frame-wait :r)) (:documentation "The application contains the information and data @@ -56,8 +55,6 @@ top (/ height scale) right (/ width scale)))) - - (defun fire-blur-event-on (thing) (when-let (blur-handlers (and thing (get-handlers-for thing 'blur))) (dolist (handler blur-handlers) @@ -97,7 +94,9 @@ (let ((listener (listener app))) (dolist (table +listener-table-slot-names+) (setf (slot-value listener table) (make-hash-table :synchronized t)))) - (call-next-method) + (dolist (unit (application-scene app)) + (drop-unit unit) + (cleanup unit)) (trivial-garbage:gc :full t)) (defun run-perframe (app) @@ -108,7 +107,7 @@ those objects are currently part of the scene tree." (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)) + when (or (eq app target) (unit-in-scene-p target)) do (loop for handler in handlers do (funcall handler target time))))) (defmethod render ((app application)) @@ -118,6 +117,8 @@ 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 ) - (call-next-method) + (dolist (unit (application-scene app)) + (render unit)) (sdl2:gl-swap-window (application-window app)) (sleep (frame-wait app))) + diff --git a/src/core/affine.lisp b/src/core/affine.lisp deleted file mode 100644 index 671c184..0000000 --- a/src/core/affine.lisp +++ /dev/null @@ -1,92 +0,0 @@ -;;;; affine.lisp - -(in-package #:wheelwork) - -(defclass/std affine (unit) - ((cached-model cached-projected-matrix cached-application cached-rectangle :a) - (base-width base-height :r :std 1.0 :doc "Determined by content.") - (scale-x scale-y :std 1.0) - (rotation x y :std 0.0))) - -(defmethod (setf closer-mop:slot-value-using-class) :after - (newval class (affine affine) slot) - (case (closer-mop:slot-definition-name slot) - ((x y scale-x scale-y rotation) - (setf (cached-model affine) nil - (cached-projected-matrix affine) nil - (cached-rectangle affine) nil)))) - -(defun scale-by (affine amount) - (with-accessors ((sx scale-x) (sy scale-y)) affine - (setf sx (* amount sx) - sy (* amount sy)))) - -(defun set-width-preserve-aspect (affine new-width) - (scale-by affine (/ new-width (width affine)))) - -(defun set-height-preserve-aspect (affine new-height) - (scale-by affine (/ new-height (height affine) ))) - -(defmethod width ((affine affine)) - (with-slots (scale-x base-width) affine - (* scale-x base-width))) - -(defmethod height ((affine affine)) - (with-slots (scale-y base-height) affine - (* scale-y base-height))) - -(defmethod (setf width) (newval (affine affine)) - (with-slots (scale-x base-width) affine - (setf scale-x (coerce (/ newval base-width) 'single-float)))) - -(defmethod (setf height) (newval (affine affine)) - (with-slots (scale-y base-height) affine - (setf scale-y (coerce (/ newval base-height) 'single-float)))) - -(defmethod model-matrix :around ((u affine)) - (or (cached-model u) - (setf (cached-model u) - (call-next-method)))) - -(defmethod model-matrix ((u affine)) - (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)) - - -(defun projected-matrix (affine) - (or (cached-projected-matrix affine) - (setf (cached-projected-matrix affine) - (mat:marr (mat:m* (application-projection (app-of-unit affine)) - (model-matrix affine)))))) - -(defmethod get-rect ((affine-unit affine)) - (or (cached-rectangle affine-unit) - (setf (cached-rectangle affine-unit) - (with-accessors ((x x) (y y) (w width) (h height) (r rotation)) affine-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 units-intersect-p (au1 au2) - "Returns T if the two units AU1 an AU2 intersect. Both must implement GET-RECT." - (paths-intersect-p (get-rect au1) (get-rect au2))) diff --git a/src/core/container.lisp b/src/core/container.lisp deleted file mode 100644 index a9e6caf..0000000 --- a/src/core/container.lisp +++ /dev/null @@ -1,81 +0,0 @@ -;;;; units/container.lisp - -(in-package #:wheelwork) - - -(defclass/std container (unit) - ((units :with :a) - (cached-rect :with) - (left right top bottom :with :std 0 :doc "container's box coordinates.")) - (: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 (setf closer-mop:slot-value-using-class) - (newval class (container container) slot) - (case (closer-mop:slot-definition-name slot) - ((left right top bottom) - (setf (container-cached-rect container) nil)))) - -(defmethod get-rect ((container container)) - (with-slots (cached-rect left right top bottom) container - (or cached-rect - (setf cached-rect - (list (vec:vec left bottom 0 1.0) - (vec:vec left top 0 1.0) - (vec:vec right top 0 1.0) - (vec:vec right bottom 0 1.0) - (vec:vec left bottom 0 1.0)))))) - - -(defun point-in-contanier-box-p (c x y) - "Returns T if the ponit X Y is inside the bounds of the container." - (and (<= (container-left c) x (container-right c)) - (<= (container-bottom c) y (container-top c)))) - -(defun visible-in-container-p (unit) - "Returns T if UNIT is VISIBLEP, if it is inside a CONTAINER, if any - of the corners of its bounding rectangle are inside that CONTAINER. - - UNIT must implement the affine protocol." - (when (unit-visiblep unit) - (when-let ((container - (unit-container unit))) - (loop for pt in (get-rect unit) - thereis (point-in-contanier-box-p container (vec:vx pt) (vec:vy pt)))))) - -(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). Also removes 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))) - -(defmethod render ((container container)) - (let ((current - (gl:get* :scissor-box)) - (scale - (application-scale - (app-of-unit container)))) - (with-slots (left right top bottom) container - (gl:scissor (* left scale) (* scale bottom) (* scale (- right left)) (* scale (- top bottom))) - (unwind-protect - (dolist (u (reverse (container-units container))) - (if (visible-in-container-p u) - (render u))) - (gl:scissor (aref current 0) (aref current 1) (aref current 2) (aref current 3)))))) diff --git a/src/core/unit.lisp b/src/core/unit.lisp index e93ba56..e56c01f 100644 --- a/src/core/unit.lisp +++ b/src/core/unit.lisp @@ -1,33 +1,107 @@ -;;;; units/unit.lisp +;;;; unit.lisp (in-package #:wheelwork) (defclass/std unit () - ((cached-application :a) - (container :with :a) - (visiblep :with :std t))) + ((cached-model cached-projected-matrix cached-rectangle :a) + (visiblep :with :std t) + (in-scene-p :with :a :std nil) + (region :with :std *application* + :doc "The screen region where the unit will be visible.") + (base-width base-height :r :std 1.0 :doc "Determined by content.") + (scale-x scale-y :std 1.0) + (rotation x y :std 0.0))) + +(defmethod render :around ((unit unit)) + (when (unit-visiblep unit) + (let ((sb + (gl:get* :scissor-box)) + (scale + (application-scale *application*))) + (with-slots (left right top bottom) (unit-region unit) + (gl:scissor (* left scale) (* bottom scale) (* scale (- right left)) (* scale (- top bottom))) + (call-next-method)) + (gl:scissor (aref sb 0) (aref sb 1) (aref sb 2) (aref sb 3))))) (defmethod (setf closer-mop:slot-value-using-class) :after (newval class (unit unit) slot) (case (closer-mop:slot-definition-name slot) - (container - (setf (cached-application unit) nil)))) + ((x y scale-x scale-y rotation) + (setf (cached-model unit) nil + (cached-projected-matrix unit) nil + (cached-rectangle unit) nil)))) +(defun scale-by (unit amount) + (with-accessors ((sx scale-x) (sy scale-y)) unit + (setf sx (* amount sx) + sy (* amount sy)))) -(defun app-of-unit (unit) - "Returns the APPLICATION instance, if any, of which this UNIT is a -part. NIL indicates that the unit has not been added to any container -in this application." - (or (cached-application unit) - (setf (cached-application unit) - (labels ((rec (u) - (etypecase u - (application u) - (unit (rec (unit-container u))) - (nil nil)))) - (rec unit))))) +(defun set-width-preserve-aspect (unit new-width) + (scale-by unit (/ new-width (width unit)))) +(defun set-height-preserve-aspect (unit new-height) + (scale-by unit (/ new-height (height unit) ))) -(defmethod render :around ((unit unit)) - (when (unit-visiblep unit) - (call-next-method))) +(defmethod width ((unit unit)) + (with-slots (scale-x base-width) unit + (* scale-x base-width))) + +(defmethod height ((unit unit)) + (with-slots (scale-y base-height) unit + (* scale-y base-height))) + +(defmethod (setf width) (newval (unit unit)) + (with-slots (scale-x base-width) unit + (setf scale-x (coerce (/ newval base-width) 'single-float)))) + +(defmethod (setf height) (newval (unit unit)) + (with-slots (scale-y base-height) unit + (setf scale-y (coerce (/ newval base-height) 'single-float)))) + +(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)) + + +(defun projected-matrix (unit) + (or (cached-projected-matrix unit) + (setf (cached-projected-matrix unit) + (mat:marr (mat:m* (application-projection *application*) + (model-matrix unit)))))) + +(defmethod get-rect ((unit unit)) + (or (cached-rectangle unit) + (setf (cached-rectangle unit) + (with-accessors ((x x) (y y) (w width) (h height) (r 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 units-intersect-p (au1 au2) + "Returns T if the two units AU1 an AU2 intersect. Both must implement GET-RECT." + (paths-intersect-p (get-rect au1) (get-rect au2))) diff --git a/src/events/event-handler.lisp b/src/events/event-handler.lisp index a7f1b1b..9d48aea 100644 --- a/src/events/event-handler.lisp +++ b/src/events/event-handler.lisp @@ -299,68 +299,3 @@ fires when the FOCUS slot of the current APPLICATION instance is changed. (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. - - All variable arguments supplied to this handler form are - optional. You may supply your own variables to use in your BODY or - you may just refer to the defaults - they will be interned in the - appropriate package. - -" - `(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 (target 'target) (container 'container)) &body body) - "Creates a handler for BEFORE-ADDED events, which fire before a unit - TARGET is added to CONTAINER. - - All variable arguments supplied to this handler form are - optional. You may supply your own variables to use in your BODY or - you may just refer to the defaults - they will be interned in the - appropriate package. -" - `(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 (target 'target) (container 'container)) &body body) - "Creates a handler for AFTER-ADDED events, which fire after a unit - is added to a container. - - All variable arguments supplied to this handler form are - optional. You may supply your own variables to use in your BODY or - you may just refer to the defaults - they will be interned in the - appropriate package. -" - `(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/interactive/canvas.lisp b/src/interactive/canvas.lisp index 7f24d89..aef8ebb 100644 --- a/src/interactive/canvas.lisp +++ b/src/interactive/canvas.lisp @@ -151,7 +151,7 @@ e.g., drawing a line in a particular color." (gl:bind-buffer :array-buffer 0) (gl:bind-vertex-array 0)) -(defclass/std canvas (affine interactive pixels) +(defclass/std canvas (unit interactive pixels) ((fbo :with :r :doc "framebuffer object for use in off-screen-rendering of this canvas to a texture") (texture :with :a :doc "texture instance"))) diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp index 3ffbc18..25812f0 100644 --- a/src/interactive/frameset.lisp +++ b/src/interactive/frameset.lisp @@ -37,7 +37,7 @@ count (length sequence)) (loop for frame across frames when frame - do (setf (unit-container frame) fs)))) + do (setf (unit-in-scene-p frame) fs)))) (defun current-frame-unit (fs) "Returns the unit be currently displaayed as the animation's frame." diff --git a/src/interactive/image.lisp b/src/interactive/image.lisp index 7c84df3..0089f57 100644 --- a/src/interactive/image.lisp +++ b/src/interactive/image.lisp @@ -21,7 +21,7 @@ count and destroys shader-program if necessary." (gl:delete-program *image-shader-program*) (setf *image-shader-program* nil)))) -(defclass/std image (affine interactive) +(defclass/std image (unit interactive) ((texture :ri :std (error "A image requires a texture.")))) (defmethod initialize-instance :after ((image image) &key) diff --git a/src/interactive/interactive.lisp b/src/interactive/interactive.lisp index 83910c7..6152c3e 100644 --- a/src/interactive/interactive.lisp +++ b/src/interactive/interactive.lisp @@ -42,18 +42,3 @@ ON-* Macros." (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/interactive/sprite.lisp b/src/interactive/sprite.lisp index 22c6be4..68f8a8d 100644 --- a/src/interactive/sprite.lisp +++ b/src/interactive/sprite.lisp @@ -14,7 +14,7 @@ (defmethod initialize-instance :after ((sprite sprite) &key) (with-slots (framesets frameset-key) sprite (loop for (name fs . more) on framesets by #'cddr - do (setf (unit-container fs) sprite)) + do (setf (unit-in-scene-p fs) sprite)) (unless frameset-key (setf frameset-key (first framesets))))) diff --git a/src/interactive/text.lisp b/src/interactive/text.lisp index a7c0582..dd99653 100644 --- a/src/interactive/text.lisp +++ b/src/interactive/text.lisp @@ -2,7 +2,7 @@ (in-package #:wheelwork) -(defclass/std text (affine interactive) +(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)) diff --git a/src/package.lisp b/src/package.lisp index 8b9f07a..a93c8fc 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -42,12 +42,6 @@ ;; Display Tree Managmennt #:add-unit - #:container - #:container-bottom - #:container-left - #:container-right - #:container-top - #:container-units #:drop-unit ;; Event Handler API @@ -82,8 +76,8 @@ #:perframe ;; Generic and APIs - #:unit-container #:unit-visbilep + #:unit-in-scene- ;; Specific Unit Classes and APIs #:image diff --git a/src/protocol.lisp b/src/protocol.lisp index 002aad6..2bccb86 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -17,12 +17,6 @@ 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 render (thing) (:documentation "Renders thing for visual display.")) diff --git a/src/region.lisp b/src/region.lisp new file mode 100644 index 0000000..2355db6 --- /dev/null +++ b/src/region.lisp @@ -0,0 +1,6 @@ +;;;; region.lisp + +(in-package :wheelwork) + +(defclass/std region () + ((left bottom top right :with :std 0))) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index db49e03..4a20553 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -5,6 +5,17 @@ (defvar *application* nil "current application") +(defun add-unit (unit) + (assert *application*) + (push unit (application-scene *application*)) + (setf (unit-in-scene-p unit) t)) + +(defun drop-unit (unit) + (assert *application*) + (setf (application-scene *application*) + (delete unit (application-scene *application*))) + (setf (unit-in-scene-p unit) nil)) + (defun start (app &key (x :centered) (y :centered)) (sdl2:with-init (:everything) (sdl2:gl-set-attr :context-major-version 3) @@ -67,6 +78,12 @@ TARGET is FOCUSABLEP" (sdl2:scancode sdl-keysym) (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))) + +(defun region-contains-point-p (region pt) + (with-slots (left right bottom top) region + (and (<= left (vec:vx pt) right) + (<= bottom (vec:vy pt) top)))) + (defun unit-contains-point-p (unit pt) (path-encloses-point-p (get-rect unit) pt)) @@ -79,40 +96,26 @@ position. The list always contains the app itself as the last element." (list app))) +(defun unit-visibly-contains-p (unit pt) + (and (unit-visiblep unit) + (region-contains-point-p (unit-region unit) pt) + (unit-contains-point-p unit pt))) + (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" (let ((xy (vec:vec x y 0.0 1.0))) - (labels - ((finder (thing) - (when (unit-visiblep thing) - (etypecase thing - (container - (when (unit-contains-point-p thing xy) - (find-if #'finder (container-units thing) :from-end t))) - (unit - (when (unit-contains-point-p thing xy) - (return-from unit-under (list thing)))))))) - (finder app)))) + (loop for u in (application-scene app) + when (unit-visibly-contains-p u xy) + return (list u)))) (defun all-units-under (app x y) "Finds all units under the point x y" (let ((xy - (vec:vec x y 0.0 1.0)) - (units - nil)) - (labels - ((finder (thing) - (when (unit-visiblep thing) - (etypecase thing - (container - (when (unit-contains-point-p thing xy) - (mapc #'finder (container-units thing)))) - (unit - (when (unit-contains-point-p thing xy) - (push thing units))))))) - (finder app)) - units)) + (vec:vec x y 0.0 1.0))) + (loop for u in (application-scene app) + when (unit-visibly-contains-p u xy) + collect u))) (defvar *event-still-bubbling-p* nil "Controls whether an event is bubbling") |