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

(defclass distances ()
  ((root :initarg :root :accessor root-cell)
   (cells :initarg :cells :initform (make-hash-table) :accessor distance-cells)
   (grid :initarg :grid :accessor distance-grid)
   (matrix :initform () :accessor distance-matrix))
  (:documentation "Keeps track of the distance of each cell from the given root cell."))

(defmethod initialize-instance :after ((d distances) &key)
  (setf (distance-matrix d) (grid-matrix (distance-grid d)))
  (setf (gethash (root-cell d) (distance-cells d)) 0))

(defgeneric set-distance (distances &key)
  (:documentation "Set the distance of the given cell from the root cell"))

(defgeneric calculate-distance (distances)
  (:documentation "Set the distance of the given cell from the root cell"))

(defgeneric distance-from-root-to (distances &key)
  (:documentation "Get the distance from the root cell to cell at :X :Y position"))

(defmethod set-distance ((d distances) &key cell distance)
  (let ((cells (distance-cells d)))
    (setf (gethash cell cells) distance)))

(defmethod calculate-distance ((d distances))
  ; (declare (optimize (debug 3)))
  (let* ((frontier (list (root-cell d)))
         (new-frontier ()))
    (loop while (not (null frontier)) 
      do 
         (setf new-frontier ())
         (dolist (cell frontier)
           (dolist (linked (links cell))
             (when (not (gethash linked (distance-cells d)))
               (set-distance d :cell linked :distance (+ 1 (gethash cell (distance-cells d))))
               (setf new-frontier (append `(,linked) new-frontier)))))
         (setf frontier (copy-tree new-frontier))))
  (distance-cells d))

(defmethod distance-from-root-to ((d distances) &key x y)
  (let ((cell (get-cell (distance-grid d) x y)))
    (gethash cell (distance-cells d))))

(defun make-distance (root grid)
  (make-instance 'distances :root root :grid grid))