# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1463706227 0
# Node ID c67f608611f59939f55362242e7955cd7b94bc40
# Parent  e6b1ce8ed0844d45c7732a14a9fd45862a882909
Add initial CL port of the cells/grids

diff -r e6b1ce8ed084 -r c67f608611f5 src/grid.lisp
--- a/src/grid.lisp	Fri May 20 00:05:16 2016 +0000
+++ b/src/grid.lisp	Fri May 20 01:03:47 2016 +0000
@@ -1,1 +1,116 @@
 (in-package #:mazes.grid)
+
+;;;; Cells
+(defclass cell ()
+  ((row :initarg :row :reader cell-row)
+   (col :initarg :col :reader cell-col)
+   (north :accessor cell-north :initform nil)
+   (south :accessor cell-south :initform nil)
+   (east :accessor cell-east :initform nil)
+   (west :accessor cell-west :initform nil)
+   (links :accessor cell-links :initform nil)))
+
+
+(defun make-cell (row col)
+  (make-instance 'cell :row row :col col))
+
+
+(defun cell-link% (cell other)
+  (pushnew other (cell-links cell)))
+
+(defun cell-link (cell1 cell2)
+  (cell-link% cell1 cell2)
+  (cell-link% cell2 cell1))
+
+(defun cell-unlink% (cell other)
+  (zap% (cell-links cell)
+        #'remove other %))
+
+(defun cell-unlink (cell1 cell2)
+  (cell-unlink% cell1 cell2)
+  (cell-unlink% cell2 cell1))
+
+(defun cell-linked-p (cell other)
+  (member other (cell-links cell)))
+
+(defun cell-neighbors (cell)
+  (with-slots (north south east west) cell
+    (remove-if #'null (list north south east west))))
+
+
+(defmethod print-object ((cell cell) stream)
+  (print-unreadable-object (cell stream :type t :identity nil)
+    (format stream "(~d, ~d)"
+            (cell-row cell)
+            (cell-col cell))))
+
+
+;;;; Grid
+(defclass grid ()
+  ((rows :initarg :rows :reader grid-rows)
+   (cols :initarg :cols :reader grid-cols)
+   (cells :accessor grid-cells)))
+
+
+(defgeneric grid-prepare (grid))
+(defgeneric grid-configure-cells (grid))
+(defgeneric grid-ref (grid row col))
+
+
+(defun make-grid (rows cols)
+  (let ((grid (make-instance 'grid :rows rows :cols cols)))
+    (grid-prepare grid)
+    (grid-configure-cells grid)
+    grid))
+
+
+(defun grid-map-cells (fn grid)
+  (with-slots (cells) grid
+    (loop :for i :from 0 :below (array-total-size cells)
+          :do (funcall fn (row-major-aref cells i)))))
+
+(defun grid-map-rows (fn grid)
+  (with-slots (rows cols cells) grid
+    (loop :for row :from 0 :below rows
+          :do (funcall fn (make-array cols
+                            :element-type 'cell
+                            :displaced-to cells
+                            :displaced-index-offset
+                            (array-row-major-index cells row 0))))))
+
+
+(defun grid-size (grid)
+  (* (grid-rows grid) (grid-cols grid)))
+
+(defun grid-random-cell (grid)
+  (aref (grid-cells grid)
+        (random (grid-rows grid))
+        (random (grid-cols grid))))
+
+
+(defmethod grid-ref ((grid grid) row col)
+  (with-slots (rows cols cells) grid
+    (if (and (<= 0 row (1- rows))
+             (<= 0 col (1- cols)))
+      (aref cells row col)
+      nil)))
+
+(defmethod grid-prepare ((grid grid))
+  (with-slots (rows cols cells) grid
+    (setf cells
+          (make-array (list rows cols)
+            :element-type 'cell
+            :initial-contents
+            (loop :for r :from 0 :below rows :collect
+                  (loop :for c :from 0 :below cols :collect
+                        (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)))