From 84cfbd5c52d035a166bcb8d8ce9bd566b01e4513 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 18 Jul 2022 10:21:08 -0500 Subject: [add] mouse event bubbling; [example] click-and-drag to 01 --- src/application.lisp | 8 ++++- src/utils.lisp | 2 +- src/wheelwork.lisp | 86 +++++++++++++++++++++++++++++++++++++++------------- 3 files changed, 73 insertions(+), 23 deletions(-) (limited to 'src') diff --git a/src/application.lisp b/src/application.lisp index e9a41dc..ef5e92f 100644 --- a/src/application.lisp +++ b/src/application.lisp @@ -22,7 +22,13 @@ :std t :doc "When T, clicking on a visible object will set the application focus to that object.") - (focus last-motion-target :with :a) + (mouse-button-events-bubble-p + mouse-motion-events-bubble-p + :std nil + :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) (fps :std 30 :doc "Frames Per Second") (frame-wait :r)) (:documentation "The application contains the information and data diff --git a/src/utils.lisp b/src/utils.lisp index 4a35aee..f3dba06 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -118,7 +118,7 @@ the path." (sqrt (+ (* dx dx) (* dy dy))))) (let ((cache - (make-array 100 :adjustable t :initial-element nibbles:))) + (make-array 100 :adjustable t :initial-element nil))) (defun factorial (n) (cond ((zerop n) 1) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 41157e6..31efe14 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -71,8 +71,18 @@ TARGET is FOCUSABLEP" (defun unit-contains-point-p (unit pt) (path-encloses-point-p (get-rect unit) pt)) +(defun mouse-event-targets (app x y &optional bubblep) + "Returns a list of one or more objects found under the x y +position. The list always contains the app itself as the last element." + (nconc (if bubblep + (all-units-under app x y) + (unit-under app x y)) + (list app))) + + (defun unit-under (app x y) - "Finds the visible unit that contains the point 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) @@ -83,9 +93,35 @@ TARGET is FOCUSABLEP" (find-if #'finder (container-units thing) :from-end t))) (unit (when (unit-contains-point-p thing xy) - (return-from unit-under thing))))))) + (return-from unit-under (list thing)))))))) (finder app)))) +(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)) + +(defvar *event-still-bubbling-p* nil + "Controls whether an event is bubbling") + +(defun stop-bubbling () + (setf *event-still-bubbling-p* nil)) + + (defun screen-to-world (x y &optional (app *application*)) "Scales the screen point - the literal pixel position relative to the top corner of the application window - to reflect the @@ -99,33 +135,42 @@ application's scaling factor." Additionally, if the APPLICATION's REFOCUS-ON-MOUSEDOWN-P is T, try to give focus to whatever was clicked." (destructuring-bind (x y) (screen-to-world wx wy) - (let ((target - (or (unit-under app x y) ; if no unit is under the mouse, - app))) ; then target the app itself - (when (and (refocus-on-mousedown-p app) (focusablep target)) - (refocus-on target)) - (when-let (handlers (get-handlers-for target 'mousedown)) - (dolist (handler handlers) - (funcall handler target x y clicks button wx wy)))))) + (let ((candidate-targets + (mouse-event-targets app x y (mouse-button-events-bubble-p app)))) + ;; refocus always occurs on the "top" focasable thing + (when (and (refocus-on-mousedown-p app) + (focusablep (first candidate-targets))) + (refocus-on (first candidate-targets))) + (let ((*event-still-bubbling-p* + (mouse-button-events-bubble-p app))) + (loop for target in candidate-targets + do + (dolist (handler (get-handlers-for target 'mousedown)) + (funcall handler target x y clicks button wx wy)) + while *event-still-bubbling-p*))))) (defun eventloop-mousebuttonup (app wx wy clicks button) (when (should-listen-for-p 'mouseup app) (destructuring-bind (x y) (screen-to-world wx wy) - (when-let* ((target (or (unit-under app x y) - app)) - (handlers (get-handlers-for target 'mouseup))) - (dolist (handler handlers) - (funcall handler target x y clicks button wx wy)))))) + (let ((*event-still-bubbling-p* + (mouse-button-events-bubble-p app))) + (loop for target in (mouse-event-targets app x y (mouse-button-events-bubble-p app)) + do + (dolist (handler (get-handlers-for target 'mouseup)) + (funcall handler target x y clicks button wx wy)) + while *event-still-bubbling-p*))))) (defun eventloop-mousemotion (app wx wy wxrel wyrel state) (when (should-listen-for-p 'mousemotion app) (destructuring-bind (x y) (screen-to-world wx wy) (destructuring-bind (xrel yrel) (screen-to-world wxrel wyrel) - (when-let* ((target (or (unit-under app x y) - app)) - (handlers (get-handlers-for target 'mousemotion))) - (dolist (handler handlers) - (funcall handler target x y xrel yrel state wx wy wxrel wyrel))))))) + (let ((*event-still-bubbling-p* + (mouse-motion-events-bubble-p app))) + (loop for target in (mouse-event-targets app x y (mouse-motion-events-bubble-p app)) + do + (dolist (handler (get-handlers-for target 'mousemotion)) + (funcall handler target x y xrel yrel state wx wy wxrel wyrel)) + while *event-still-bubbling-p*)))))) (defun eventloop-mousewheel (app wx wy dir) (when (should-listen-for-p 'mousewheel app) @@ -134,7 +179,6 @@ give focus to whatever was clicked." (dolist (handler handlers) (funcall handler focus wx wy dir))))) - (defun eventloop (app) (sdl2:with-event-loop (:method :poll) (:mousebuttondown -- cgit v1.2.3