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 distance-to (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 distance-to ((root cell))
  (let* ((dist (make-distance root))
         (frontier '(root)))
    (do () ((null frontier) ())
      (mapcar #'(lambda (cell)
                  (mapcar #'(lambda (linked)
                              (format t "2nd mapcar: ~a~%" linked))
                          (links cell))
                  (format t "~a~%" cell))
              frontier))
    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))