[wip]

6 files changed, 109 insertions, 25 deletions

diff --git a/examples/11-canvas-geometry.lisp b/examples/11-canvas-geometry.lisp
new file mode 100644
index 0000000..1147ed9
--- /dev/null
+++ b/examples/11-canvas-geometry.lisp
@@ -0,0 +1,32 @@
+;;;; examples/11-canvas-geometry.lisp
+
+(defpackage #:ww.examples/11
+  (:use #:cl)
+  (:export #:start))
+
+(in-package :ww.examples/11)
+
+(defclass geo-demo (ww:application) ())
+
+(defmethod ww:boot ((app geo-demo))
+  (let ((canvas
+          (make-instance 'ww:canvas
+                         :pixel-width 500
+                         :pixel-height 500)))
+    ;; stretch canvas over the whole app
+    (setf (ww:width canvas) (ww::application-width app)
+          (ww:height canvas) (ww::application-height app))
+
+    ;; add it to the display tree
+    (ww:add-unit app canvas)
+
+    ;; draw a circle
+    (ww::with-grid-circle (x y) (50 50 30)
+      (ww::with-pixel (r g b a) (ww::pixel canvas x y)
+        (setf r (mod (* x y) 255)
+              g x
+              b y)))
+    
+
+    ;; blit the canvas
+    (ww::blit canvas)))
diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp
new file mode 100644
index 0000000..cef69f8
--- /dev/null
+++ b/src/grid-geometry.lisp
@@ -0,0 +1,70 @@
+;;; 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))))
+
+(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))
+         (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))))))
+
+(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)))))
+
+(defmacro with-grid-poly-interior
+    ((x y) perimeter &body body)
+  "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))
+       (destructuring-bind ((,left ,bottom) (,right ,top)) (grid-bbox-for ,points)
+         (loop )
+         )))
+  )
+
+(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)) 
+         (with-grid-rect (,x ,y) ((- ,sx ,rad) (- ,sy ,rad) (+ ,sx ,rad) (+ ,sy ,rad))
+           (when (,comparator ,rad (round (euclidean-dist ,x ,y ,sx ,sy)))
+             ,@body))))))
diff --git a/src/interactive/canvas.lisp b/src/interactive/canvas.lisp
index e8bdc39..7f24d89 100644
--- a/src/interactive/canvas.lisp
+++ b/src/interactive/canvas.lisp
@@ -92,7 +92,6 @@ e.g., drawing a line in a particular color."
        (with-grid-line (,x ,y) (,start-x ,start-y) (,end-x ,end-y)
          (with-pixel (,r ,g ,b ,a) (pixel ,pxs ,x ,y) ,@body)))))
 
-
 (defvar *canvas-shader-program* nil)
 (defvar *canvas-render-vao* nil)
 (defvar *canvas-count* 0)
diff --git a/src/utils.lisp b/src/utils.lisp
index 4037b7a..7b68e3d 100644
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -41,7 +41,6 @@ and B intersects the linesegment between C and D, NIL otherwise."
                         while b2
                           thereis (segments-intersect-p a1 a2 b1 b2))))
 
-
 (defun closed-path-p (path)
   (equalp (first path)
           (first (last path))))
@@ -63,8 +62,6 @@ and B intersects the linesegment between C and D, NIL otherwise."
           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.")
@@ -115,23 +112,7 @@ the path."
     `(let ((,value ,value-form))
        (setf ,@clauses))))
 
-
-(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 euclidean-dist (x1 y1 x2 y2)
+  (let ((dx (- x2 x1))
+        (dy (- y2 y1)))
+    (sqrt (+ (* dx dx) (* dy dy)))))
diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd
index 862358c..ca6e328 100644
--- a/wheelwork-examples.asd
+++ b/wheelwork-examples.asd
@@ -15,4 +15,5 @@
                (:file "07-renderarea")
                (:file "08-pong")
                (:file "09-ghoulspree")
-               (:file "10-canvas-sneks")))
+               (:file "10-canvas-sneks")
+               (:file "11-canvas-geometry")))
diff --git a/wheelwork.asd b/wheelwork.asd
index 06fa686..086c1c7 100644
--- a/wheelwork.asd
+++ b/wheelwork.asd
@@ -19,6 +19,7 @@
   :components ((:file "package")
                (:file "protocol")
                (:file "utils")
+               (:file "grid-geometry")
                (:module "gl"
                 :components ((:file "util")
                              (:file "texture")