diff options
| -rw-r--r-- | wheelwork.lisp | 46 |
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))) |