diff options
Diffstat (limited to 'src/wheelwork.lisp')
| -rw-r--r-- | src/wheelwork.lisp | 55 |
1 files changed, 29 insertions, 26 deletions
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") |