800b4dcae88c

Add grid printing, prepare for maze gen
[view raw] [browse files]
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)))))