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