;;;; utils.lisp (in-package #:wheelwork) (define-symbol-macro +pi-over-180+ 0.017453292519943295d0) (defun radians (degrees) "Converse DEGREES to radians" (* degrees +pi-over-180+)) (defun safe-slot (object slot &optional default) (if-let (val (and (slot-exists-p object slot) (slot-boundp object slot) (slot-value object slot))) val default)) (defun counterclockwisep (a b c) "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))))) (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." (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) "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 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 ;; 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)))) (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 (:top N :left N :right N :bottom N :width N :height N) This is the smallest UNROTATED RECTANGLE that contains the points in the path." (loop with max-x = nil 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) when (or (null max-x) (< max-x x)) do (setf max-x x) when (or (null min-x) (< x min-x)) do (setf min-x x) when (or (null max-y) (< max-y y)) do (setf max-y y) when (or (null min-y) (< y min-y)) do (setf min-y y) finally (return (list :top max-y :left min-x :right max-x :bottom min-y :width (- max-x min-x) :height (- max-y min-y)))))