[modify] contains-point-p to factor in rotation;

1 files changed, 42 insertions, 4 deletions

diff --git a/wheelwork.lisp b/wheelwork.lisp
index fe6914e..cdfec40 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -454,10 +454,48 @@ TARGET is FOCUSABLEP"
                (sdl2:scancode sdl-keysym)
                (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))))
 
+(defun get-rect (unit)
+  (with-accessors ((x unit-x) (y unit-y) (w unit-width) (h unit-height) (r unit-rotation)) unit
+    (let ((m
+            (mat:meye 4))
+          (tr
+            (vec:vec (+ x (* 0.5 w)) (+ y (* 0.5 h)) 0.0)))
+      (mat:nmtranslate m tr)
+      (mat:nmrotate  m vec:+vz+ r)
+      (mat:nmtranslate m (vec:v* -1.0 tr))
+
+      (list (mat:m* m (vec:vec x y 0.0 1.0))
+            (mat:m* m (vec:vec x (+ y h) 0.0 1.0))
+            (mat:m* m (vec:vec (+ x w) (+ y h) 0.0 1.0))
+            (mat:m* m (vec:vec (+ x w) y 0.0 1.0))
+            (mat:m* m (vec:vec x y 0.0 1.0))))))
+
+(defun counterclockwisep (a b c)
+  (> (* (- (vec:vx b) (vec:vx a))
+        (- (vec:vy c) (vec:vy a)))
+     (* (- (vec:vy b) (vec:vy a))
+        (- (vec:vx c) (vec:vx a)))))
+
+
+(defun intersectp (a b c d)
+  (or (vec:v= a c) (vec:v= a d) (vec:v= b c) (vec:v= b d)
+      (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
+           (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))
+
 (defun contains-point-p (unit px py)
-  (with-accessors ((x unit-x) (y unit-y) (width unit-width) (height unit-height)) unit
-    (and (<= x px (+ x width))
-         (<= y py (+ y height)))))
+  (let ((pt
+          (vec:vec px py 0.0 1.0))
+        (corner
+          (vec:vec 0.0 0.0 0.0 1.0))
+        (poly
+          (get-rect unit)))
+    (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-under (app x y)
   (labels
@@ -466,7 +504,7 @@ TARGET is FOCUSABLEP"
            (container
             (find-if #'finder (container-units thing) :from-end t))
            (unit
-            (when  (contains-point-p thing x y)
+            (when (contains-point-p thing x y)
               (return-from unit-under thing))))))
     (finder app)))