[refactor] contains-point-p to eliminate edge cases

1 files changed, 42 insertions, 6 deletions

diff --git a/wheelwork.lisp b/wheelwork.lisp
index 7fadb57..a9d4a3d 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -463,6 +463,8 @@ TARGET is FOCUSABLEP"
                (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
 
 (defun get-rect (unit)
+  "Returns a list of vectors representing the path of the smallest
+rectangle that encloses the unit. The rectangle is scaled and rotated."
   (with-accessors ((x unit-x) (y unit-y) (w unit-width) (h unit-height) (r unit-rotation)) unit
     (let ((m
             (mat:meye 4))
@@ -490,13 +492,47 @@ TARGET is FOCUSABLEP"
       (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
            (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))
 
+(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 
+
+(:top N :left N :right N :bottom N :width N :height N)
+
+This is the smallest UNROTATED RECTANGLE that contains the points in
+the path."
+  (loop
+    with max-x = nil
+    and max-y = nil
+    and min-x = nil
+    and min-y = nil
+    for vec in path
+    for x = (vec:vx vec)
+    for y = (vec:vy vec)
+    when (or (null max-x) (< max-x x))
+      do (setf max-x x)
+    when (or (null min-x) (< x min-x))
+      do (setf min-x x)
+    when (or (null max-y) (< max-y y))
+      do (setf max-y y)
+    when (or (null min-y) (< y min-y))
+      do (setf min-y y)
+    finally
+       (return (list :top max-y :left min-x :right max-x :bottom min-y
+                     :width (- max-x min-x)
+                     :height (- max-y min-y)))))
+
 (defun contains-point-p (unit px py)
-  (let ((pt
-          (vec:vec px py 0.0 1.0))
-        (corner
-          (vec:vec -1.0 -1.0 0.0 1.0))
-        (poly
-          (get-rect unit)))
+  (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)