;;;; 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)))))

(defmacro setf-many (&rest places-and-value)
  "e.g. (setf-many a b c 10) would set a b and c to 10"
  (let* ((value-form
           (first (last places-and-value)))
         (value
           (gensym))
         (clauses
           (loop for place in (butlast places-and-value)
                 append `(,place ,value))))
    `(let ((,value ,value-form))
       (setf ,@clauses))))

(defun euclidean-dist (x1 y1 x2 y2)
  (let ((dx (- x2 x1))
        (dy (- y2 y1)))
    (sqrt (+ (* dx dx) (* dy dy)))))

(let ((cache
        (make-array 100 :adjustable t :initial-element nibbles:)))
 (defun factorial (n)
   (cond
     ((zerop n) 1)
     ((< n (length cache))
      (or (aref cache n)
          (setf (aref cache n)
                (* n (factorial (1- n))))))
     ((>= n (length cache))
      (setf cache (adjust-array cache (* 2 (length cache))))
      (factorial n)))))

(defun binomial-coefficient (n k)
  (/ (factorial n)
     (* (factorial k) (factorial (- n k)))))

(defun bezier-lambda (&rest points)
  (let* ((n
           (1- (length points)))
         (bin-coeffs
           (loop for i from 0 to n collect (binomial-coefficient n i))))
    (lambda (a)
      (loop for (x y) in points
            for i from 0
            for bin-coeff in bin-coeffs
            for coeff = (* bin-coeff
                           (expt (- 1 a) (- n i))
                           (expt a i))
            sum (* coeff x) into bx
            sum (* coeff y) into by
            finally (return (list bx by))))))