[refactor] point containment, generalized [add] intersections

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