[refactor] point containment, generalized [add] intersections

3 files changed, 45 insertions, 31 deletions

diff --git a/src/core/affine.lisp b/src/core/affine.lisp
index 7cfb805..671c184 100644
--- a/src/core/affine.lisp
+++ b/src/core/affine.lisp
@@ -87,3 +87,6 @@
                       (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/utils.lisp b/src/utils.lisp
index 7024a8d..165f29a 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -25,7 +25,7 @@ order, nil if not."
         (- (vec:vx c) (vec:vx a)))))
 
 
-(defun intersectp (a b c d)
+(defun segments-intersect-p (a b c d)
   "A B C and D are vectors of the sort created by 3d-vectors:vec,
 each representing a 2d point.  Returns T if the line segment between A
 and B intersects the linesegment between C and D, NIL otherwise."
@@ -33,6 +33,33 @@ and B intersects the linesegment between C and D, NIL otherwise."
       (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
            (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))
 
+(defun paths-intersect-p (path-a path-b)
+  "Paths are lists of vectors, each of which represents a 2d point."
+  (loop for (a1 a2 . more-a) on path-a
+        while a2
+          thereis (loop for (b1 b2 . b-more) on path-b
+                        while b2
+                          thereis (segments-intersect-p a1 a2 b1 b2))))
+
+(defun path-contains-point (path pt)
+  "Path is a list of vectors, pt is a single vector."
+  (let* ((bounds
+           (path-bounds path))
+         (corner
+           ;; creating a point guaranteed to be outside of the path
+           (vec:vec (- (getf bounds :left) (getf bounds :width))
+                    (- (getf bounds :bottom) (getf bounds :height))
+                    0.0 1.0)))
+    (loop for (p1 p2 . more) on path
+          while p2
+          when (segments-intersect-p p1 p2 pt corner)
+            count 1 into intersection-count
+          finally
+             (return (oddp intersection-count)))))
+
+(defun path-encloses-p (path other)
+  )
+
 (defun path-bounds (path)
   "Path is a list of vectors representing 2d points. Returns the
 bounds and width and height as a plist of the form 
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