From 3ba8033be883eb3c8f32bdc35cc3d1278e824903 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 3 Jun 2020 15:48:12 +0100 Subject: [PATCH] Started MicroWorld integration; more work on unit tests --- .gitignore | 2 + docs/cloverage/index.html | 117 ++++--- docs/cloverage/walkmap/microworld.clj.html | 293 ++++++++++++++++++ docs/cloverage/walkmap/polygon.clj.html | 139 ++++++--- docs/cloverage/walkmap/stl.clj.html | 2 +- .../cloverage/walkmap/superstructure.clj.html | 2 +- docs/cloverage/walkmap/svg.clj.html | 4 +- docs/cloverage/walkmap/tag.clj.html | 6 +- docs/cloverage/walkmap/utils.clj.html | 6 +- docs/cloverage/walkmap/vertex.clj.html | 273 ++++++++-------- project.clj | 3 + resources/rules/settlement_rules.txt | 155 +++++++++ src/walkmap/microworld.clj | 95 ++++++ src/walkmap/polygon.clj | 29 +- src/walkmap/tag.clj | 2 +- src/walkmap/utils.clj | 4 +- src/walkmap/vertex.clj | 18 +- test/walkmap/path_test.clj | 38 +-- test/walkmap/vertex_test.clj | 113 ++++++- 19 files changed, 1023 insertions(+), 278 deletions(-) create mode 100644 docs/cloverage/walkmap/microworld.clj.html create mode 100644 resources/rules/settlement_rules.txt create mode 100644 src/walkmap/microworld.clj diff --git a/.gitignore b/.gitignore index b81df1f..f747809 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,5 @@ resources/isle_of_man.svg resources/small_hill.svg s.edn + +.eastwood diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index ff0a0f9..93248aa 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -40,6 +40,21 @@ 100.00 % 822 + + walkmap.microworld
3
167
+1.76 % +
3
37
+7.50 % +95840 + walkmap.ocean
walkmap.polygon
327
29
-91.85 % + style="width:71.45969498910675%; + float:left;"> 328
131
+71.46 %
43
5
-100.00 % -971148 + style="width:10.714285714285714%; + float:left;"> 6
7
+87.50 % +1141356 walkmap.read-svg
walkmap.stl
238
232
-50.64 % + style="width:50.92783505154639%; + float:left;"> 247
+49.07 %
43
walkmap.superstructure
257
272
107
-70.60 % +71.77 %
62
walkmap.svg
11
250
-4.21 % + style="width:96.24573378839591%; + float:left;"> 282
+3.75 %
8
walkmap.tag
162
+ float:left;"> 178
100.00 %
walkmap.utils
400
356
-52.91 % + style="width:56.216931216931215%; + float:left;"> 425
331
+56.22 %
23
3
10
-72.22 % + style="width:69.44444444444444%; + float:left;"> 25
4
7
+80.56 % 101936 walkmap.vertex
380
170
-69.09 % + style="width:86.52094717668488%; + float:left;"> 475
74
+86.52 %
46
15
12
-83.56 % -1491573 + style="width:82.1917808219178%; + float:left;"> 60
11
2
+97.26 % +1501573 Totals: -66.22 % +64.52 % -70.05 % +67.67 % diff --git a/docs/cloverage/walkmap/microworld.clj.html b/docs/cloverage/walkmap/microworld.clj.html new file mode 100644 index 0000000..839c56b --- /dev/null +++ b/docs/cloverage/walkmap/microworld.clj.html @@ -0,0 +1,293 @@ + + + + walkmap/microworld.clj + + + + 001  (ns walkmap.microworld +
+ + 002    "An interface between walkmap and microworld, to allow use of microworld +
+ + 003    functionality to model things like rainfall, soil fertility, settlement +
+ + 004    and so on." +
+ + 005    (:require [clojure.edn :as edn :only [read]] +
+ + 006              [clojure.java.io :as io] +
+ + 007              [clojure.string :as s] +
+ + 008              [mw-cli.core :refer [process]] +
+ + 009              [mw-engine.core :refer [run-world]] +
+ + 010              [mw-engine.heightmap :as h] +
+ + 011              [mw-engine.drainage :as d] +
+ + 012              [mw-parser.bulk :as parser] +
+ + 013              [taoensso.timbre :as l] +
+ + 014              [walkmap.edge :as e] +
+ + 015              [walkmap.polygon :as p :only [check-polygon polygon? rectangle]] +
+ + 016              [walkmap.superstructure :refer [store]] +
+ + 017              [walkmap.tag :as t :only [tag tags]] +
+ + 018              [walkmap.utils :as u :only [check-kind-type check-kind-type-seq kind-type truncate]] +
+ + 019              [walkmap.vertex :as v :only [vertex vertex?]])) +
+ + 020   +
+ + 021  ;; (def settlement-rules (parser/compile-file "resources/rules/settlement_rules.txt")) +
+ + 022   +
+ + 023  ;; (def w0 (h/apply-heightmap "../the-great-game/resources/maps/heightmap.png")) +
+ + 024  ;; (def w1 (d/rain-world (d/flood-hollows w0))) +
+ + 025  ;; (def w2 (drainage/flow-world-nr w1)) +
+ + 026   +
+ + 027  ;; (def w3 (run-world w2 nil settlement-rules 100)) +
+ + 028   +
+ + 029  ;; (with-open [w (clojure.java.io/writer "settlement_1.edn")] +
+ + 030  ;;   (binding [*out* w] +
+ + 031  ;;     (pr +
+ + 032  ;;       (run-world w0 nil settlement-rules 100)))) +
+ + 033   +
+ + 034  ;; (process +
+ + 035  ;;   (h/apply-heightmap "resources/small_hill.png") +
+ + 036  ;;   (parser/compile-file "resources/rules/settlement_rules.txt") +
+ + 037  ;;   100 +
+ + 038  ;;   "small_hill.edn" +
+ + 039  ;;   "small_hill.html") +
+ + 040   +
+ + 041  (defn cell->polygon +
+ + 042    ([cell] +
+ + 043     (cell->polygon cell (v/vertex 1 1 1))) +
+ + 044    ([cell scale-vector] +
+ + 045     (t/tag +
+ + 046       (assoc +
+ + 047         (merge +
+ + 048           cell +
+ + 049           (let [w (* (:x cell) (:x scale-vector)) +
+ + 050                 s (* (:y cell) (:y scale-vector)) +
+ + 051                 e (+ w (:x scale-vector)) +
+ + 052                 n (+ s (:y scale-vector)) +
+ + 053                 z (* (:altitude cell) (:z scale-vector))] +
+ + 054           (p/rectangle +
+ + 055             (v/vertex s w z) +
+ + 056             (v/vertex n e z)))) +
+ + 057         :walkmap.id/id +
+ + 058         (keyword (gensym "mw-cell"))) +
+ + 059       (:state cell)))) +
+ + 060   +
+ + 061  (defn load-microworld-edn +
+ + 062    "While it would be possible to call MicroWorld functions directly from +
+ + 063    Walkmap, the fact is that running MicroWorld is so phenomenally +
+ + 064    compute-heavy that it's much more sensible to do it in batch mode. So the +
+ + 065    better plan is to be able to pull the output from MicroWorld - as an EDN +
+ + 066    structure - into a walkmap superstructure." +
+ + 067    ([filename] +
+ + 068     (load-microworld-edn filename :mw)) +
+ + 069    ([filename map-kind] +
+ + 070     (when-not +
+ + 071       (keyword? map-kind) +
+ + 072       (throw (IllegalArgumentException. +
+ + 073                (u/truncate +
+ + 074                  (str "Must be a keyword: " (or map-kind "nil")) 80)))) +
+ + 075     (load-microworld-edn filename map-kind nil)) +
+ + 076    ([filename mapkind superstucture] +
+ + 077     (load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1))) +
+ + 078    ([filename map-kind superstructure scale-vertex] +
+ + 079     (let [mw (try +
+ + 080                (with-open [r (io/reader filename)] +
+ + 081                  (edn/read (java.io.PushbackReader. r))) +
+ + 082                (catch RuntimeException e +
+ + 083                  (l/error "Error parsing edn file '%s': %s\n" +
+ + 084                           filename (.getMessage e)))) +
+ + 085           polys (reduce +
+ + 086                   concat +
+ + 087                   (map (fn [row] (map cell->polygon row)) mw))] +
+ + 088       (if (map? superstructure) +
+ + 089         (reduce +
+ + 090           #(store %2 %1) +
+ + 091           superstructure +
+ + 092           polys) +
+ + 093         polys)))) +
+ + 094   +
+ + 095  ;; (load-microworld-edn "../MicroWorld/mw-cli/isle_of_man.edn" nil {}) +
+ + diff --git a/docs/cloverage/walkmap/polygon.clj.html b/docs/cloverage/walkmap/polygon.clj.html index e8f3084..c3b5f51 100644 --- a/docs/cloverage/walkmap/polygon.clj.html +++ b/docs/cloverage/walkmap/polygon.clj.html @@ -23,7 +23,7 @@ 006              [walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
- 007              [walkmap.vertex :refer [check-vertices vertex vertex?]])) + 007              [walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]]))
008   @@ -139,7 +139,7 @@ 045  (defmacro check-triangle
- + 046    "If `o` is not a triangle, throw an `IllegalArgumentException` with an
@@ -154,7 +154,7 @@ 050    `(check-kind-type ~o triangle? :triangle))
- + 051  
@@ -179,121 +179,172 @@ 058  
- 059  (defn gradient + 059  (defn rectangle
- 060    "Return a polygon like `triangle` but with a key `:gradient` whose value is a + 060    "Return a rectangle, with edges aligned east-west and north-south, whose
- 061    unit vector representing the gradient across `triangle`." + 061    south-west corner is the vertex `vsw` and whose north-east corner is the
- 062    [triangle] + 062    vertex `vne`." +
+ + 063    [vsw vne] +
+ + 064    ;; we can actually create any rectangle in the xy plane based on two opposite +
+ + 065    ;; corners, but the maths are a bit to advanced for me today. TODO: do it! +
+ + 066    (let [vnw (vertex (:x (check-vertex vsw)) +
+ + 067                      (:y (check-vertex vne)) +
+ + 068                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2)) +
+ + 069          vse (vertex (:x vne) +
+ + 070                      (:y vsw) +
+ + 071                      (/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))] +
+ + 072      (t/tag (polygon vsw vnw vne vse) :rectangle))) +
+ + 073   +
+ + 074  ;; (rectangle (vertex 1 2 3) (vertex 7 9 4)) +
+ + 075   +
+ + 076  (defn gradient +
+ + 077    "Return a polygon like `triangle` but with a key `:gradient` whose value is a +
+ + 078    unit vector representing the gradient across `triangle`." +
+ + 079    [triangle]
- 063    (let [order (sort #(max (:z %1) (:z %2)) + 080    (let [order (sort #(max (:z %1) (:z %2))
- 064                      (:vertices (check-triangle triangle))) + 081                      (:vertices (check-triangle triangle)))
- 065          highest (first order) + 082          highest (first order)
- 066          lowest (last order)] + 083          lowest (last order)]
- 067       (assoc triangle :gradient (e/unit-vector (e/edge lowest highest))))) + 084       (assoc triangle :gradient (e/unit-vector (e/edge lowest highest)))))
- 068   + 085  
- 069  (defn triangle-centre -
- - 070    "Return a canonicalised `facet` (i.e. a triangular polygon) with an added + 086  (defn triangle-centre
- 071    key `:centre` whose value represents the centre of this facet in 3 + 087    "Return a canonicalised `facet` (i.e. a triangular polygon) with an added
- 072    dimensions. This only works for triangles, so is here not in + 088    key `:centre` whose value represents the centre of this facet in 3
- 073    `walkmap.polygon`. It is an error (although no exception is currently + 089    dimensions. This only works for triangles, so is here not in
- 074    thrown) if the object past is not a triangular polygon." + 090    `walkmap.polygon`. It is an error (although no exception is currently
- 075    [facet] + 091    thrown) if the object past is not a triangular polygon." +
+ + 092    [facet]
- 076    (let [vs (:vertices (check-triangle facet)) + 093    (let [vs (:vertices (check-triangle facet))
- 077          v1 (first vs) + 094          v1 (first vs)
- 078          opposite (e/edge (nth vs 1) (nth vs 2)) + 095          opposite (e/edge (nth vs 1) (nth vs 2))
- 079          oc (e/centre opposite)] + 096          oc (e/centre opposite)]
- 080        (assoc + 097        (assoc
- 081        facet + 098        facet
- 082        :centre + 099        :centre
- 083        (vertex + 100        (vertex
- 084          (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3)) + 101          (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
- 085          (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3)) + 102          (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
- 086          (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3)))))) + 103          (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
- 087   + 104  
- 088  (defn centre + 105  (defn centre
- 089    [poly] + 106    [poly]
- 090    (case (count (:vertices (check-polygon poly))) + 107    (case (count (:vertices (check-polygon poly)))
- 091      3 (triangle-centre poly) + 108      3 (triangle-centre poly)
- 092      ;; else + 109      ;; else
- 093      (throw + 110      (throw
- 094        (UnsupportedOperationException. + 111        (UnsupportedOperationException.
- 095          "The general case of centre for polygons is not yet implemented.")))) + 112          "The general case of centre for polygons is not yet implemented."))))
- 096   + 113  
- 097   + 114  
diff --git a/docs/cloverage/walkmap/stl.clj.html b/docs/cloverage/walkmap/stl.clj.html index ff71dd2..5240aa8 100644 --- a/docs/cloverage/walkmap/stl.clj.html +++ b/docs/cloverage/walkmap/stl.clj.html @@ -550,7 +550,7 @@ 182    ([filename stl solidname]
- + 183     (l/debug "Solid name is " solidname)
diff --git a/docs/cloverage/walkmap/superstructure.clj.html b/docs/cloverage/walkmap/superstructure.clj.html index 229b2b9..a83ad6d 100644 --- a/docs/cloverage/walkmap/superstructure.clj.html +++ b/docs/cloverage/walkmap/superstructure.clj.html @@ -355,7 +355,7 @@ 117    ([o s]
- + 118     (l/debug "Finding objects in:" o)
diff --git a/docs/cloverage/walkmap/svg.clj.html b/docs/cloverage/walkmap/svg.clj.html index 29fe91d..c04a8b4 100644 --- a/docs/cloverage/walkmap/svg.clj.html +++ b/docs/cloverage/walkmap/svg.clj.html @@ -274,7 +274,7 @@ 090                   (:facets stl)))]
- + 091      (l/info "Generating SVG for " *preferred-svg-render* " renderer")
@@ -316,7 +316,7 @@ 104     (let [s (binary-stl-file->svg in-filename)]
- + 105       (l/info "Emitting SVG with " *preferred-svg-render* " renderer")
diff --git a/docs/cloverage/walkmap/tag.clj.html b/docs/cloverage/walkmap/tag.clj.html index dddaf4e..d26ce5f 100644 --- a/docs/cloverage/walkmap/tag.clj.html +++ b/docs/cloverage/walkmap/tag.clj.html @@ -118,7 +118,7 @@ 038    [object & tags]
- + 039    (l/debug "Tagging" (kind-type object) "with" tags)
@@ -205,8 +205,8 @@ 067                 (str "Must be keywords: " (map kind-type tags')))))
- - 068      (assoc object ::tags (difference (::tags object) (set tags'))))) + + 068      (update-in object [:walkmap.tag/tags] difference (set tags'))))
diff --git a/docs/cloverage/walkmap/utils.clj.html b/docs/cloverage/walkmap/utils.clj.html index 217b039..84e02ec 100644 --- a/docs/cloverage/walkmap/utils.clj.html +++ b/docs/cloverage/walkmap/utils.clj.html @@ -61,13 +61,13 @@ 019    [s n]
- + 020    (if (and (string? s) (number? n) (> (count s) n))
- + 021      (subs s 0 n)
- + 022      s))
diff --git a/docs/cloverage/walkmap/vertex.clj.html b/docs/cloverage/walkmap/vertex.clj.html index 27eac17..b1ca90f 100644 --- a/docs/cloverage/walkmap/vertex.clj.html +++ b/docs/cloverage/walkmap/vertex.clj.html @@ -139,7 +139,7 @@ 045      (:walkmap.id/id o)
- + 046      (number? (:x o))
@@ -175,7 +175,7 @@ 057  
- + 058  (defmacro check-vertices
@@ -208,10 +208,10 @@ 068    (check-vertex v1)
- + 069    (check-vertex v2)
- + 070    (every?
@@ -238,218 +238,221 @@ 078    [v1 v2]
- - 079    (check-vertex v1) -
- - 080    (check-vertex v2) -
- 081    (let [f (fn [v1 v2 coord] -
- - 082              (* (or (coord v1) 0) -
- - 083                 ;; one here is deliberate! -
- - 084                 (or (coord v2) 1)))] -
- - 085      (assoc v1 :x (f v1 v2 :x) -
- - 086        :y (f v1 v2 :y) -
- - 087        :z (f v1 v2 :z)))) -
- - 088   -
- - 089  (defn vertex -
- - 090    "Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map -
- - 091    with those values, plus a unique `:walkmap.id/id` value, and `:kind` set to `:vertex`. -
- - 092    It's not necessary to use this function to create a vertex, but the `:walkmap.id/id` -
- - 093    must be present and must be unique." -
- - 094    ([x y] -
- - 095     (let [v {:x x :y y :kind :vertex}] -
- - 096       (assoc v :walkmap.id/id (vertex-key v)))) -
- - 097    ([x y z] + 079    (let [f (fn [v1 v2 coord]
- 098     (let [v {:x x :y y :z z :kind :vertex}] + 080              (* (or (coord v1) 0) +
+ + 081                 ;; one here is deliberate! +
+ + 082                 (or (coord v2) 1)))] +
+ + 083      (assoc v1 :x (f (check-vertex v1) (check-vertex v2) :x) +
+ + 084        :y (f v1 v2 :y) +
+ + 085        :z (f v1 v2 :z)))) +
+ + 086   +
+ + 087  (defn vertex +
+ + 088    "Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map +
+ + 089    with those values, plus a unique `:walkmap.id/id` value, and `:kind` set to `:vertex`. +
+ + 090    It's not necessary to use this function to create a vertex, but the `:walkmap.id/id` +
+ + 091    must be present and must be unique." +
+ + 092    ([x y] +
+ + 093     (let [v {:x x :y y :kind :vertex}]
- 099       (assoc v :walkmap.id/id (vertex-key v))))) + 094       (assoc v :walkmap.id/id (vertex-key v)))) +
+ + 095    ([x y z] +
+ + 096     (let [v {:x x :y y :z z :kind :vertex}] +
+ + 097       (assoc v :walkmap.id/id (vertex-key v)))))
- 100   + 098  
- 101  (defn canonicalise + 099  (defn canonicalise
- 102    "If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`, + 100    "If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`,
- 103    upgrade it to something we will recognise as a vertex." + 101    upgrade it to something we will recognise as a vertex."
- 104    [o] + 102    [o]
- 105    (if + 103    (if
- - 106      (and + + 104      (and
- 107        (map? o) + 105        (map? o)
- 108        (number? (:x o)) + 106        (number? (:x o))
- 109        (number? (:y o)) + 107        (number? (:y o))
- 110        (or (nil? (:z o)) (number? (:z o)))) + 108        (or (nil? (:z o)) (number? (:z o))))
- 111      (assoc o :kind :vertex :walkmap.id/id (vertex-key o)) -
- - 112      (throw -
- - 113        (IllegalArgumentException. -
- - 114          (truncate -
- - 115            (str "Not a proto-vertex: must have numeric `:x` and `:y`: " -
- - 116                 (or o "nil")) -
- - 117            80))))) -
- - 118   + 109      (assoc o :kind :vertex :walkmap.id/id (vertex-key o))
- 119  (def ensure3d + 110      (throw +
+ + 111        (IllegalArgumentException. +
+ + 112          (truncate +
+ + 113            (str "Not a proto-vertex: must have numeric `:x` and `:y`: " +
+ + 114                 (or o "nil"))
- 120    "Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise -
- - 121    return a vertex like `o` but having this `dflt` value as the value of its -
- - 122    `:z` key, or zero as the value of its `:z` key if `dflt` is not specified. + 115            80)))))
- 123   + 116   +
+ + 117  (def ensure3d
- 124    If `o` is not a vertex, throws an exception." + 118    "Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise +
+ + 119    return a vertex like `o` but having this `dflt` value as the value of its +
+ + 120    `:z` key, or zero as the value of its `:z` key if `dflt` is not specified. +
+ + 121   +
+ + 122    If `o` is not a vertex, throws an exception."
- 125    (memoize + 123    (memoize
- 126      (fn + 124      (fn
- 127        ([o] + 125        ([o]
- 128         (ensure3d o 0.0)) + 126         (ensure3d o 0.0))
- 129        ([o dflt] + 127        ([o dflt]
- 130         (if (:z (check-vertex o)) + 128         (if (:z (check-vertex o))
- 131           o + 129           o
- 132           (assoc o :z dflt)))))) + 130           (assoc o :z dflt))))))
- 133   + 131  
- 134  (def ensure2d + 132  (def ensure2d
- 135    "If `o` is a vertex, set its `:z` value to zero; else throw an exception." + 133    "If `o` is a vertex, set its `:z` value to zero; else throw an exception."
- 136    (memoize + 134    (memoize
- 137      (fn [o] + 135      (fn [o]
- 138        (assoc (check-vertex o) :z 0.0)))) + 136        (assoc (check-vertex o) :z 0.0))))
- 139   + 137  
- 140  (defn within-box? + 138  (defn within-box?
- 141    "True if `target` is within the box defined by `minv` and `maxv`. All + 139    "True if `target` is within the box defined by `minv` and `maxv`. All
- 142    arguments must be vertices; additionally, both `minv` and `maxv` must + 140    arguments must be vertices; additionally, both `minv` and `maxv` must
- 143    have `:z` coordinates." + 141    have `:z` coordinates."
- 144    [target minv maxv] + 142    [target minv maxv]
- - 145    (check-vertices [target minv maxv]) + + 143    (check-vertices [target minv maxv])
- - 146    (every? + + 144    (every?
- - 147      (map + + 145      true?
- - 148        #(< (% minv) (or (% target) 0) (% maxv)) + + 146      (map
- - 149        [:x :y :z]))) + + 147        #(if (% target) +
+ + 148           (<= (% minv) (% target) (% maxv)) +
+ + 149           true) +
+ + 150        [:x :y :z])))
diff --git a/project.clj b/project.clj index b0f66d6..4ac438a 100644 --- a/project.clj +++ b/project.clj @@ -13,6 +13,9 @@ [dali "0.7.4"] ;; not currently used because performance issues. [hiccup "1.0.5"] [me.raynes/fs "1.4.6"] + [mw-cli "0.1.6-SNAPSHOT"] + [mw-engine "0.1.6-SNAPSHOT"] + [mw-parser "0.1.6-SNAPSHOT"] [smee/binary "0.5.5"]] :deploy-repositories [["releases" :clojars] ["snapshots" :clojars]] diff --git a/resources/rules/settlement_rules.txt b/resources/rules/settlement_rules.txt new file mode 100644 index 0000000..22b9be3 --- /dev/null +++ b/resources/rules/settlement_rules.txt @@ -0,0 +1,155 @@ +# Human settlement + +;; This rule set attempts to model human settlement in a landscape. It models +;; western European pre-history moderately well. Settlement first occurs as +;; nomadic camps on coastal promentaries (cells with four or more neighbours +;; that are water). This represents 'kitchen-midden' mesolithic settlement. +;; +;; As grassland becomes available near camps, pastoralists appear, and will +;; follow their herds inland. When pastoralists have available fertile land, +;; they will till the soil and plant crops, and in doing so will establish +;; permanent settlements; this is approximately a neolithic stage. +;; +;; Where soil is fertile, settlements will cluster, and markets will appear. +;; where there is sufficient settlement, the markets become permanent, and you +;; have the appearance of towns. This takes us roughly into the bronze age. +;; +;; This is quite a complex ruleset, and runs quite slowly. However, it does +;; model some significant things. Soil gains in fertility under woodland; deep +;; loams and podzols build up over substantial time. Agriculture depletes +;; fertility. So if forest has become well established before human settlement +;; begins, a higher population (more crops) will eventually be sustainable, +;; whereas if human population starts early the deep fertile soils will not +;; establish and you will have more pastoralism, supporting fewer permanent +;; settlements. + +;; hack to speed up processing on the 'great britain and ireland' map +if state is water then state should be water + +;; nomads make their first significant camp near water because of fish and +;; shellfish (kitchen-midden people) +if state is in grassland or heath and more than 3 neighbours are water and generation is more than 20 then state should be camp + +;; sooner or later nomads learn to keep flocks +if state is in grassland or heath and some neighbours are camp then 1 chance in 2 state should be pasture + +;; and more herds support more people +if state is in grassland or heath and more than 2 neighbours are pasture then 1 chance in 3 state should be camp +if state is pasture and more than 3 neighbours are pasture and fewer than 1 neighbours are camp and fewer than 1 neighbours within 2 are house then state should be camp + +;; the idea of agriculture spreads +if state is in grassland or heath and some neighbours within 2 are house then state should be pasture + +;; nomads don't move on while the have crops growing. That would be silly! +if state is camp and some neighbours are ploughland then state should be camp + +;; Impoverished pasture can't be grazed permanently +if state is pasture and fertility is less than 2 then 1 chance in 3 state should be heath + +;; nomads move on +if state is camp then 1 chance in 5 state should be waste + +;; pasture that's too far from a house or camp will be abandoned +if state is pasture and fewer than 1 neighbours within 3 are house and fewer than 1 neighbours within 2 are camp then state should be heath + +;; markets spring up near settlements +if state is in grassland or pasture and more than 1 neighbours are house then 1 chance in 10 state should be market + +;; good fertile pasture close to settlement will be ploughed for crops +if state is pasture and fertility is more than 10 and altitude is less than 100 and some neighbours are camp or some neighbours are house then state should be ploughland + +if state is ploughland then state should be crop + +;; after the crop is harvested, the land is allowed to lie fallow. But cropping +;; depletes fertility. +if state is crop then state should be grassland and fertility should be fertility - 1 + +;; if there's reliable food available, nomads build permanent settlements +if state is in camp or abandoned and some neighbours are crop then state should be house +if state is abandoned and some neighbours are pasture then state should be house +;; people camp near to markets +if state is in waste or grassland and some neighbours are market then state should be camp + +;; a market in a settlement survives +if state is market and some neighbours are inn then state should be market +if state is market then state should be grassland + +;; a house near a market in a settlement will become an inn +if state is house and some neighbours are market and more than 1 neighbours are house then 1 chance in 5 state should be inn +;; but it will need some local custom to survive +if state is inn and fewer than 3 neighbours are house then state should be house + +;; if there aren't enough resources houses should be abandoned +;; resources from fishing +if state is house and more than 2 neighbours are water then state should be house +;; from farming +if state is house and some neighbours are pasture then state should be house +if state is house and some neighbours are ploughland then state should be house +if state is house and some neighbours are crop then state should be house +;; from the market +if state is house and some neighbours are market then state should be house +if state is house then 1 chance in 2 state should be abandoned +if state is abandoned then 1 chance in 5 state should be waste + + +## Vegetation rules +;; rules which populate the world with plants + +;; Occasionally, passing birds plant tree seeds into grassland + +if state is grassland then 1 chance in 10 state should be heath + +;; heath below the treeline grows gradually into forest + +if state is heath and altitude is less than 120 then state should be scrub +if state is scrub then 1 chance in 5 state should be forest + +;; Forest on fertile land grows to climax + +if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax + +;; Climax forest occasionally catches fire (e.g. lightning strikes) + +if state is climax then 1 chance in 500 state should be fire + +;; Forest neighbouring fires is likely to catch fire. So are buildings. +if state is in forest or climax or camp or house or inn and some neighbours are fire then 1 chance in 3 state should be fire + +;; Climax forest near to settlement may be cleared for timber +if state is in climax and more than 3 neighbours within 2 are house then state should be scrub + +;; After fire we get waste + +if state is fire then state should be waste + +;; waste near settlement that is fertile becomes ploughland +if state is waste and fertility is more than 10 and some neighbours are house or some neighbours are camp then state should be ploughland + +;; And after waste we get pioneer species; if there's a woodland seed +;; source, it's going to be heath, otherwise grassland. + +if state is waste and some neighbours are scrub then state should be heath +if state is waste and some neighbours are forest then state should be heath +if state is waste and some neighbours are climax then state should be heath +if state is waste then state should be grassland + + +## Potential blockers + +;; Forest increases soil fertility. +if state is in forest or climax then fertility should be fertility + 1 + +## Initialisation rules + +;; Rules which deal with state 'new' will waste less time if they're near the +;; end of the file + +;; below the waterline we have water. + +if state is new and altitude is less than 10 then state should be water + +;; above the snowline we have snow. +if state is new and altitude is more than 200 then state should be snow + +;; otherwise, we have grassland. +if state is new then state should be grassland diff --git a/src/walkmap/microworld.clj b/src/walkmap/microworld.clj new file mode 100644 index 0000000..43d5684 --- /dev/null +++ b/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 {}) diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj index 5b0ce79..d5bd83a 100644 --- a/src/walkmap/polygon.clj +++ b/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 diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj index 0df4ade..39c0dca 100644 --- a/src/walkmap/tag.clj +++ b/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')))) diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj index 2343eff..1295676 100644 --- a/src/walkmap/utils.clj +++ b/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] diff --git a/src/walkmap/vertex.clj b/src/walkmap/vertex.clj index 4fb8555..19a016a 100644 --- a/src/walkmap/vertex.clj +++ b/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])))) diff --git a/test/walkmap/path_test.clj b/test/walkmap/path_test.clj index 5d66c6c..31523a2 100644 --- a/test/walkmap/path_test.clj +++ b/test/walkmap/path_test.clj @@ -19,7 +19,7 @@ (check-path (update-in (path (vertex 0 0 0) (vertex 1 1 1)) - :vertices + [:vertices] conj "Not a vertex"))) "Checking an invalid path should throw an exception.") @@ -42,10 +42,10 @@ (let [poly (polygon (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0)) p (polygon->path poly)] (is (path? p) "Should be a path.") - (is (vertex= (first p) (last p)) + (is (vertex= (first (:vertices p)) (last (:vertices p))) "First and last vertices of the generated path should be equal to one another.") - (is (= (count (:vertices path)) (inc (count (:vertices poly)))) + (is (= (count (:vertices p)) (inc (count (:vertices poly)))) "The generated path should have one more vertex than the polygon.") (map #(is (vertex= (nth (:vertices poly) %) (nth (:vertices p) %)) @@ -58,21 +58,23 @@ "Every returned edge should be an edge.") (is (= (count (:vertices poly)) (count edges)) "There should be the same number of edges as the vertices of the polygon") - (map - #(is - (vertex= (nth (:vertices poly) %) (:start (nth edges %))) - (str - "Each edge should start from the same place as the corresponding - vertex: " %)) - (range (count (:vertices poly)))) - (map - #(is - (vertex= (nth (:vertices poly) (mod (inc %) (count (:vertices poly)))) - (:end (nth edges %))) - (str - "Each edge should end at the same place as the subsequent - vertex: " %)) - (range (count (:vertices poly))))) + (doall + (map + #(is + (vertex= (nth (:vertices poly) %) (:start (nth edges %))) + (str + "Each edge should start from the same place as the corresponding + vertex: " %)) + (range (count (:vertices poly))))) + (doall + (map + #(is + (vertex= (nth (:vertices poly) (mod (inc %) (count (:vertices poly)))) + (:end (nth edges %))) + (str + "Each edge should end at the same place as the subsequent + vertex: " %)) + (range (count (:vertices poly)))))) (is (thrown? IllegalArgumentException (path->edges "Not a legal argument."))))) diff --git a/test/walkmap/vertex_test.clj b/test/walkmap/vertex_test.clj index dbdbb30..b6b26ef 100644 --- a/test/walkmap/vertex_test.clj +++ b/test/walkmap/vertex_test.clj @@ -1,5 +1,6 @@ -(ns walkmap.utils-test +(ns walkmap.vertex-test (:require [clojure.test :refer :all] + [walkmap.utils :refer [=ish kind-type]] [walkmap.vertex :refer :all])) (deftest vertex-equal-tests @@ -8,7 +9,7 @@ "should be equal") (is (vertex= (vertex 0 0 0) (vertex 0.0000001 0 0)) "differences less than one part in a million should be ignored") - (is (vertex= (vertex 0 0 0) (vertex 0 0 1)) + (is (false? (vertex= (vertex 0 0 0) (vertex 0 0 1))) "should not be equal") (is (thrown? IllegalArgumentException (vertex= (vertex 0 0 0) "Not a vertex")) @@ -28,18 +29,118 @@ (is (vertex= expected v') "Multiplication by values other than {:x 1 :y 1 :z 1} should change the vertex")) - (let [v (vertex 0.333333 0.25 0.2) + (let [v (vertex 0.3333333 0.25 0.2) d (vertex 3 4) v' (vertex* v d) expected (vertex 1 1 0.2)] (is (vertex= expected v') "Multiplication by a 2D vertex should not change `:z`")) - (let [v (vertex 0.333333 0.25) + (let [v (vertex 0.3333333 0.25) d (vertex 3 4) v' (vertex* v d) expected (vertex 1 1 0)] - (is (vertex= expected v') + (is (=ish 0 (:z v')) "Multiplication of a 2D vertex should result in `:z` = zero")) + (is (thrown? IllegalArgumentException + (vertex* 3 (vertex 0 0 0))) + "Exception should be thrown: not a vertex (1st arg).") (is (thrown? IllegalArgumentException (vertex* (vertex 0 0 0) "Not a vertex")) - "Exception should be thrown: not a vertex."))) + "Exception should be thrown: not a vertex (2nd arg)."))) + +(deftest canonicalise-tests + (testing "Canonicalisation of vertices." + (is (thrown? IllegalArgumentException + (canonicalise {:x "3" :y 4})) + "Exception should be thrown: not a number (`:x` coord).") + (is (thrown? IllegalArgumentException + (canonicalise {:x 3 :y :Jam})) + "Exception should be thrown: not a number (`:y` coord).") + (is (thrown? IllegalArgumentException + (canonicalise {:x 3 :y :4 :z {:foo "bar"}})) + "Exception should be thrown: not a number (`:z` coord).") + (let [v (canonicalise {:x 3 :y 4})] + (is + (= (:walkmap.id/id v) + (keyword (str "vert_" (:x v) "_" (:y v)))) + "Vertex ids should match the expected pattern.") + (is (= (kind-type v) :vertex) + "A canonicalised 2d vertex should have the kind `:vertex`.") + (is (vertex? v) + "A canonicalised 2d vertex should be recognisable as a vertex.")) + (let [v (canonicalise {:x 3 :y 4 :z 5})] + (is + (= (:walkmap.id/id v) + (keyword (str "vert_" (:x v) "_" (:y v) "_" (:z v)))) + "Vertex ids should match the expected pattern.") + (is (= (kind-type v) :vertex) + "A canonicalised 3d vertex should have the kind `:vertex`.") + (is (vertex? v) + "A canonicalised 3d vertex should be recognisable as a vertex.")))) + +(deftest ensure3d-tests + (testing "Coercing vertices to three dimensions" + (let [v (vertex 2 3) + v' (ensure3d v)] + (is (zero? (:z v')) + "If not already 3d, and no `dflt` arg specified, `:z` should be zero.")) + (let [v (vertex 2 3) + v' (ensure3d v 5)] + (is (= (:z v') 5) + "If not already 3d, and `dflt` arg specified, `:z` should be + equal to `dflt`.")) + (let [v (vertex 2 3 4) + v' (ensure3d v 5)] + (is (= v v') + "If already 3d, should be unchanged.")))) + +(deftest within-box-tests + (testing "Checking whether a vertex is within a specified region: 2d." + (is (within-box? (vertex 2 2) (vertex 1 1) (vertex 3 3)) "Should be.") + (is (within-box? (vertex 1 3) (vertex 1 1) (vertex 3 3)) "Should be.") + (is (false? (within-box? (vertex 0 2) (vertex 1 1) (vertex 3 3))) + "Outside west") + (is (false? (within-box? (vertex 5 2) (vertex 1 1) (vertex 3 3))) + "Outside east") + (is (false? (within-box? (vertex 2 0) (vertex 1 1) (vertex 3 3))) + "Outside south") + (is (false? (within-box? (vertex 2 5) (vertex 1 1) (vertex 3 3))) + "Outside north") + (is (false? (within-box? (vertex 2 3.000001) (vertex 1 1) (vertex 3 3))) + "Very slightly outside north")) + (testing "Checking whether a vertex is within a specified region: 3d." + (is (within-box? + (vertex 2 2 2) (vertex 1 1 1) (vertex 3 3 3)) "Should be.") + (is (within-box? + (vertex 1 3 3) (vertex 1 1 1) (vertex 3 3 3)) "Should be.") + (is (false? + (within-box? (vertex 0 2 2) (vertex 1 1 1) (vertex 3 3 3))) + "Outside west") + (is (false? + (within-box? (vertex 5 2 2) (vertex 1 1 1) (vertex 3 3 3))) + "Outside east") + (is (false? + (within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3))) + "Outside south") + (is (false? + (within-box? (vertex 2 5 2) (vertex 1 1 1) (vertex 3 3 3))) + "Outside north") + (is (false? + (within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3))) + "Outside south") + (is (false? + (within-box? (vertex 2 2 0) (vertex 1 1 1) (vertex 3 3 3))) + "Outside down") + (is (false? + (within-box? (vertex 2 2 5) (vertex 1 1 1) (vertex 3 3 3))) + "Outside up")) + (testing "Bad arguments." + (is (thrown? IllegalArgumentException + (within-box? :fred (vertex 1 1 1) (vertex 3 3 3))) + "Not a vertex: `target`.") + (is (thrown? IllegalArgumentException + (within-box? (vertex 2 2 2) :ginny (vertex 3 3 3))) + "Not a vertex: `minv`.") + (is (thrown? IllegalArgumentException + (within-box? (vertex 2 2 2) (vertex 1 1 1) :henry)) + "Not a vertex: `maxv`.")))