Newer
Older
mazes / grid.lisp
(in-package #:mazes)

(defclass grid ()
  ((rows :initarg :rows :reader grid-rows)
   (cols :initarg :cols :reader grid-cols)
   (matrix :initform nil :accessor grid-matrix))
  (:documentation "Initializes a grid of cells with dimension rows x cells"))

#|
  (print-unreadable-object (obj stream :type t)
    (format stream "+~v{~a~:*~}~C" (grid-cols obj) '("---+") #\linefeed))
|#
(defmethod print-object ((obj grid) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "(~a, ~a)" (grid-rows obj) (grid-cols obj)))
  (format stream (to-string obj)))

(defmethod initialize-instance :after ((g grid) &key)
  (setf (grid-matrix g) (prepare-grid g))
  (configure-cells g))

(defun make-grid (rows cols)
  "Constructor for grid class"
  (make-instance 'grid :rows rows :cols cols))

(defgeneric prepare-grid (grid)
  (:documentation "Create a grid of cells with dimension rows x cols.  This should only be called by INTIALIZE-INSTANCE"))

(defgeneric configure-cells (grid)
  (:documentation "Set the neighbors of each cell"))

(defgeneric cell-in-grid-p (grid &key)
  (:documentation "Determine if a cell is inside the grid."))

(defgeneric random-cell (grid)
 (:documentation "Return a random cell from the grid"))

(defgeneric size (grid)
  (:documentation "Return the size of the grid"))

(defgeneric contents-of (grid cell)
  (:documentation "Default value of text for a cell to print out.  To be overridden by subclasses of GRID."))

(defgeneric to-string (grid)
  (:documentation "Return ASCII string of the maze."))

(defgeneric get-cell (grid row cell)
  (:documentation "Return a cell at position (row,col)"))

(defmethod contents-of ((g grid) (c cell))
  (declare (ignore g c))
  (format nil " "))

(defmethod to-string ((obj grid))

  (let ((body "")
        (top "")
        (bottom "")
        (east-boundary "")
        (south-boundary "")
        (sell ())
        (str (make-array 0 :element-type 'character :fill-pointer 0)))
    (format str "~%+~v{~a~:*~}~C" (grid-cols obj) '("---+") #\Newline)
    (dotimes (r (grid-rows obj))
      (setf top "|")
      (setf bottom "+")
      (dotimes (c (grid-cols obj))
        (setf sell (aref (grid-matrix obj) r c))
        (when (null sell) (setf sell (make-cell -1 -1)))
        (setf body (concatenate 'string " " (contents-of obj sell) " ")) ; three spaces
        (if (linked-p sell :other-cell (cell-east sell)) 
            (setf east-boundary " ")
            (setf east-boundary "|"))
        (setf top (concatenate 'string top body east-boundary))
        (if (linked-p sell :other-cell (cell-south sell))
            (setf south-boundary "   ")
            (setf south-boundary "---"))
        (setf bottom (concatenate 'string bottom south-boundary "+")))
      (format str "~a~%" top)
      (format str "~a~%" bottom))
    str))

(defmethod prepare-grid ((g grid))
  (let* ((rows (grid-rows g))
         (cols (grid-cols g))
         (matrix (make-array `(,rows ,cols) :initial-element nil)))
    (dotimes (r rows)
      (dotimes (c cols)
        (setf (aref matrix r c) (make-cell r c))))
    matrix))

(defmethod configure-cells ((g grid))
  "Assumes a square or rectangular grid"
  (let ((rowz (grid-rows g))
        (colz (grid-cols g))
        (cell ()))
    (dotimes (row rowz)
      (dotimes (col colz)
        (setf cell (aref (grid-matrix g) row col))
        (setf (cell-north cell) (cell-in-grid-p g :row (- row 1) :col col))
        (setf (cell-south cell) (cell-in-grid-p g :row (+ row 1) :col col))
        (setf (cell-east cell) (cell-in-grid-p g :row row :col (+ col 1)))
        (setf (cell-west cell) (cell-in-grid-p g :row row :col (- col 1)))
))))

(defmethod cell-in-grid-p ((g grid) &key row col)
  (let ((g-rows (- (grid-rows g) 1))
        (g-cols (- (grid-cols g) 1)))
    (cond ((or (< row 0) (> row g-rows)) nil)
          ((or (< col 0) (> col g-cols)) nil)
          ; if cell is lies in the grid return the cell
          (t (aref (grid-matrix g) row col)))))

(defmethod random-cell ((g grid))
  (aref (grid-matrix g) (random (grid-rows g) (make-random-state t)) (random (grid-cols g) (make-random-state t))))

(defmethod size ((g grid))
  (* (grid-rows g) (grid-cols g)))

(defmethod get-cell ((g grid) row cell)
  (aref (grid-matrix g) row cell))