;;; 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 ,left to ,right do
    (loop for ,y from ,bottom to ,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))))