diff options
Diffstat (limited to 'src/grid-geometry.lisp')
| -rw-r--r-- | src/grid-geometry.lisp | 80 |
1 files changed, 40 insertions, 40 deletions
diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp index f66a41f..ec4edd2 100644 --- a/src/grid-geometry.lisp +++ b/src/grid-geometry.lisp @@ -8,30 +8,30 @@ 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)))) + :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))))) + (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)) @@ -49,11 +49,11 @@ top right corners of the bounding box for POLY " (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 + (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)) @@ -71,23 +71,23 @@ top right corners of the bounding box for POLY " (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)))))) + (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 + :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)))))) + :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 ))) + `(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) @@ -95,8 +95,8 @@ top right corners of the bounding box for POLY " (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 + (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))))))) @@ -118,7 +118,7 @@ Evaluates the BODY with X Y bound to a point on the bezier curve. ,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)))) + (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)))) |