# HG changeset patch # User Steve Losh # Date 1465389015 0 # Node ID a012e3f65a0d69be71c6afca609dd92f702256f2 # Parent 7bed529a71b5173038f7ce84125c3f2b5f646cdc Add active cell highlighting during generation diff -r 7bed529a71b5 -r a012e3f65a0d package.lisp --- a/package.lisp Wed Jun 08 12:07:35 2016 +0000 +++ b/package.lisp Wed Jun 08 12:30:15 2016 +0000 @@ -49,6 +49,8 @@ #:cell-west #:cell-col #:cell-row + #:cell-active + #:cell-active-group #:grid #:grid-cols #:grid-rows diff -r 7bed529a71b5 -r a012e3f65a0d src/demo.lisp --- a/src/demo.lisp Wed Jun 08 12:07:35 2016 +0000 +++ b/src/demo.lisp Wed Jun 08 12:30:15 2016 +0000 @@ -50,6 +50,12 @@ (defparameter *end-pen* (make-pen :fill (rgb 1.000 0.733 0.424))) +(defparameter *active-pen* + (make-pen :fill (rgb 0.731 0.550 0.758))) + +(defparameter *active-group-pen* + (make-pen :fill (rgb 0.427 0.322 0.443))) + (defun draw-maze (instance) (with-slots (grid start end path longest-path show-longest show-colors) @@ -82,6 +88,13 @@ (with-pen *end-pen* (when start (draw-cell start)) (when end (draw-cell end))) + (grid-loop-cells cell grid + (with-pen *active-group-pen* + (when (cell-active-group cell) + (draw-cell cell))) + (with-pen *active-pen* + (when (cell-active cell) + (draw-cell cell)))) (with-pen *wall-pen* (grid-loop-cells cell grid (let ((x1 (cell-x cell)) @@ -111,7 +124,7 @@ (frame 0) (log " ") ;; Variables - (grid (make-grid 20 20)) + (grid (make-grid 25 25)) (gen (funcall *generator* grid)) (finished-generating nil) (distances nil) @@ -128,7 +141,7 @@ ;; (draw-maze sketch::instance) (if (and (not finished-generating) - (dividesp frame 1)) + (dividesp frame 4)) (when (funcall gen) (setf finished-generating t longest-path (find-longest-path grid)))) diff -r 7bed529a71b5 -r a012e3f65a0d src/generation.lisp --- a/src/generation.lisp Wed Jun 08 12:07:35 2016 +0000 +++ b/src/generation.lisp Wed Jun 08 12:30:15 2016 +0000 @@ -2,15 +2,18 @@ (defgenerator binary-tree-generator (grid) (grid-loop-cells cell grid + (setf (cell-active cell) t) (let ((other (random-elt (full-list (cell-north cell) (cell-east cell))))) (when other (cell-link cell other))) - (yield))) + (yield) + (setf (cell-active cell) nil))) (defun binary-tree (grid) (do-generator (_ (binary-tree-generator grid)))) + (defgenerator sidewinder-generator (grid) (grid-loop-rows row grid (loop :with run = nil @@ -20,16 +23,25 @@ :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))))) + :do + (progn + (setf (cell-active-group cell) t + (cell-active cell) t) + (push cell run) + (if should-close + (let* ((member (random-elt run)) + (member-north (cell-north member))) + (when member-north + (setf (cell-active member) t) + (cell-link member member-north)) + (yield) + (setf (cell-active member) nil) + (loop :for c :in run :do (setf (cell-active-group c) nil)) + (setf run nil)) + (progn + (cell-link cell (cell-east cell)) + (yield))) + (setf (cell-active cell) nil))))) (defun sidewinder (grid) (do-generator (_ (sidewinder-generator grid)))) diff -r 7bed529a71b5 -r a012e3f65a0d src/grid.lisp --- a/src/grid.lisp Wed Jun 08 12:07:35 2016 +0000 +++ b/src/grid.lisp Wed Jun 08 12:30:15 2016 +0000 @@ -8,6 +8,8 @@ (south :accessor cell-south :initform nil) (east :accessor cell-east :initform nil) (west :accessor cell-west :initform nil) + (active :accessor cell-active :initform nil) + (active-group :accessor cell-active-group :initform nil) (links :accessor cell-links :initform nil)))