--- a/.lispwords Thu Jun 30 23:23:24 2016 +0000
+++ b/.lispwords Sat Jul 02 20:47:28 2016 +0000
@@ -1,6 +1,5 @@
(1 scancode-case)
(1 make-sketch)
-(2 grid-loop-cells grid-loop-rows)
(1 recursively)
(1 with-cell-active)
(1 when-let)
--- a/package.lisp Thu Jun 30 23:23:24 2016 +0000
+++ b/package.lisp Sat Jul 02 20:47:28 2016 +0000
@@ -82,10 +82,8 @@
#:grid-clear-active
#:make-grid
#:grid-size
- #:grid-map-cells
- #:grid-map-rows
- #:grid-loop-cells
- #:grid-loop-rows
+ #:in-grid
+ #:row-of-grid
#:grid-size
#:grid-random-cell
#:distance-map
--- a/src/demo.lisp Thu Jun 30 23:23:24 2016 +0000
+++ b/src/demo.lisp Sat Jul 02 20:47:28 2016 +0000
@@ -79,7 +79,8 @@
(grid-ref grid 0 0))))
(max (dm-distance distances (dm-max distances))))
(when (plusp max)
- (grid-loop-cells cell grid
+ (iterate
+ (for cell :in-grid grid)
(when-let (distance (dm-distance distances cell))
(with-pen
(make-pen :fill (lerp-color
@@ -102,24 +103,26 @@
(when end (draw-cell end)))))
(defun draw-active (instance)
- (grid-loop-cells cell (slot-value instance 'grid)
- (when (cell-active-group cell)
- (with-pen *active-group-pen* (draw-cell cell)))
- (when (cell-active cell)
- (with-pen *active-pen* (draw-cell cell)))))
+ (iterate (for cell :in-grid (slot-value instance 'grid))
+ (when (cell-active-group cell)
+ (with-pen *active-group-pen* (draw-cell cell)))
+ (when (cell-active cell)
+ (with-pen *active-pen* (draw-cell cell)))))
(defun draw-maze (instance)
- (with-slots (grid) instance
+ (with-slots (finished-generating grid) instance
(in-context
(translate (/ (* (grid-cols grid) *cell-size*) -2)
(/ (* (grid-rows grid) *cell-size*) -2))
- (draw-colors instance)
- (draw-longest instance)
- (draw-path instance)
+ (when finished-generating
+ (draw-colors instance)
+ (draw-longest instance)
+ (draw-path instance))
(draw-active instance)
(with-pen *wall-pen*
- (grid-loop-cells cell grid
+ (iterate
+ (for cell :in-grid grid)
(let ((x1 (cell-x cell))
(y1 (cell-y cell))
(x2 (cell-x cell 1))
--- a/src/generation.lisp Thu Jun 30 23:23:24 2016 +0000
+++ b/src/generation.lisp Sat Jul 02 20:47:28 2016 +0000
@@ -31,12 +31,13 @@
;;; picked, which results in signature long corridors on those edges.
(defgenerator binary-tree-generator (grid)
- (grid-loop-cells cell grid
+ (iterate
+ (for cell :in-grid grid)
+ (for other = (random-elt (full-list (cell-north cell)
+ (cell-east cell))))
(with-cell-active (cell)
- (let ((other (random-elt (full-list (cell-north cell)
- (cell-east cell)))))
- (when other
- (cell-link cell other)))
+ (when other
+ (cell-link cell other))
(yield))))
(defun binary-tree (grid)
@@ -57,7 +58,8 @@
;;; results in a signature long corridor along the top of the maze.
(defgenerator sidewinder-generator (grid)
- (grid-loop-rows row grid
+ (iterate
+ (for row :row-of-grid grid)
(iterate
(with run = nil)
(for cell :in-vector row)
@@ -124,7 +126,8 @@
(defgenerator wilson-generator (grid)
(iterate
- (with unvisited = (make-set :initial-data (grid-map-cells #'identity grid)))
+ (with unvisited = (make-set :initial-data (iterate (for cell :in-grid grid)
+ (collect cell))))
(initially (setf (cell-active-group (set-pop unvisited)) t))
(with path = nil)
(with cell = (set-random unvisited))
@@ -169,10 +172,11 @@
(random-unvisited-neighbor (cell)
(random-elt (remove-if #'visited-p (cell-neighbors cell))))
(hunt ()
- (grid-loop-cells cell grid
- (when (and (not (visited-p cell))
- (some #'visited-p (cell-neighbors cell)))
- (return cell)))))
+ (iterate
+ (for cell :in-grid grid)
+ (finding cell :such-that
+ (and (not (visited-p cell))
+ (some #'visited-p (cell-neighbors cell)))))))
(iterate
(with cell = (grid-ref grid 0 0))
(initially (setf (cell-active-group cell) t))
--- a/src/grid.lisp Thu Jun 30 23:23:24 2016 +0000
+++ b/src/grid.lisp Sat Jul 02 20:47:28 2016 +0000
@@ -90,39 +90,30 @@
grid))
-(defun grid-map-cells (fn grid)
- (with-slots (cells) grid
- (loop :for i :from 0 :below (array-total-size cells)
- :collect (funcall fn (row-major-aref cells i)))))
+(defun grid-row (grid row)
+ (let ((cells (grid-cells grid)))
+ (make-array (grid-cols grid)
+ :element-type 'cell
+ :displaced-to cells
+ :displaced-index-offset (array-row-major-index cells row 0))))
-(defun grid-map-rows (fn grid)
- (with-slots (rows cols cells) grid
- (loop :for row :from 0 :below rows
- :do (funcall fn (make-array cols
- :element-type 'cell
- :displaced-to cells
- :displaced-index-offset
- (array-row-major-index cells row 0))))))
-(defmacro grid-loop-cells (cell-symbol grid &body body)
- (with-gensyms (i)
- (once-only (grid)
- `(loop :for ,i :from 0 :below (array-total-size (grid-cells ,grid))
- :for ,cell-symbol = (row-major-aref (grid-cells ,grid) ,i)
- :do (progn ,@body)))))
+(defclause-sequence IN-GRID nil
+ :access-fn (lambda (grid index)
+ (row-major-aref (grid-cells grid) index))
+ :size-fn (lambda (grid)
+ (array-total-size (grid-cells grid)))
+ :sequence-type 'grid
+ :element-type 'cell
+ :element-doc-string "All cells in a grid")
-(defmacro grid-loop-rows (row-symbol grid &body body)
- (with-gensyms (row cols)
- (once-only (grid)
- `(loop
- :with ,cols = (grid-cols ,grid)
- :for ,row :from 0 :below (grid-rows ,grid)
- :for ,row-symbol = (make-array ,cols
- :element-type 'cell
- :displaced-to (grid-cells ,grid)
- :displaced-index-offset
- (array-row-major-index (grid-cells grid) ,row 0))
- :do (progn ,@body)))))
+(defclause-sequence ROW-OF-GRID nil
+ :access-fn #'grid-row
+ :size-fn (lambda (grid)
+ (array-dimension (grid-cells grid) 0))
+ :sequence-type 'grid
+ :element-type '(vector cell)
+ :element-doc-string "All rows in a grid")
(defun grid-size (grid)
@@ -152,7 +143,8 @@
(make-cell r c)))))))
(defmethod grid-configure-cells ((grid grid))
- (grid-loop-cells cell grid
+ (iterate
+ (for cell :in-grid grid)
(with-slots (row col north south east west) cell
(setf north (grid-ref grid (1- row) col)
south (grid-ref grid (1+ row) col)
@@ -161,9 +153,9 @@
(defun grid-clear-active (grid)
- (grid-loop-cells cell grid
- (setf (cell-active cell) nil
- (cell-active-group cell) nil)))
+ (iterate (for cell :in-grid grid)
+ (setf (cell-active cell) nil
+ (cell-active-group cell) nil)))
(defmethod print-object ((grid grid) stream)
@@ -171,7 +163,8 @@
(grid stream :type t :identity nil)
(format stream "~%+~A~%"
(cl-strings:repeat "---+" (grid-cols grid)))
- (grid-loop-rows row grid
+ (iterate
+ (for row :row-of-grid grid)
(let ((top "|")
(bottom "+"))
(loop :for contents :across row