Solid start made on routing.

src/walkmap/microworld.clj

@@ -5,40 +5,17 @@
   (:require [clojure.edn :as edn :only [read]]
             [clojure.java.io :as io]
             [clojure.string :as s]
-            [mw-cli.core :refer [process]]
-            [mw-engine.core :refer [run-world]]
-            [mw-engine.heightmap :as h]
-            [mw-engine.drainage :as d]
-            [mw-parser.bulk :as parser]
             [taoensso.timbre :as l]
             [walkmap.edge :as e]
-            [walkmap.polygon :as p :only [check-polygon polygon? rectangle]]
+            [walkmap.polygon :as p :only [rectangle]]
             [walkmap.superstructure :refer [store]]
-            [walkmap.tag :as t :only [tag tags]]
-            [walkmap.utils :as u :only [check-kind-type check-kind-type-seq kind-type truncate]]
-            [walkmap.vertex :as v :only [vertex vertex?]]))
-
-;; (def settlement-rules (parser/compile-file "resources/rules/settlement_rules.txt"))
-
-;; (def w0 (h/apply-heightmap "../the-great-game/resources/maps/heightmap.png"))
-;; (def w1 (d/rain-world (d/flood-hollows w0)))
-;; (def w2 (drainage/flow-world-nr w1))
-
-;; (def w3 (run-world w2 nil settlement-rules 100))
-
-;; (with-open [w (clojure.java.io/writer "settlement_1.edn")]
-;;   (binding [*out* w]
-;;     (pr
-;;       (run-world w0 nil settlement-rules 100))))
-
-;; (process
-;;   (h/apply-heightmap "resources/small_hill.png")
-;;   (parser/compile-file "resources/rules/settlement_rules.txt")
-;;   100
-;;   "small_hill.edn"
-;;   "small_hill.html")
+            [walkmap.tag :as t :only [tag]]
+            [walkmap.vertex :as v :only [check-vertex vertex vertex?]]))
 
 (defn cell->polygon
+  "From this MicroWorld `cell`, construct a walkmap polygon (specifically,
+  a rectangle. If `scale-vector` passed and is a vertex, scale all the vertices
+  in the cell by that vector."
   ([cell]
    (cell->polygon cell (v/vertex 1 1 1)))
   ([cell scale-vector]
@@ -46,7 +23,7 @@
      (assoc
        (merge
          cell
-         (let [w (* (:x cell) (:x scale-vector))
+         (let [w (* (:x cell) (:x (check-vertex scale-vector)))
                s (* (:y cell) (:y scale-vector))
                e (+ w (:x scale-vector))
                n (+ s (:y scale-vector))

src/walkmap/routing.clj

@@ -1,8 +1,10 @@
 (ns walkmap.routing
   "Finding optimal routes to traverse a map."
-    (:require [walkmap.path :as p]
+  (:require [walkman.edge :as e]
+            [walkmap.path :as p]
             [walkmap.polygon :as q]
-            [walkmap.stl :as s]
+            [walkmap.superstructure :as s]
+            [walkmap.tag :as t]
             [walkmap.utils :as u]
             [walkmap.vertex :as v]))
 
@@ -16,3 +18,64 @@
 ;; https://faculty.nps.edu/ncrowe/opmpaper2.htm
 ;;
 ;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html
+
+(defn traversable?
+  "True if this object can be considered as part of the walkmap."
+  [object]
+  (and
+    (or
+      (and
+        (q/polygon? object)
+        (:centre object))
+      (p/path? object))
+    (not (t/tagged? object :no-traversal))))
+
+(defn extend-frontier
+  "Return a sequence like `frontier` with all of these `candidates` which are
+  not already members either of `frontier` or of `rejects` appended."
+  ([frontier candidates]
+   (extend-frontier frontier candidates nil))
+  ([frontier candidates rejects]
+  (if
+    (empty? frontier)
+    candidates
+    (let [fs (set (concat frontier rejects))]
+      (concat frontier (remove fs candidates))))))
+
+;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8) '(6 8))
+;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8))
+;; (extend-frontier '(1 2 3 4 5) '())
+;; (extend-frontier '(1 2 3 4 5) nil)
+;; (extend-frontier nil '(1 2 3 4 5))
+
+(defn route
+  ;; NOT YET GOOD ENOUGH! Simple breadth first, and although it will
+  ;; reach the goal
+  ([from to s search-radius]
+   (loop [f from
+          t to
+          frontier (extend-frontier
+                     nil
+                     (s/neighbour-ids
+                       (s/nearest s from :centre search-radius)
+                       traversable?
+                       s))
+          visited nil]
+     (let [here (s/retrieve (first frontier) s)]
+       (cond
+         (< (e/length (e/edge (:centre here)) to) search-radius)
+         ;; close enough
+         (apply p/path (cons (:centre here) track))
+         (empty? (rest frontier))
+         ;; failed
+         nil
+         :else
+         (recur
+           f
+           t
+           (extend-frontier
+             (rest frontier)
+             (neighbour-ids here traversable? s)
+             visited)
+           (cons here visited)))))))
+

src/walkmap/superstructure.clj

@@ -181,7 +181,7 @@
        #(v/within-box? % minv maxv)
        (filter #(= (:kind %) :vertex) (vals s))))))
 
-(defn find-nearest
+(defn nearest
   "Search superstructure `s` for the nearest object matching `filter-fn` to
   the `target` vertex. Searches only with `radius` (slight misnomer, area
   actually searched is a cube). Returns one object, or `nil` if no matching
@@ -219,3 +219,21 @@
                          :walkmap.id/id
                          (search-vertices s minv maxv))))))))))))
 
+(defn neighbours
+  "Return a sequence of all those objects in superstructure `s` which share
+  at least one vertex with `target`, and which are matched by `filter-fn`
+  if supplied."
+  ([target s]
+   (neighbours identity s))
+  ([target filter-fn s]
+  ;; TODO: write it.
+  nil))
+
+(defn neighbour-ids
+  "Return a sequence of the ids all those objects in superstructure `s` which
+  share at least one vertex with `target`, and which are matched by
+  `filter-fn` if supplied."
+  ([target s]
+   (neighbour-ids target identity s))
+  ([target filter-fn s]
+   (map :walkmap.id/id (neighbours target filter-fn s))))

src/walkmap/utils.clj

@@ -1,6 +1,8 @@
 (ns walkmap.utils
   "Miscellaneous utility functions."
-  (:require [clojure.math.numeric-tower :as m]
+  (:require [clojure.edn :as edn :only [read]]
+            [clojure.java.io :as io]
+            [clojure.math.numeric-tower :as m]
             [clojure.string :as s]))
 
 (defn deep-merge