--- a/mazes.asd Fri May 20 21:59:56 2016 +0000
+++ b/mazes.asd Sun May 22 22:02:25 2016 +0000
@@ -10,6 +10,7 @@
:depends-on (#:defstar
#:sketch
#:sb-cga
+ #:snakes
#:cl-strings
#:cl-arrows)
--- a/package.lisp Fri May 20 21:59:56 2016 +0000
+++ b/package.lisp Sun May 22 22:02:25 2016 +0000
@@ -41,7 +41,12 @@
#:cell-south
#:cell-east
#:cell-west
+ #:cell-col
+ #:cell-row
#:grid
+ #:grid-cols
+ #:grid-rows
+ #:grid-cells
#:grid-ref
#:make-grid
#:grid-size
@@ -59,7 +64,12 @@
#:mazes.utils
#:mazes.grid)
(:export
- #:gen-binary-tree))
+ #:binary-tree
+ #:binary-tree-generator)
+ (:import-from #:snakes
+ #:defgenerator
+ #:do-generator
+ #:yield))
(defpackage #:mazes.demo
(:use
--- a/src/demo.lisp Fri May 20 21:59:56 2016 +0000
+++ b/src/demo.lisp Sun May 22 22:02:25 2016 +0000
@@ -1,8 +1,7 @@
(in-package #:mazes.demo)
-
;;;; Config
-(setf *bypass-cache* t)
+(setf *bypass-cache* nil)
(defparameter *width* 800)
(defparameter *height* 800)
@@ -32,17 +31,46 @@
;;;; Sketch
+(defparameter *wall-pen*
+ (make-pen :weight 3 :stroke (rgb 0.625 0.423 0.399)))
+
+(defun draw-maze (grid cell-size)
+ (in-context
+ (translate (/ (* (grid-cols grid) cell-size) -2)
+ (/ (* (grid-rows grid) cell-size) -2))
+ (with-pen *wall-pen*
+ (grid-loop-cells cell grid
+ (let ((x1 (* cell-size (cell-col cell)))
+ (y1 (* cell-size (cell-row cell)))
+ (x2 (* cell-size (1+ (cell-col cell))))
+ (y2 (* cell-size (1+ (cell-row cell)))))
+ (when (not (cell-north cell))
+ (line x1 y1 x2 y1))
+ (when (not (cell-west cell))
+ (line x1 y1 x1 y2))
+ (when (not (cell-linked-east-p cell))
+ (line x2 y1 x2 y2))
+ (when (not (cell-linked-south-p cell))
+ (line x1 y2 x2 y2)))))))
+
(defsketch demo
- ((width *width*) (height *height*) (y-axis :up) (title "Mazes")
+ ((width *width*) (height *height*) (y-axis :down) (title "Mazes")
(mouse (cons 0 0))
+ (frame 0)
;; Variables
+ (maze (make-grid 20 20))
+ (gen (binary-tree-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)
+ (funcall gen))
;;
+ (incf frame)
))
@@ -135,7 +163,4 @@
;;;; Run
-(defparameter g (make-grid 7 5))
-(gen-binary-tree g)
-
; (defparameter *demo* (make-instance 'demo))
--- a/src/generation.lisp Fri May 20 21:59:56 2016 +0000
+++ b/src/generation.lisp Sun May 22 22:02:25 2016 +0000
@@ -1,8 +1,12 @@
(in-package #:mazes.generation)
-(defun gen-binary-tree (grid)
+(defgenerator binary-tree-generator (grid)
(grid-loop-cells cell grid
(let ((other (random-elt (full-list (cell-north cell)
(cell-east cell)))))
(when other
- (cell-link cell other)))))
+ (cell-link cell other)))
+ (yield)))
+
+(defun binary-tree (grid)
+ (do-generator (_ (binary-tree-generator grid))))
--- a/src/grid.lisp Fri May 20 21:59:56 2016 +0000
+++ b/src/grid.lisp Sun May 22 22:02:25 2016 +0000
@@ -93,8 +93,11 @@
(array-row-major-index cells row 0))))))
(defmacro grid-loop-cells (cell-symbol grid &body body)
- `(grid-map-cells (lambda (,cell-symbol) ,@body)
- ,grid))
+ (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)))))
(defmacro grid-loop-rows (row-symbol grid &body body)
`(grid-map-rows (lambda (,row-symbol) ,@body)
--- a/src/utils.lisp Fri May 20 21:59:56 2016 +0000
+++ b/src/utils.lisp Sun May 22 22:02:25 2016 +0000
@@ -43,5 +43,7 @@
(values nil nil)
(values (elt seq (random length)) t))))
+
(defun full-list (&rest args)
(remove-if #'null args))
+