[add] path drawing

1 files changed, 35 insertions, 13 deletions

diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp
index cef69f8..bddde38 100644
--- a/src/grid-geometry.lisp
+++ b/src/grid-geometry.lisp
@@ -23,17 +23,31 @@ connecting the integer point START-X , START-Y and END-X, END-Y. "
 
 (defmacro with-grid-path
     ((x y) (path &key autoclosep interiorp) &body body)
-  (with-gensyms (points x1 y1 x2 y2 more)
-    (let ((autoclose-block
-            (when autoclosep
-              `(destructuring-bind (,x2 ,y2) (first ,points)
-                 (with-grid-line (,x2 ,y2) (,x1 ,y1) ,@body))))) 
-      `(let ((,points ,path))
+  (with-gensyms (points x1 y1 x2 y2 more perimeter)
+    (let* ((perimeter-acc-clause
+             (when (and autoclosep interiorp)
+               `(pushnew (list ,x ,y) ,perimeter :test #'equalp)))
+           (autoclose-clause
+             (when autoclosep
+               `(destructuring-bind (,x2 ,y2) (first ,points)
+                  (with-grid-line (,x2 ,y2) (,x1 ,y1)
+                      ,perimeter-acc-clause
+                    ,@body))))
+           (autofill-clause
+             (when (and autoclosep interiorp)
+               `(with-grid-poly-interior (,x ,y) ,perimeter ,@body)))) 
+      `(let ((,points ,path)
+             (,perimeter nil))
          (loop
            for ((,x1 ,y) (,x2 ,y2) . ,more) on ,points
            while ,x2 do
-             (with-grid-line (,x ,y) (,x1 ,y1) (,x2 ,y2) ,@body)
-           finally (progn ,autoclose-block))))))
+             (with-grid-line (,x ,y) (,x1 ,y1) (,x2 ,y2)
+               (progn
+                 ,perimeter-acc-clause 
+                 ,@body))
+           finally (progn
+                     ,autoclose-clause
+                     ,autofill-clause))))))
 
 (defun grid-bbox-for (poly)
   "POLY is a list of pairs of xy coordinates. Return a pair of
@@ -52,12 +66,20 @@ top right corners of the bounding box for POLY "
   "PERMIETER is expected to evaluate to a list of contiguous points,
 representing the permimeter a polygon in 2d space. Execute BODY for
 each point interior to this polygon."
-  (with-gensyms (points bottom left top right)
-    `(let ((,points ,permieter))
+  (with-gensyms (points bottom left top right inside)
+    `(let ((,points ,perimeter)
+           (,inside nil))
        (destructuring-bind ((,left ,bottom) (,right ,top)) (grid-bbox-for ,points)
-         (loop )
-         )))
-  )
+         (loop for ,y from ,bottom to ,top do
+           (loop for ,x from ,left to ,right
+                 when (member (list ,x ,y) ,points :test #'equalp)
+                   do (setf ,inside (not ,inside))
+                 when ,inside
+                   do (progn ,@body)))))))
+
+(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)