Started MicroWorld integration; more work on unit tests

src/walkmap/microworld.clj

@@ -0,0 +1,95 @@
+(ns walkmap.microworld
+  "An interface between walkmap and microworld, to allow use of microworld
+  functionality to model things like rainfall, soil fertility, settlement
+  and so on."
+  (: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.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")
+
+(defn cell->polygon
+  ([cell]
+   (cell->polygon cell (v/vertex 1 1 1)))
+  ([cell scale-vector]
+   (t/tag
+     (assoc
+       (merge
+         cell
+         (let [w (* (:x cell) (:x scale-vector))
+               s (* (:y cell) (:y scale-vector))
+               e (+ w (:x scale-vector))
+               n (+ s (:y scale-vector))
+               z (* (:altitude cell) (:z scale-vector))]
+         (p/rectangle
+           (v/vertex s w z)
+           (v/vertex n e z))))
+       :walkmap.id/id
+       (keyword (gensym "mw-cell")))
+     (:state cell))))
+
+(defn load-microworld-edn
+  "While it would be possible to call MicroWorld functions directly from
+  Walkmap, the fact is that running MicroWorld is so phenomenally
+  compute-heavy that it's much more sensible to do it in batch mode. So the
+  better plan is to be able to pull the output from MicroWorld - as an EDN
+  structure - into a walkmap superstructure."
+  ([filename]
+   (load-microworld-edn filename :mw))
+  ([filename map-kind]
+   (when-not
+     (keyword? map-kind)
+     (throw (IllegalArgumentException.
+              (u/truncate
+                (str "Must be a keyword: " (or map-kind "nil")) 80))))
+   (load-microworld-edn filename map-kind nil))
+  ([filename mapkind superstucture]
+   (load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1)))
+  ([filename map-kind superstructure scale-vertex]
+   (let [mw (try
+              (with-open [r (io/reader filename)]
+                (edn/read (java.io.PushbackReader. r)))
+              (catch RuntimeException e
+                (l/error "Error parsing edn file '%s': %s\n"
+                         filename (.getMessage e))))
+         polys (reduce
+                 concat
+                 (map (fn [row] (map cell->polygon row)) mw))]
+     (if (map? superstructure)
+       (reduce
+         #(store %2 %1)
+         superstructure
+         polys)
+       polys))))
+
+;; (load-microworld-edn "../MicroWorld/mw-cli/isle_of_man.edn" nil {})

src/walkmap/polygon.clj

@@ -4,7 +4,7 @@
             [walkmap.edge :as e]
             [walkmap.tag :as t]
             [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
-            [walkmap.vertex :refer [check-vertices vertex vertex?]]))
+            [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]]))
 
 (defn polygon?
   "True if `o` satisfies the conditions for a polygon. A polygon shall be a
@@ -52,9 +52,30 @@
 (defn polygon
   "Return a polygon constructed from these `vertices`."
   [& vertices]
-  {:vertices (check-vertices vertices)
-   :walkmap.id/id (keyword (gensym "poly"))
-   :kind :polygon})
+  (if
+    (> (count vertices) 2)
+    {:vertices (check-vertices vertices)
+     :walkmap.id/id (keyword (gensym "poly"))
+     :kind :polygon}
+    (throw (IllegalArgumentException.
+             "A polygon must have at least 3 vertices."))))
+
+(defn rectangle
+  "Return a rectangle, with edges aligned east-west and north-south, whose
+  south-west corner is the vertex `vsw` and whose north-east corner is the
+  vertex `vne`."
+  [vsw vne]
+  ;; we can actually create any rectangle in the xy plane based on two opposite
+  ;; corners, but the maths are a bit to advanced for me today. TODO: do it!
+  (let [vnw (vertex (:x (check-vertex vsw))
+                    (:y (check-vertex vne))
+                    (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))
+        vse (vertex (:x vne)
+                    (:y vsw)
+                    (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))]
+    (t/tag (polygon vsw vnw vne vse) :rectangle)))
+
+;; (rectangle (vertex 1 2 3) (vertex 7 9 4))
 
 (defn gradient
   "Return a polygon like `triangle` but with a key `:gradient` whose value is a

src/walkmap/tag.clj

@@ -65,4 +65,4 @@
     (when-not (every? keyword? tags')
       (throw (IllegalArgumentException.
                (str "Must be keywords: " (map kind-type tags')))))
-    (assoc object ::tags (difference (::tags object) (set tags')))))
+    (update-in object [:walkmap.tag/tags] difference (set tags'))))

src/walkmap/utils.clj

@@ -31,11 +31,11 @@
 
 (defn =ish
   "True if numbers `n1`, `n2` are roughly equal; that is to say, equal to
-  within `tolerance` (defaults to one part in a million)."
+  within `tolerance` (defaults to one part in one hundred thousand)."
   ([n1 n2]
    (if (and (number? n1) (number? n2))
      (let [m (m/abs (min n1 n2))
-           t (if (zero? m) 0.000001 (* 0.000001 m))]
+           t (if (zero? m) 0.00001 (* 0.00001 m))]
        (=ish n1 n2 t))
      (= n1 n2)))
   ([n1 n2 tolerance]

src/walkmap/vertex.clj

@@ -76,13 +76,11 @@
   by the equivalent vertex in `v2`. It is an error, and an exception will
   be thrown, if either `v1` or `v2` is not a vertex."
   [v1 v2]
-  (check-vertex v1)
-  (check-vertex v2)
   (let [f (fn [v1 v2 coord]
             (* (or (coord v1) 0)
                ;; one here is deliberate!
                (or (coord v2) 1)))]
-    (assoc v1 :x (f v1 v2 :x)
+    (assoc v1 :x (f (check-vertex v1) (check-vertex v2) :x)
       :y (f v1 v2 :y)
       :z (f v1 v2 :z))))
 
@@ -142,8 +140,12 @@
   arguments must be vertices; additionally, both `minv` and `maxv` must
   have `:z` coordinates."
   [target minv maxv]
-  (check-vertices [target minv maxv])
-  (every?
-    (map
-      #(< (% minv) (or (% target) 0) (% maxv))
-      [:x :y :z])))
+  (do
+    (check-vertices [target minv maxv])
+    (every?
+      true?
+      (map
+        #(if (% target)
+           (<= (% minv) (% target) (% maxv))
+           true)
+        [:x :y :z]))))