Commits

Paul Sexton  committed e1e5255

New function: dijkstra-closer-positions. Returns a list of positions adjacent
to the supplied position, that are closer to the root node.

New function: dijkstra-walk. Given a starting position, calls a supplied
function there and at every position as it walks toward the root node.

  • Participants
  • Parent commits 9658c48

Comments (0)

Files changed (1)

File dijkstra-map.lisp

            #:dijkstra-compute-multi
            #:dijkstra-computed?
            #:dijkstra-path-exists?
+           #:dijkstra-closer-positions
            #:random-reachable-position
            #:dijkstra-distance
            #:dijkstra-print
+           #:dijkstra-walk
            #:dm-timestamp)
   (:documentation
    "* Description
   (< (dijkstra-distance dmap x y) 999999))
 
 
+(defun* (out-of-dijkstra-map-bounds? -> boolean) ((dmap dijkstra-map)
+                                                  (x fixnum) (y fixnum))
+  (not (and (<= 0 x (1- (dm-xdim dmap)))
+            (<= 0 y (1- (dm-ydim dmap))))))
+
+
+(defun* (dijkstra-closer-positions -> list)
+    ((dmap dijkstra-map) (startx fixnum) (starty fixnum)
+     &key (diagonal-ok? t))
+  "Return a list of all positions immediately adjacent to STARTX, STARTY)
+which are 'closer' to the root node. Each position in the returned list
+is given in the form of a cons cell, (X . Y)."
+  (let ((positions nil))
+    (iterate
+      (with current-dist = (dijkstra-distance dmap startx starty))
+      (for x from (1- startx) to (1+ startx))
+      (iterate
+        (for y from (1- starty) to (1+ starty))
+        (if (and (= x startx) (= y starty))
+            (next-iteration))
+        (if (out-of-dijkstra-map-bounds? dmap x y)
+            (next-iteration))
+        (if (and (not diagonal-ok?)
+                 (/= x startx) (/= y starty))
+            (next-iteration))
+        (for dist = (dijkstra-distance dmap x y))
+        (if (< dist current-dist)
+            (push (list dist (cons x y)) positions))))
+    (mapcar #'second (sort positions #'< :key #'car))))
+
+
+
 (defun* (random-reachable-position -> (cons fixnum fixnum)) ((dmap dijkstra-map))
   (:pre (dijkstra-computed? dmap))
   (let* ((mmax (position 0 (dm-nodes dmap)))
 specified."
   (*let ((mx fixnum (dm-xdim dmap))
          (my fixnum (dm-ydim dmap))
-         (index fixnum 0)
          (diag-cost fixnum (dm-diagonal-cost dmap))
          (dx simple-vector (vector -1  0  1 0 -1  1 1 -1))
          (dy simple-vector (vector  0 -1  0 1 -1 -1 1  1))
                (setf (aref distances root) base-distance)
                (setf (aref nodes i) root)
                (incf i)))))))
-    (setf index 0)
     (setf (dm-root-coords dmap) roots)
 
     (setf active-nodes (copy-seq nodes))
   dmap)
 
 
+
+(defun dijkstra-walk (dmap startx starty fn &key (diagonal-ok? t))
+  "Call (FN X Y) at (STARTX, STARTY), then move 1 square closer to the
+origin for DMAP and call FN again. Keep doing this until FN returns nil
+or until we reach the dmap origin."
+  (iterate
+    (with x = startx)
+    (with y = starty)
+    (while (and (funcall fn x y)
+                (not (zerop (dijkstra-distance dmap x y)))))
+    ;; get closer pos
+    (for next-pos = (car (dijkstra-closer-positions
+                          dmap x y :diagonal-ok? diagonal-ok?)))
+    (unless next-pos (finish))
+    (setf x (car next-pos)
+          y (cdr next-pos))))
+
+
+
 (defun dijkstra-test (&key (root-count 5) (wall? nil))
   (let* ((omap (make-2d-array 30 30))
          (roots (iterate (for i from 1 to root-count)