Newer
Older
mazes / mazes.lisp
;;;; mazes.lisp

(in-package #:mazes)

(defclass cell ()
  ((row :initarg :row :reader cell-row)
   (col :initarg :col :reader cell-col)
   (north :initarg :north :initform nil :accessor cell-north)
   (south :initarg :south :initform nil :accessor cell-south)
   (east :initarg :east :initform nil :accessor cell-east)
   (west :initarg :west :initform nil :accessor cell-west)
   (links :initform (make-hash-table) :accessor cell-links)
   (neighbors-list :initform () :accessor cell-neighbors))
  (:documentation "Defines a single cell in a maze"))

(defmethod print-object ((obj cell) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "Cell(~a,~a)" (cell-row obj) (cell-col obj))))

(defgeneric link (cell &key &allow-other-keys)
  (:documentation "Links current cell with neighbor cell.  If 
bidi (bi-directional) is true both cells are updated"))

(defgeneric unlink (cell &key &allow-other-keys)
  (:documentation "Unlinks current cell with neighbor cell.  If 
bidi (bi-directional) is true both cells are updated"))

(defgeneric links (cell)
  (:documentation "Return the list of all cells connected to given cell."))

(defgeneric linked-p (cell &key)
  (:documentation "Returns if the current cell is linked to a given cell."))

(defgeneric neighbors (cell)
  (:documentation "List of cells that adjoin this cell."))

(defgeneric distances (cell)
  (:documentation "Caluclate distance of each cell from root cell"))

(defmethod link ((current-cell cell) &key neighbor-cell  (bidi t))
  (setf (gethash neighbor-cell (cell-links current-cell)) t)
  (when (eql bidi t)
    (setf (gethash current-cell (cell-links neighbor-cell)) t)))

(defmethod unlink ((current-cell cell) &key neighbor-cell  (bidi t))
  (remhash neighbor-cell (cell-links current-cell))
  (when (eql bidi t)
    (remhash current-cell (cell-links neighbor-cell))))

(defmethod links ((current-cell cell))
  (get-hash-keys (cell-links current-cell)))

(defmethod linked-p ((current-cell cell) &key other-cell)
  (gethash other-cell (cell-links current-cell)))

(defmethod neighbors ((current-cell cell))
  (when (and (cell-north current-cell) (not (find (cell-north current-cell) (cell-neighbors current-cell))))
      (push (cell-north current-cell) (cell-neighbors current-cell)))

  (when (and (cell-south current-cell) (not (find (cell-south current-cell) (cell-neighbors current-cell))))
    (push (cell-south current-cell) (cell-neighbors current-cell)))

  (when (and (cell-east current-cell) (not (find (cell-east current-cell) (cell-neighbors current-cell))))
    (push (cell-east current-cell) (cell-neighbors current-cell)))

  (when (and (cell-west current-cell) (not (find (cell-west current-cell) (cell-neighbors current-cell))))
    (push (cell-west current-cell) (cell-neighbors current-cell)))

  (cell-neighbors current-cell))

(defmethod distances ((root-cell cell))
  (let ((dist (make-distance root-cell))
        (frontier (list root-cell))
        (new-frontier ()))
    (loop while (not (null frontier))
          do
          (progn
            (setf new-frontier ())
            (dolist (c frontier)
              (dolist (linked (links c))
                (when (not (gethash linked (cells dist)))
                  (set-distance dist :cell linked :distance (1+ (gethash c (cells dist))))
                  (setf new-frontier (append (list linked) new-frontier)))))
            (setf frontier (copy-tree new-frontier))))
    (cells dist)))


;;
;; cell constructor
;; 
(defun make-cell (row col)
  (make-instance 'cell :row row :col col))



;;
;; Util functions
;;
(defun get-hash-keys (hash-table)
  (loop for key being the hash-keys of hash-table collect key))