aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/utils.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/utils.lisp')
-rw-r--r--src/utils.lisp89
1 files changed, 47 insertions, 42 deletions
diff --git a/src/utils.lisp b/src/utils.lisp
index 4ace1b8..7357325 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -2,11 +2,10 @@
(in-package #:wheelwork)
-(define-symbol-macro +pi-over-180+ 0.017453292519943295d0)
-
+(declaim (inline radians counterclockwisep points-equal-p))
(defun radians (degrees)
"Converse DEGREES to radians"
- (* degrees +pi-over-180+))
+ (* degrees 0.017453292519943295d0))
(defun safe-slot (object slot &optional default)
(if-let (val (and (slot-exists-p object slot)
@@ -15,61 +14,69 @@
val
default))
-(defun counterclockwisep (a b c)
+(defun counterclockwisep (ax ay bx by cx cy)
"A B and C are vectors created by 3d-vectors:vec, each representing
a 2d point. Returns T if the three are supplied in counterclockwise
order, nil if not."
- (> (* (- (vec:vx b) (vec:vx a))
- (- (vec:vy c) (vec:vy a)))
- (* (- (vec:vy b) (vec:vy a))
- (- (vec:vx c) (vec:vx a)))))
+ (> (* (- bx ax)
+ (- cy ay))
+ (* (- by ay)
+ (- cx ax))))
+(defun points-equal-p (x1 y1 x2 y2)
+ (and (= x1 x2)) (= y1 y2))
-(defun segments-intersect-p (a b c d)
+(defun segments-intersect-p (ax ay bx by cx cy dx dy)
"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."
- (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 paths-intersect-p (path-a path-b)
+ (or (points-equal-p ax ay cx cy)
+ (points-equal-p ax ay dx dy)
+ (points-equal-p bx by cx cy)
+ (points-equal-p bx by dx dy)
+ (and (not (eq (counterclockwisep ax ay cx cy dx dy)
+ (counterclockwisep bx by cx cy dx dy)))
+ (not (eq (counterclockwisep ax ay bx by cx cy)
+ (counterclockwisep ax ay bx by dx dy))))))
+
+(defun paths-intersect-p (path1 path2)
"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))))
+ (loop for ((ax ay) (bx by) . more1) on path1
+ while bx
+ thereis (loop for ((cx cy) (dx dy) . more2) on path2
+ while dx
+ thereis (segments-intersect-p ax ay bx by cx cy dx dy))))
(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."
+(defun path-encloses-point-p (path px py)
+ "Path is a list of points, pt is a single vector."
(assert (closed-path-p path) () "Enclosing path must be a closed path.")
(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-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))))
+ (list (- (getf bounds :left) (getf bounds :width))
+ (- (getf bounds :bottom) (getf bounds :height)))))
+ (loop
+ with (cx cy) = corner
+ for ((ax ay) (bx by) . more) on path
+ while bx
+ when (segments-intersect-p ax ay bx by px py cx cy)
+ count 1 into intersection-count
+ finally
+ (return (oddp intersection-count)))))
+
+;; (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
@@ -84,9 +91,7 @@ the path."
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)
+ for (x y) in path
when (or (null max-x) (< max-x x))
do (setf max-x x)
when (or (null min-x) (< x min-x))