# HG changeset patch # User Steve Losh # Date 1463741566 0 # Node ID 800b4dcae88c8a7402bc91cbdd29a601b22edf47 # Parent c67f608611f59939f55362242e7955cd7b94bc40 Add grid printing, prepare for maze gen diff -r c67f608611f5 -r 800b4dcae88c .lispwords --- 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) diff -r c67f608611f5 -r 800b4dcae88c mazes.asd --- 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"))))) diff -r c67f608611f5 -r 800b4dcae88c package.lisp --- 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 diff -r c67f608611f5 -r 800b4dcae88c src/generation.lisp --- /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) diff -r c67f608611f5 -r 800b4dcae88c src/grid.lisp --- 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)))))