Add grid printing, prepare for maze gen
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 20 May 2016 10:52:46 +0000 |
parents |
c67f608611f5
|
children |
e63077fb7d6a
|
branches/tags |
(none) |
files |
.lispwords mazes.asd package.lisp src/generation.lisp src/grid.lisp |
Changes
--- a/.lispwords Fri May 20 01:03:47 2016 +0000
+++ b/.lispwords Fri May 20 10:52:46 2016 +0000
@@ -1,2 +1,3 @@
(1 scancode-case)
(1 make-sketch)
+(2 grid-loop-cells grid-loop-rows)
--- a/mazes.asd Fri May 20 01:03:47 2016 +0000
+++ b/mazes.asd Fri May 20 10:52:46 2016 +0000
@@ -10,6 +10,7 @@
:depends-on (#:defstar
#:sketch
#:sb-cga
+ #:cl-strings
#:cl-arrows)
:serial t
@@ -21,5 +22,5 @@
:components ((:file "utils")
(:file "fps")
(:file "grid")
- (:file "demo")
- ))))
+ (:file "generation")
+ (:file "demo")))))
--- a/package.lisp Fri May 20 01:03:47 2016 +0000
+++ b/package.lisp Fri May 20 10:52:46 2016 +0000
@@ -24,7 +24,32 @@
#:cl
#:mazes.quickutils
#:mazes.utils)
- (:export))
+ (:export
+ #:cell
+ #:make-cell
+ #:cell-link
+ #:cell-unlink
+ #:cell-linked-p
+ #:cell-linked-north-p
+ #:cell-linked-south-p
+ #:cell-linked-east-p
+ #:cell-linked-west-p
+ #:cell-neighbors
+ #:grid
+ #:grid-ref
+ #:make-grid
+ #:grid-size
+ #:grid-map-cells
+ #:grid-map-rows
+ #:grid-size
+ #:grid-random-cell))
+
+(defpackage #:mazes.generation
+ (:use
+ #:cl
+ #:mazes.quickutils
+ #:mazes.utils
+ #:mazes.grid))
(defpackage #:mazes.demo
(:use
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/generation.lisp Fri May 20 10:52:46 2016 +0000
@@ -0,0 +1,1 @@
+(in-package #:mazes.generation)
--- a/src/grid.lisp Fri May 20 01:03:47 2016 +0000
+++ b/src/grid.lisp Fri May 20 10:52:46 2016 +0000
@@ -30,9 +30,23 @@
(cell-unlink% cell1 cell2)
(cell-unlink% cell2 cell1))
+
(defun cell-linked-p (cell other)
(member other (cell-links cell)))
+(defun cell-linked-north-p (cell)
+ (cell-linked-p cell (cell-north cell)))
+
+(defun cell-linked-south-p (cell)
+ (cell-linked-p cell (cell-south cell)))
+
+(defun cell-linked-east-p (cell)
+ (cell-linked-p cell (cell-east cell)))
+
+(defun cell-linked-west-p (cell)
+ (cell-linked-p cell (cell-west cell)))
+
+
(defun cell-neighbors (cell)
(with-slots (north south east west) cell
(remove-if #'null (list north south east west))))
@@ -78,6 +92,14 @@
:displaced-index-offset
(array-row-major-index cells row 0))))))
+(defmacro grid-loop-cells (cell-symbol grid &body body)
+ `(grid-map-cells (lambda (,cell-symbol) ,@body)
+ ,grid))
+
+(defmacro grid-loop-rows (row-symbol grid &body body)
+ `(grid-map-rows (lambda (,row-symbol) ,@body)
+ ,grid))
+
(defun grid-size (grid)
(* (grid-rows grid) (grid-cols grid)))
@@ -106,11 +128,26 @@
(make-cell r c)))))))
(defmethod grid-configure-cells ((grid grid))
- (grid-map-cells
- (lambda (cell)
- (with-slots (row col north south east west) cell
- (setf north (grid-ref grid (1- row) col)
- south (grid-ref grid (1+ row) col)
- west (grid-ref grid row (1- col))
- east (grid-ref grid row (1+ col)))))
- (grid-cells grid)))
+ (grid-loop-cells cell 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)
+ west (grid-ref grid row (1- col))
+ east (grid-ref grid row (1+ col))))))
+
+
+(defmethod print-object ((grid grid) stream)
+ (print-unreadable-object
+ (grid stream :type t :identity nil)
+ (format stream "~%+~A~%"
+ (cl-strings:repeat "---+" (grid-cols grid)))
+ (grid-loop-rows row grid
+ (let ((top "|")
+ (bottom "+"))
+ (loop :for contents :across row
+ :for cell = (or contents (make-cell -1 -1))
+ :for cell-top = (if (cell-linked-east-p cell) " " " |")
+ :for cell-bot = (if (cell-linked-south-p cell) " +" "---+")
+ :do (setf top (cl-strings:insert cell-top top)
+ bottom (cl-strings:insert cell-bot bottom)))
+ (format stream "~A~%~A~%" top bottom)))))