diff options
Diffstat (limited to 'src/wheelwork.lisp')
| -rw-r--r-- | src/wheelwork.lisp | 44 |
1 files changed, 14 insertions, 30 deletions
diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 8efca4e..983ecbe 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -65,39 +65,23 @@ TARGET is FOCUSABLEP" (sdl2:scancode sdl-keysym) (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))) -(defun contains-point-p (unit px py) - (let* ((pt - (vec:vec px py 0.0 1.0)) - (poly - (get-rect unit)) - (bounds - (path-bounds poly)) - (corner - ;; creating a point guaranteed to be outside of poly - (vec:vec (- (getf bounds :left) (getf bounds :width)) - (- (getf bounds :bottom) (getf bounds :height)) - 0.0 1.0))) - (loop for (p1 p2 . more) on poly - while p2 - when (intersectp p1 p2 pt corner) - count 1 into intersection-count - finally - (progn - (return (oddp intersection-count)))))) +(defun unit-contains-point-p (unit pt) + (path-contains-point (get-rect unit) pt)) (defun unit-under (app x y) "Finds the visible unit that contains the point x y." - (labels - ((finder (thing) - (when (unit-visiblep thing) - (etypecase thing - (container - (when (contains-point-p thing x y) - (find-if #'finder (container-units thing) :from-end t))) - (unit - (when (contains-point-p thing x y) - (return-from unit-under thing))))))) - (finder app))) + (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 thing))))))) + (finder app)))) (defun screen-to-world (x y &optional (app *application*)) "Scales the screen point - the literal pixel position relative to |