# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463955629 0
# Node ID 155ad4c670c8cd5dc11eb76b81407f226dd323c9
# Parent  901e9fc8958dffe5eebab66604726b31c8f75227
Add Sidewinder algo

diff -r 901e9fc8958d -r 155ad4c670c8 package.lisp
--- 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
diff -r 901e9fc8958d -r 155ad4c670c8 src/demo.lisp
--- 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)
diff -r 901e9fc8958d -r 155ad4c670c8 src/generation.lisp
--- 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))))
diff -r 901e9fc8958d -r 155ad4c670c8 src/grid.lisp
--- 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)
diff -r 901e9fc8958d -r 155ad4c670c8 src/utils.lisp
--- 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))