diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/core/affine.lisp | 3 | ||||
| -rw-r--r-- | src/utils.lisp | 29 | ||||
| -rw-r--r-- | src/wheelwork.lisp | 44 |
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 |