;;; grid-geometry.lisp

(in-package :wheelwork )

(defmacro with-grid-line
    ((x y) (start-x start-y) (end-x end-y) &body body)
  "Execute BODY for X and Y assigned to integer values in a line
connecting the integer point START-X , START-Y and END-X, END-Y. "
  (with-gensyms (sx sy ex ey distance step progress xdiff ydiff)
    `(loop
       :with ,sx := ,start-x
       :with ,sy := ,start-y
       :with ,ex := ,end-x
       :with ,ey := ,end-y
       :with ,xdiff := (- ,ex ,sx)
       :with ,ydiff := (- ,ey, sy)
       :with ,distance := (max (abs ,xdiff) (abs ,ydiff))
       :for ,step :from 0 :to ,distance
       :for ,progress := (if (zerop ,distance) 0.0 (/ ,step ,distance))
       :for ,x := (round (+ ,start-x (* ,progress ,xdiff)))
       :for ,y := (round (+ ,start-y (* ,progress ,ydiff)))
       :do (progn ,@body))))

(defun grid-bbox-for (poly)
  "POLY is a list of pairs of xy coordinates. Return a pair of
pairs, ((min-x min-y) (max-x max-y)), representing the bottom left and
top right corners of the bounding box for POLY "
  (loop :for (x y) :in poly
        :minimizing x :into x-min
        :maximizing x :into x-max
        :minimizing y :into y-min
        :maximizing y :into y-max
        :finally (return (list (list x-min y-min)
                               (list x-max y-max)))))

(defun grid-counterclockwisep (a b c)
  (> (* (- (first b) (first a))
        (- (second c) (second a)))
     (* (- (second b) (second a))
        (- (first c) (first a)))))

(defun grid-segments-intersect-p (a b c d)
  (or (equalp a c) (equalp a d) (equalp b c) (equalp b d)
      (and (not (eq (grid-counterclockwisep a c d) (grid-counterclockwisep b c d)))
           (not (eq (grid-counterclockwisep a b c) (grid-counterclockwisep a b d))))))

(defun grid-poly-contains-p (poly x y)
  (let ((pt
          (list x y))
        (corner
          (list -1 x))) 
    (loop :for (p1 p2 . more) :on poly
          :while p2
          :when (grid-segments-intersect-p p1 p2 pt corner)
            :count 1 :into intersection-count
          :finally
             (progn
               (when (grid-segments-intersect-p p1 (first poly) pt corner)
                 (incf intersection-count))
               (return (oddp intersection-count))))))

(defmacro with-grid-path
    ((x y) (path &key autoclosep interiorp) &body body)
  "Interiorp assumes autoclosep."
  (with-gensyms (points x1 y1 x2 y2 more)
    (let* ((autoclose-clause
             (when (or interiorp autoclosep)
               `(destructuring-bind (,x2 ,y2) (first ,points)
                  (with-grid-line (,x ,y) (,x2 ,y2) (,x1 ,y1)
                    ,@body))))
           (interior-clause
             (when interiorp
               `(destructuring-bind ((,x1 ,y1) (,x2 ,y2)) (grid-bbox-for ,points)
                  (loop :for ,x :from ,x1 :to ,x2 :do
                    (loop :for ,y :from ,y1 :to ,y2
                          :when (grid-poly-contains-p ,points ,x ,y)
                            :do ,@body)))))) 
      `(let ((,points ,path))
         (loop
           :for ((,x1 ,y1) (,x2 ,y2) . ,more) :on ,points
           :while ,x2 :do
             (with-grid-line (,x ,y) (,x1 ,y1) (,x2 ,y2)
               ,@body)
           :finally (progn
                      ,autoclose-clause
                      ,interior-clause))))))

(defmacro with-grid-rect ((x y) (left bottom right top) &body body)
  `(loop :for ,x :from (floor ,left) :to (floor ,right) :do
    (loop :for ,y :from (floor ,bottom) :to (floor ,top) :do ,@body)))

(defmacro with-grid-circle
    ((x y) (cx cy radius &key interiorp) &body body)
  (with-gensyms (rad sx sy)
    (let ((comparator
            (if interiorp '>= '=))) 
      `(let ((,sx ,cx) (,sy ,cy) (,rad ,radius)) 
         (loop :for ,x :from (- ,sx ,rad) :to (+ ,sx ,rad) :do
           (loop :for ,y :from (- ,sy ,rad) :to (+ ,sy ,rad) :do
             (when (,comparator ,rad (round (euclidean-dist ,x ,y ,sx ,sy)))
               ,@body)))))))


(defmacro with-grid-bezier
    ((x y) (control-pts &key (count 100)) &body body)
  "CONTROL-POINTS is an expression that evalueates to a list of (X Y)
pairs, these are the control points for the curve.. COUNT is the
number of points on the bezier curve that will be calclated. The first
point is always the first control point and the last point is always
the last control point.  Use high counts for smooth curves, as needed.

Evaluates the BODY with X Y bound to a point on the bezier curve.
"
  (with-gensyms (fn points a step)
    `(let* ((,step
              (/ 1.0 ,count))
            (,points
              ,control-pts)
            (,fn
              (apply #'bezier-lambda ,points)))
       (loop :for ,a :from 0.0 :to (+ 1.0 ,step) :by ,step
             :for (,x ,y) := (mapcar #'round (funcall ,fn (clamp 0 ,a 1.0)))
             :do ,@body))))