(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))