# HG changeset patch # User Steve Losh # Date 1467492448 0 # Node ID 338a2f2c4b9a64d02548a892bceb8a1363b7c92f # Parent 367e393b0992e676c4512386535d4bcef4b775f4 Lean into iterate diff -r 367e393b0992 -r 338a2f2c4b9a .lispwords --- 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) diff -r 367e393b0992 -r 338a2f2c4b9a package.lisp --- 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 diff -r 367e393b0992 -r 338a2f2c4b9a src/demo.lisp --- 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)) diff -r 367e393b0992 -r 338a2f2c4b9a src/generation.lisp --- 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)) diff -r 367e393b0992 -r 338a2f2c4b9a src/grid.lisp --- 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