diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-07 08:26:55 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-07 08:26:55 -0500 |
commit | 40d48067429300bedfc93f6d7f6357927d6d90cb (patch) | |
tree | d7df16bad67b7a52af599df1722dcc1e816a36fa /src | |
parent | 208eb74ed6af4e016f34704bf7c7de547e8b1612 (diff) |
[refactor] paths points and enclosure [add] path encloses path test
Diffstat (limited to 'src')
-rw-r--r-- | src/utils.lisp | 20 | ||||
-rw-r--r-- | src/wheelwork.lisp | 2 |
2 files changed, 18 insertions, 4 deletions
diff --git a/src/utils.lisp b/src/utils.lisp index 165f29a..bcb4cb2 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -41,8 +41,14 @@ and B intersects the linesegment between C and D, NIL otherwise." while b2 thereis (segments-intersect-p a1 a2 b1 b2)))) -(defun path-contains-point (path pt) + +(defun closed-path-p (path) + (equalp (first path) + (first (last path)))) + +(defun path-encloses-point-p (path pt) "Path is a list of vectors, pt is a single vector." + (assert (closed-path-p path) () "Enclosing path must be a closed path.") (let* ((bounds (path-bounds path)) (corner @@ -57,8 +63,16 @@ and B intersects the linesegment between C and D, NIL otherwise." finally (return (oddp intersection-count))))) -(defun path-encloses-p (path other) - ) + + +(defun path-encloses-path-p (path-a path-b) + "T if path-b is totally contained in path-a and does not intersect path-a" + (assert (closed-path-p path-a) () "Enclosing path must be a closed path.") + (and + (loop for (p1 p2 . more) on path-b + while p2 + always (path-encloses-point-p path-a p1)) + (not (paths-intersect-p path-a path-b)))) (defun path-bounds (path) "Path is a list of vectors representing 2d points. Returns the diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 983ecbe..8b1e534 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -66,7 +66,7 @@ TARGET is FOCUSABLEP" (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))) (defun unit-contains-point-p (unit pt) - (path-contains-point (get-rect unit) pt)) + (path-encloses-point-p (get-rect unit) pt)) (defun unit-under (app x y) "Finds the visible unit that contains the point x y." |