--- a/package.lisp Sun May 22 22:02:25 2016 +0000
+++ b/package.lisp Sun May 22 22:20:29 2016 +0000
@@ -7,6 +7,7 @@
#:dividesp
#:in-context
#:random-elt
+ #:randomp
#:zap%
#:full-list
#:%))
@@ -65,7 +66,9 @@
#:mazes.grid)
(:export
#:binary-tree
- #:binary-tree-generator)
+ #:binary-tree-generator
+ #:sidewinder
+ #:sidewinder-generator)
(:import-from #:snakes
#:defgenerator
#:do-generator
--- a/src/demo.lisp Sun May 22 22:02:25 2016 +0000
+++ b/src/demo.lisp Sun May 22 22:20:29 2016 +0000
@@ -1,7 +1,7 @@
(in-package #:mazes.demo)
;;;; Config
-(setf *bypass-cache* nil)
+(setf *bypass-cache* t)
(defparameter *width* 800)
(defparameter *height* 800)
@@ -58,16 +58,16 @@
(mouse (cons 0 0))
(frame 0)
;; Variables
- (maze (make-grid 20 20))
- (gen (binary-tree-generator maze))
+ (maze (make-grid 25 25))
+ (gen (sidewinder-generator maze))
;; Pens
(simple-pen (make-pen :fill (gray 0.1)))
(line-pen (make-pen :stroke (gray 0.1) :weight 1))
)
(with-setup
;;
- (draw-maze maze 30)
- (if (dividesp frame 5)
+ (draw-maze maze 20)
+ (if (dividesp frame 2)
(funcall gen))
;;
(incf frame)
--- a/src/generation.lisp Sun May 22 22:02:25 2016 +0000
+++ b/src/generation.lisp Sun May 22 22:20:29 2016 +0000
@@ -10,3 +10,26 @@
(defun binary-tree (grid)
(do-generator (_ (binary-tree-generator grid))))
+
+(defgenerator sidewinder-generator (grid)
+ (grid-loop-rows row grid
+ (loop :with run = nil
+ :for cell :across row
+ :for at-east-bound = (null (cell-east cell))
+ :for at-north-bound = (null (cell-north cell))
+ :for should-close = (or at-east-bound
+ (and (not at-north-bound)
+ (randomp)))
+ :do (progn
+ (push cell run)
+ (if should-close
+ (let* ((member (random-elt run))
+ (member-north (cell-north member)))
+ (when member-north
+ (cell-link member member-north))
+ (setf run nil))
+ (cell-link cell (cell-east cell)))
+ (yield)))))
+
+(defun sidewinder (grid)
+ (do-generator (_ (sidewinder-generator grid))))
--- a/src/grid.lisp Sun May 22 22:02:25 2016 +0000
+++ b/src/grid.lisp Sun May 22 22:20:29 2016 +0000
@@ -100,8 +100,17 @@
:do (progn ,@body)))))
(defmacro grid-loop-rows (row-symbol grid &body body)
- `(grid-map-rows (lambda (,row-symbol) ,@body)
- ,grid))
+ (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)))))
(defun grid-size (grid)
--- a/src/utils.lisp Sun May 22 22:02:25 2016 +0000
+++ b/src/utils.lisp Sun May 22 22:20:29 2016 +0000
@@ -43,6 +43,9 @@
(values nil nil)
(values (elt seq (random length)) t))))
+(defun randomp ()
+ (zerop (random 2)))
+
(defun full-list (&rest args)
(remove-if #'null args))