From e19ce2e5f7bbc59836e5834f3393ec547c39080b Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 6 Apr 2024 09:41:52 +0100 Subject: [PATCH] drainage/flow-world-nr now works; drainage/flow-world still doesn't --- docs/cloverage/index.html | 139 ++++--- docs/cloverage/mw_engine/core.clj.html | 424 ++++++++++++-------- docs/cloverage/mw_engine/flow.clj.html | 398 +++++++++++------- docs/cloverage/mw_engine/heightmap.clj.html | 334 +++++++-------- docs/cloverage/mw_engine/render.clj.html | 302 ++++++++++++++ docs/cloverage/mw_engine/utils.clj.html | 266 +++++++++++- docs/cloverage/mw_engine/world.clj.html | 184 ++++++--- project.clj | 4 +- resources/heightmaps/20x20/crucible.png | Bin 0 -> 1356 bytes resources/heightmaps/20x20/crucible.xcf | Bin 0 -> 1733 bytes resources/test.edn | 1 + src/cljc/mw_engine/core.clj | 35 +- src/cljc/mw_engine/drainage.clj | 121 +++--- src/cljc/mw_engine/heightmap.clj | 6 - src/cljc/mw_engine/render.clj | 2 +- src/cljc/mw_engine/utils.clj | 5 +- src/mw_engine/core.clj | 134 ------- 17 files changed, 1540 insertions(+), 815 deletions(-) create mode 100644 docs/cloverage/mw_engine/render.clj.html create mode 100644 resources/heightmaps/20x20/crucible.png create mode 100644 resources/heightmaps/20x20/crucible.xcf create mode 100644 resources/test.edn delete mode 100644 src/mw_engine/core.clj diff --git a/docs/cloverage/index.html b/docs/cloverage/index.html index 87b7ba8..c18113a 100644 --- a/docs/cloverage/index.html +++ b/docs/cloverage/index.html @@ -16,20 +16,20 @@ mw-engine.core
51
103
-33.12 % + style="width:37.185929648241206%; + float:left;"> 74
125
+37.19 %
12
26
1
20
-39.39 % -1151533 + style="width:48.07692307692308%; + float:left;"> 25 +51.92 % +1451352 mw-engine.display
mw-engine.flow
447
69
-86.63 % + style="width:77.65957446808511%; + float:left;"> 511
147
+77.66 %
47
4
4
-92.73 % -1411555 + style="width:67.5%; + float:left;"> 54
8
18
+77.50 % +1791880 mw-engine.heightmap
136
140
11
-92.52 % +92.72 %
40
42
2
2
-95.45 % -1271144 +95.65 % +1331246 mw-engine.natural-rules
18414106 - mw-engine.utils
376
162
-69.89 % + mw-engine.render
11
149
+6.88 %
82
10
26
+27.78 % +981136 + + + mw-engine.utils
554
287
+65.87 % +
100
1
29
-74.11 % -30135112 + style="width:34.41558441558441%; + float:left;"> 53
+65.58 % +37941154 mw-engine.world
63
53
-54.31 % + style="width:34.57446808510638%; + float:left;"> 65
123
+34.57 %
11
13
1
14
-46.15 % -891226 + style="width:64.1025641025641%; + float:left;"> 25 +35.90 % +1111439 Totals: -46.89 % +45.14 % -57.73 % +54.18 % diff --git a/docs/cloverage/mw_engine/core.clj.html b/docs/cloverage/mw_engine/core.clj.html index e540e94..133d478 100644 --- a/docs/cloverage/mw_engine/core.clj.html +++ b/docs/cloverage/mw_engine/core.clj.html @@ -77,277 +77,367 @@ 024   mw-engine.core
- 025    (:require [mw-engine.utils :refer [get-int-or-zero map-world]] + 025    (:require [mw-engine.flow :refer [flow-world]]
- 026              [taoensso.timbre :as l])) + 026              [mw-engine.utils :refer [add-history-event get-int-or-zero map-world rule-type]] +
+ + 027              [taoensso.timbre :as l]))
- 027   + 028  
- 028  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 029  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 029  ;;;; + 030  ;;;;
- 030  ;;;; mw-engine: the state/transition engine of MicroWorld. + 031  ;;;; mw-engine: the state/transition engine of MicroWorld.
- 031  ;;;; + 032  ;;;;
- 032  ;;;; This program is free software; you can redistribute it and/or + 033  ;;;; This program is free software; you can redistribute it and/or
- 033  ;;;; modify it under the terms of the GNU General Public License + 034  ;;;; modify it under the terms of the GNU General Public License
- 034  ;;;; as published by the Free Software Foundation; either version 2 + 035  ;;;; as published by the Free Software Foundation; either version 2
- 035  ;;;; of the License, or (at your option) any later version. + 036  ;;;; of the License, or (at your option) any later version.
- 036  ;;;; + 037  ;;;;
- 037  ;;;; This program is distributed in the hope that it will be useful, + 038  ;;;; This program is distributed in the hope that it will be useful,
- 038  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of + 039  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- 039  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the + 040  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- 040  ;;;; GNU General Public License for more details. + 041  ;;;; GNU General Public License for more details.
- 041  ;;;; + 042  ;;;;
- 042  ;;;; You should have received a copy of the GNU General Public License + 043  ;;;; You should have received a copy of the GNU General Public License
- 043  ;;;; along with this program; if not, write to the Free Software + 044  ;;;; along with this program; if not, write to the Free Software
- 044  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, + 045  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
- 045  ;;;; USA. + 046  ;;;; USA.
- 046  ;;;; + 047  ;;;;
- 047  ;;;; Copyright (C) 2014 Simon Brooke + 048  ;;;; Copyright (C) 2014 Simon Brooke
- 048  ;;;; + 049  ;;;;
- 049  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 050  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 050   -
- - 051  (defn apply-rule -
- - 052    "Apply a single `rule` to a `cell`. What this is about is that I want to be able, -
- - 053     for debugging purposes, to tag a cell with the rule text of the rule which -
- - 054     fired (and especially so when an exception is thrown. So a rule may be either -
- - 055     an ifn, or a list (ifn source-text). This function deals with despatching -
- - 056     on those two possibilities. `world` is also passed in in order to be able -
- - 057     to access neighbours." -
- - 058    ([world cell rule] -
- - 059     (cond -
- - 060       (ifn? rule) (apply-rule world cell rule nil) -
- - 061       (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src)))) -
- - 062    ([world cell rule source] -
- - 063     (let [result (apply rule (list cell world))] + 051  
- 064       (cond + 052  (def ^:dynamic *with-history*
- - 065         (and result source) (merge result {:rule source}) + + 053    "I suspect that caching history on the cells is greatly worsening the
- - 066         :else result)))) + + 054     memory problems. Make it optional, but by default false." +
+ + 055    false)
- 067   + 056  
- 068  (defn- apply-rules + 057  (defn apply-rule
- 069    "Derive a cell from this `cell` of this `world` by applying these `rules`." + 058    "Apply a single `rule` to a `cell`. What this is about is that I want to be able,
- 070    [world cell rules] -
- - 071    (cond (empty? rules) cell -
- - 072          :else (let [result (apply-rule world cell (first rules))] -
- - 073                  (cond result result -
- - 074                        :else (apply-rules world cell (rest rules)))))) -
- - 075   -
- - 076  (defn- transform-cell + 059     for debugging purposes, to tag a cell with the rule text of the rule which
- 077    "Derive a cell from this `cell` of this `world` by applying these `rules`. If an + 060     fired (and especially so when an exception is thrown). "
- 078     exception is thrown, cache its message on the cell and set it's state to error" + 061    ;; as of version 0-3-0, metadata for rules is now passed around on the metadata
- 079    [world cell rules] + 062    ;; of the rule function itself. Yes, I know, this is obvious; but I'll confess +
+ + 063    ;; I didn't think of it before. +
+ + 064    [world cell rule] +
+ + 065    (let [result (try +
+ + 066                   (apply rule (list cell world)) +
+ + 067                   (catch Exception e +
+ + 068                     (l/warn e +
+ + 069                             (format +
+ + 070                              "Error in `apply-rule`: `%s` (%s) while executing rule `%s` on cell `%s`"
- 080    (try + 071                              e +
+ + 072                              (.getMessage e) +
+ + 073                              (-> rule meta :lisp) +
+ + 074                              cell))))] +
+ + 075      (if *with-history* +
+ + 076        (add-history-event result rule) +
+ + 077        result))) +
+ + 078   +
+ + 079  (defn- apply-rules +
+ + 080    "Derive a cell from this `cell` of this `world` by applying these `rules`." +
+ + 081    [world cell rules] +
+ + 082    (or +
+ + 083     (first +
+ + 084      (remove +
+ + 085       nil? +
+ + 086       (try +
+ + 087         (map #(apply-rule world cell %) rules) +
+ + 088         (catch Exception e +
+ + 089           (l/warn e +
+ + 090                   (format +
+ + 091                    "Error in `apply-rules`: `%s` (%s) while executing rules on cell `%s`"
- 081      (merge -
- - 082       (apply-rules world cell rules) -
- - 083       {:generation (+ (get-int-or-zero cell :generation) 1)}) -
- - 084      (catch Exception e -
- - 085        (merge cell {:error -
- - 086                     (format "%s at generation %d when in state %s" + 092                    (-> e .getClass .getName)
- 087                             (.getMessage e) + 093                    (.getMessage e)
- - 088                             (:generation cell) -
- - 089                             (:state cell)) -
- - 090                     :stacktrace (map #(.toString %) (.getStackTrace e)) + + 094                    cell))))))
- 091                     :state :error})))) + 095     cell))
- 092   + 096  
- 093  (defn transform-world + 097  (defn- transform-cell
- 094    "Return a world derived from this `world` by applying these `rules` to each cell." + 098    "Derive a cell from this `cell` of this `world` by applying these `rules`. If an
- 095    ([world rules] + 099     exception is thrown, cache its message on the cell and set it's state to error"
- - 096     (map-world world transform-cell (list rules)))) -
- - 097   + + 100    [world cell rules]
- 098  (defn run-world + 101    (try +
+ + 102      (merge +
+ + 103       (apply-rules world cell rules) +
+ + 104       {:generation (+ (get-int-or-zero cell :generation) 1)})
- 099    "Run this world with these rules for this number of generations. + 105      (catch Exception e
- - 100   + + 106        (let [narrative (format "Error in `transform-cell`: `%s` (%s) at generation %d when in state %s;"
- - 101    * `world` a world as discussed above; + + 107                                (-> e .getClass .getName)
- - 102    * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; -
- - 103    * `rules` a sequence of rules as defined above, to be run iteratively for each generation; -
- - 104    * `generations` an (integer) number of generations. -
- - 105   -
- - 106    Return the final generation of the world." -
- - 107    [world init-rules rules generations] + + 108                                (.getMessage e)
- 108    (reduce (fn [world iteration] + 109                                (:generation cell) +
+ + 110                                (:state cell))]
- 109              (l/info "Running iteration " iteration) + 111          (l/warn e narrative)
- - 110              (transform-world world rules)) -
- - 111            (transform-world world init-rules) -
- - 112            (range generations))) + + 112          cell))))
113  
- - 114   + + 114  (defn transform-world +
+ + 115    "Return a world derived from this `world` by applying the production rules  +
+ + 116    found among these `rules` to each cell." +
+ + 117    [world rules] +
+ + 118    (map-world world transform-cell +
+ + 119               ;; Yes, that `list` is there for a reason!  +
+ + 120               (list +
+ + 121                (filter +
+ + 122                 #(= :production (rule-type %)) +
+ + 123                 rules))))
- 115   + 124   +
+ + 125  (defn run-world +
+ + 126    "Run this world with these rules for this number of generations. +
+ + 127   +
+ + 128     * `world` a world as discussed above; +
+ + 129     * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; +
+ + 130     * `rules` a sequence of rules as defined above, to be run iteratively for each generation; +
+ + 131     * `generations` an (integer) number of generations. +
+ + 132      +
+ + 133     **NOTE THAT** all rules **must** be tagged with `rule-type` metadata, or thet **will not** +
+ + 134     be executed. +
+ + 135   +
+ + 136     Return the final generation of the world." +
+ + 137    ([world rules generations] +
+ + 138     (run-world world rules rules (dec generations))) +
+ + 139    ([world init-rules rules generations] +
+ + 140     (reduce (fn [world iteration] +
+ + 141               (l/info "Running iteration " iteration) +
+ + 142               (let [w' (transform-world world rules)] +
+ + 143                 (flow-world w' rules))) +
+ + 144             (transform-world world init-rules) +
+ + 145             (range generations))))
diff --git a/docs/cloverage/mw_engine/flow.clj.html b/docs/cloverage/mw_engine/flow.clj.html index 8246897..40d0fe1 100644 --- a/docs/cloverage/mw_engine/flow.clj.html +++ b/docs/cloverage/mw_engine/flow.clj.html @@ -77,355 +77,469 @@ 024     executed. This namespace deals with mainly with execution."
- 025    (:require [mw-engine.utils :refer [get-cell get-num in-bounds? merge-cell]] + 025    (:require [mw-engine.utils :refer [add-history-event get-cell get-num
- 026              [taoensso.timbre :refer [info warn]])) + 026                                       in-bounds? map-world merge-cell rule-type]] +
+ + 027              [taoensso.timbre :refer [info warn]]))
- 027   + 028  
- 028  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 029  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 029  ;;;; + 030  ;;;;
- 030  ;;;; mw-engine: the state/transition engine of MicroWorld. + 031  ;;;; mw-engine: the state/transition engine of MicroWorld.
- 031  ;;;; + 032  ;;;;
- 032  ;;;; This program is free software; you can redistribute it and/or + 033  ;;;; This program is free software; you can redistribute it and/or
- 033  ;;;; modify it under the terms of the GNU General Public License + 034  ;;;; modify it under the terms of the GNU General Public License
- 034  ;;;; as published by the Free Software Foundation; either version 2 + 035  ;;;; as published by the Free Software Foundation; either version 2
- 035  ;;;; of the License, or (at your option) any later version. + 036  ;;;; of the License, or (at your option) any later version.
- 036  ;;;; + 037  ;;;;
- 037  ;;;; This program is distributed in the hope that it will be useful, + 038  ;;;; This program is distributed in the hope that it will be useful,
- 038  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of + 039  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- 039  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the + 040  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- 040  ;;;; GNU General Public License for more details. + 041  ;;;; GNU General Public License for more details.
- 041  ;;;; + 042  ;;;;
- 042  ;;;; You should have received a copy of the GNU General Public License + 043  ;;;; You should have received a copy of the GNU General Public License
- 043  ;;;; along with this program; if not, write to the Free Software + 044  ;;;; along with this program; if not, write to the Free Software
- 044  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, + 045  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
- 045  ;;;; USA. + 046  ;;;; USA.
- 046  ;;;; + 047  ;;;;
- 047  ;;;; Copyright (C) 2014 Simon Brooke + 048  ;;;; Copyright (C) 2014 Simon Brooke
- 048  ;;;; + 049  ;;;;
- 049  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + 050  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- 050   + 051  
- 051  (defn coordinate? + 052  (defn coordinate?
- 052    "Return `true` if this object `o` is a valid coordinate with respect to + 053    "Return `true` if this object `o` is a valid coordinate with respect to
- 053       this `world`, else `false`. Assumes square worlds." + 054       this `world`, else `false`. Assumes square worlds."
- 054    [o world] + 055    [o world]
- 055    (try + 056    (try
- 056      (and (or (zero? o) (pos-int? o)) + 057      (and (or (zero? o) (pos-int? o))
- 057           (< o (count world))) + 058           (< o (count world)))
- 058      (catch Exception e + 059      (catch Exception e
- 059        (warn (format "Not a valid coordinate: %s; %s" o (.getMessage e))) + 060        (warn (format "Not a valid coordinate: %s; %s" o (.getMessage e)))
- 060        false))) + 061        false)))
- 061   + 062  
- 062  (defn location? + 063  (defn location?
- 063    "Return `true` if this object `o` is a location as defined above with respect to + 064    "Return `true` if this object `o` is a location as defined above with respect to
- 064     this `world`, else `false`." + 065     this `world`, else `false`."
- 065    [o world] + 066    [o world]
- 066    (try + 067    (try
- 067      (and (map? o) + 068      (and (map? o)
- 068           (integer? (:x o)) + 069           (integer? (:x o))
- 069           (integer? (:y o)) + 070           (integer? (:y o))
- 070           (in-bounds? world (:x o) (:y o))) + 071           (in-bounds? world (:x o) (:y o)))
- 071      (catch Exception e + 072      (catch Exception e
- 072        (warn (format "Not a valid location: %s; %s" o (.getMessage e))) + 073        (warn (format "Not a valid location: %s; %s" o (.getMessage e)))
- 073        false))) + 074        false)))
- 074   + 075  
- 075  (defn flow? + 076  (defn flow?
- 076    "Return `true` if this object `o` is a flow as defined above with respect to + 077    "Return `true` if this object `o` is a flow as defined above with respect to
- 077     this `world`, else `false`. Assumes square worlds." + 078     this `world`, else `false`. Assumes square worlds."
- 078    [o world] + 079    [o world]
- 079    (try + 080    (try
- 080      (and (map? o) + 081      (and (map? o)
- 081           (location? (:source o) world) + 082           (location? (:source o) world)
- 082           (location? (:destination o) world) + 083           (location? (:destination o) world)
- 083           (keyword? (:property o)) + 084           (keyword? (:property o))
- 084           (pos? (:quantity o))) + 085           (pos? (:quantity o)))
- 085      (catch Exception e + 086      (catch Exception e
- 086        (warn (format "Not a valid flow: %s; %s" o (.getMessage e))) + 087        (warn (format "Not a valid flow: %s; %s" o (.getMessage e)))
- 087        false))) + 088        false)))
- 088   + 089  
- 089  (defn execute + 090  (defn execute
- 090    "Return a world like this `world`, except with the quantity of the property + 091    "Return a world like this `world`, except with the quantity of the property
- 091     described in this `flow` object transferred from the source of that flow + 092     described in this `flow` object transferred from the source of that flow
- 092     to its destination." + 093     to its destination."
- 093    [world flow] + 094    [world flow]
- 094    (try + 095    (try
- 095      (let [sx (-> flow :source :x) + 096      (let [sx (-> flow :source :x)
- 096            sy (-> flow :source :y) + 097            sy (-> flow :source :y)
- 097            source (get-cell world sx sy) + 098            source (get-cell world sx sy)
- 098            dx (-> flow :destination :x) + 099            dx (-> flow :destination :x)
- 099            dy (-> flow :destination :y) + 100            dy (-> flow :destination :y)
- 100            dest (get-cell world dx dy) + 101            dest (get-cell world dx dy)
- 101            p (:property flow) + 102            p (:property flow)
- - 102            q (min (:quantity flow) (get-num source p)) + + 103            q (min (:quantity flow) (get-num source p)) +
+ + 104            s' (add-history-event 
- 103            s' (assoc source p (- (source p) q)) + 105                (assoc source p (- (source p) q)) 
- - 104            d' (assoc dest p (+ (get-num dest p) q))] -
- - 105        (if (= q (:quantity flow)) -
- - 106          (info (format "Moving %f units of %s from %d,%d to %d,%d" -
- - 107                      (float q) (name p) sx sy dx dy)) -
- - 108          (warn (format "Moving %s from %d,%d to %d,%d; %f units ordered but only %f available" + + 106                (:rule flow) 
- 109                        (name p) sx sy dx dy (float (:quantity flow)) (float q)))) + 107                {:direction :sent :other {:x dx :y dy} :property p :quantity q}) +
+ + 108            d' (add-history-event +
+ + 109                (assoc dest p (+ (get-num dest p) q)) +
+ + 110                (:rule flow) +
+ + 111                {:direction :received :other {:x sx :y sy} :property p :quantity q})] +
+ + 112        (if (= q (:quantity flow)) +
+ + 113          (info (format "Moving %f units of %s from %d,%d to %d,%d" +
+ + 114                        (float q) (name p) sx sy dx dy)) +
+ + 115          (warn (format "Moving %s from %d,%d to %d,%d; %f units ordered but only %f available" +
+ + 116                        (name p) sx sy dx dy (float (:quantity flow)) (float q))))
- 110        (merge-cell (merge-cell world s') d')) + 117        (merge-cell (merge-cell world s') d'))
- 111      (catch Exception e + 118      (catch Exception e
- 112        (warn (format "Failed to execute flow %s: %s" flow (.getMessage e))) + 119        (warn (format "Failed to execute flow %s: %s" flow (.getMessage e)))
- 113        ;; return the world unmodified. + 120        ;; return the world unmodified.
- 114        world))) -
- - 115   -
- - 116  (defn execute-flows -
- - 117    "Return a world like this `world`, but with each of these flows executed." -
- - 118    [world flows] -
- - 119    (reduce execute world (filter #(flow? % world) flows))) -
- - 120   -
- - 121  ;; building blocks for compiled flow rules + 121        world)))
122  
- - 123  (defmacro create-location + + 123  (defn execute-flows
- 124    [cell] + 124    "Return a world like this `world`, but with each of these flows executed."
- - 125    `(select-keys ~cell [:x :y])) + + 125    [world flows] +
+ + 126    (reduce execute world (filter #(flow? % world) flows)))
- 126   + 127   +
+ + 128  (defn- plan-cell-flows  +
+ + 129    [world cell rules] +
+ + 130    (map ;; across all the rules +
+ + 131     (fn [rule] (let [r (try  +
+ + 132                          (apply rule (list cell world)) +
+ + 133                             (catch Exception any +
+ + 134                               (throw (ex-info "Planning of flows failed" +
+ + 135                                               (merge (meta rule) {:cell cell}) +
+ + 136                                               any))))]  +
+ + 137                  (when r (map #(assoc % :rule rule) r)))) +
+ + 138     rules)) +
+ + 139   +
+ + 140  (defn plan-flows +
+ + 141    "Plan, but do not execute, all the flows in this `world` implied by those of  +
+ + 142     these `rules` (which are expected to be pre-compiled) which are +
+ + 143     flow rules. Return the list of plans, as flow objects." +
+ + 144    [world rules] +
+ + 145    (remove nil? +
+ + 146            (flatten +
+ + 147             (map-world +
+ + 148              world +
+ + 149              plan-cell-flows +
+ + 150              (list (filter #(= :flow (rule-type %)) rules)))))) +
+ + 151   +
+ + 152  (defn flow-world +
+ + 153        "Return a world derived from this `world` by applying the flow rules  +
+ + 154        found among these `rules` to each cell, and executing all the flows +
+ + 155         planned." +
+ + 156    [world rules] +
+ + 157    (execute-flows world (plan-flows world rules))) +
+ + 158   +
+ + 159  ;; building blocks for compiled flow rules +
+ + 160   +
+ + 161  (defmacro create-location +
+ + 162    [cell] +
+ + 163    `(select-keys ~cell [:x :y])) +
+ + 164  
- 127  (defmacro create-flow-quantity + 165  (defmacro create-flow-quantity
- 128    [source dest prop quantity] + 166    [source dest prop quantity]
- 129    `{:source (create-location ~source) + 167    `{:source (create-location ~source)
- 130      :destination (create-location ~dest) + 168      :destination (create-location ~dest)
- 131      :prop ~prop + 169      :prop ~prop
- 132      :quantity ~quantity}) + 170      :quantity ~quantity})
- 133   + 171  
- 134  (defmacro create-flow-fraction + 172  (defmacro create-flow-fraction
- 135    [source dest prop fraction] + 173    [source dest prop fraction]
- 136    `(create-flow-quantity ~source ~dest ~prop + 174    `(create-flow-quantity ~source ~dest ~prop
- 137                           (* ~fraction (get-num ~source ~prop)))) + 175                           (* ~fraction (get-num ~source ~prop))))
- 138   + 176  
- 139  (defmacro create-flow-percent + 177  (defmacro create-flow-percent
- 140    [source dest prop percent] + 178    [source dest prop percent]
- 141    `(create-flow-fraction ~source ~dest ~prop (/ ~percent 100))) + 179    `(create-flow-fraction ~source ~dest ~prop (/ ~percent 100)))
diff --git a/docs/cloverage/mw_engine/heightmap.clj.html b/docs/cloverage/mw_engine/heightmap.clj.html index 3926ecb..4d2b5d6 100644 --- a/docs/cloverage/mw_engine/heightmap.clj.html +++ b/docs/cloverage/mw_engine/heightmap.clj.html @@ -107,283 +107,301 @@ 034  
- 035  (defn tag-property + 035  (defn abs 
- 036    "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`. + 036    "Prior to Clojure 1.11, there is no native `abs` function. Afterwards, there
- 037     If the heightmap you supply is smaller than the world, this will break. -
- - 038   + 037     is."
- 039     * `world` not actually used, but present to enable this function to be -
- - 040       passed as an argument to `mw-engine.utils/map-world`, q.v. -
- - 041     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; -
- - 042     * `property` the property (normally a keyword) whose value will be set on the cell. -
- - 043     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should -
- - 044       exceed those of the world of which the `cell` forms part." -
- - 045    ([_ cell property heightmap] -
- - 046      (tag-property cell property heightmap)) -
- - 047    ([cell property heightmap] -
- - 048      (merge cell + 038    [n] 
- 049             {property -
- - 050              (+ (get-int cell property) -
- - 051                 (- 256 -
- - 052                    (abs -
- - 053                      (mod -
- - 054                        (.getRGB heightmap -
- - 055                          (get-int cell :x) -
- - 056                          (get-int cell :y)) 256))))}))) + 039    (Math/abs n))
- 057   + 040  
- 058  (defn tag-gradient + 041  (defn tag-property
- 059    "Set the `gradient` property of this `cell` of this `world` to the difference in + 042    "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`.
- 060     altitude between its highest and lowest neghbours." + 043     If the heightmap you supply is smaller than the world, this will break. +
+ + 044  
- 061    [world cell] + 045     * `world` not actually used, but present to enable this function to be +
+ + 046       passed as an argument to `mw-engine.utils/map-world`, q.v. +
+ + 047     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; +
+ + 048     * `property` the property (normally a keyword) whose value will be set on the cell. +
+ + 049     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should +
+ + 050       exceed those of the world of which the `cell` forms part." +
+ + 051    ([_ cell property heightmap] +
+ + 052      (tag-property cell property heightmap)) +
+ + 053    ([cell property heightmap] +
+ + 054      (merge cell +
+ + 055             {property +
+ + 056              (+ (get-int cell property) +
+ + 057                 (- 256 +
+ + 058                    (abs +
+ + 059                      (mod +
+ + 060                        (.getRGB heightmap +
+ + 061                          (get-int cell :x) +
+ + 062                          (get-int cell :y)) 256))))}))) +
+ + 063   +
+ + 064  (defn tag-gradient +
+ + 065    "Set the `gradient` property of this `cell` of this `world` to the difference in +
+ + 066     altitude between its highest and lowest neghbours." +
+ + 067    [world cell]
- 062    (let [heights (remove nil? (map :altitude (get-neighbours world cell))) + 068    (let [heights (remove nil? (map :altitude (get-neighbours world cell)))
- 063          highest (cond (empty? heights) 0 ;; shouldn't happen + 069          highest (cond (empty? heights) 0 ;; shouldn't happen
- 064                    :else (apply max heights)) + 070                    :else (apply max heights))
- 065          lowest (cond (empty? heights) 0 ;; shouldn't + 071          lowest (cond (empty? heights) 0 ;; shouldn't
- 066                   :else (apply min heights)) + 072                   :else (apply min heights))
- 067          gradient (- highest lowest)] + 073          gradient (- highest lowest)]
- 068      (merge cell {:gradient gradient}))) -
- - 069   -
- - 070  (defn tag-gradients -
- - 071    "Set the `gradient` property of each cell in this `world` to the difference in -
- - 072     altitude between its highest and lowest neghbours." -
- - 073    [world] -
- - 074    (map-world world tag-gradient)) + 074      (merge cell {:gradient gradient})))
075  
- 076  (defn tag-altitude + 076  (defn tag-gradients
- 077    "Set the altitude of this cell from the corresponding pixel of this heightmap. + 077    "Set the `gradient` property of each cell in this `world` to the difference in
- 078     If the heightmap you supply is smaller than the world, this will break. + 078     altitude between its highest and lowest neghbours." +
+ + 079    [world] +
+ + 080    (map-world world tag-gradient))
- 079   -
- - 080     * `world` not actually used, but present to enable this function to be -
- - 081       passed as an argument to `mw-engine.utils/map-world`, q.v.; -
- - 082     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; -
- - 083     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should -
- - 084       exceed those of the world of which the `cell` forms part." -
- - 085    ([_ cell heightmap] -
- - 086      (tag-property cell :altitude heightmap)) -
- - 087    ([cell heightmap] -
- - 088      (tag-property cell :altitude heightmap))) -
- - 089   + 081  
- 090  (defn apply-heightmap + 082  (defn tag-altitude
- 091    "Apply the image file loaded from this path to this world, and return a world whose + 083    "Set the altitude of this cell from the corresponding pixel of this heightmap.
- 092    altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that + 084     If the heightmap you supply is smaller than the world, this will break. +
+ + 085  
- 093    the heightmap is at least as large in x and y dimensions as the world. Note that, in + 086     * `world` not actually used, but present to enable this function to be
- 094    addition to setting the `:altitude` of each cell, this function also sets the `:gradient`. + 087       passed as an argument to `mw-engine.utils/map-world`, q.v.; +
+ + 088     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; +
+ + 089     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should +
+ + 090       exceed those of the world of which the `cell` forms part." +
+ + 091    ([_ cell heightmap] +
+ + 092      (tag-property cell :altitude heightmap)) +
+ + 093    ([cell heightmap] +
+ + 094      (tag-property cell :altitude heightmap)))
095  
- - 096    * `world` a world, as defined in `world.clj`, q.v.; if world is not supplied, + + 096  (defn apply-heightmap
- 097      a world the size of the heightmap will be created; + 097    "Apply the image file loaded from this path to this world, and return a world whose
- 098    * `imagepath` a file path or URL which indicates an (ideally greyscale) image file." + 098    altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that
- 099    ([world imagepath] + 099    the heightmap is at least as large in x and y dimensions as the world. Note that, in +
+ + 100    addition to setting the `:altitude` of each cell, this function also sets the `:gradient`. +
+ + 101   +
+ + 102    * `world` a world, as defined in `world.clj`, q.v.; if world is not supplied, +
+ + 103      a world the size of the heightmap will be created; +
+ + 104    * `imagepath` a file path or URL which indicates an (ideally greyscale) image file." +
+ + 105    ([world imagepath]
- 100      (let [heightmap (filter-image + 106      (let [heightmap (filter-image
- 101                       (load-image imagepath) + 107                       (load-image imagepath)
- 102                        (filters/grayscale))] + 108                        (filters/grayscale))]
- 103        (map-world + 109        (map-world
- 104          (map-world world tag-altitude (list heightmap)) + 110          (map-world world tag-altitude (list heightmap))
- 105          tag-gradient))) + 111          tag-gradient)))
- 106     ([imagepath] + 112     ([imagepath]
- 107      (let [heightmap (filter-image + 113      (let [heightmap (filter-image
- 108                        (load-image imagepath) + 114                        (load-image imagepath)
- 109                        (filters/grayscale)) + 115                        (filters/grayscale))
- 110            world (make-world (.getWidth heightmap) (.getHeight heightmap))] + 116            world (make-world (.getWidth heightmap) (.getHeight heightmap))]
- 111        (map-world + 117        (map-world
- 112          (map-world world tag-altitude (list heightmap)) + 118          (map-world world tag-altitude (list heightmap))
- 113          tag-gradient)))) + 119          tag-gradient))))
- 114   + 120  
- 115  (defn apply-valuemap + 121  (defn apply-valuemap
- 116    "Generalised from apply-heightmap, set an arbitrary property on each cell + 122    "Generalised from apply-heightmap, set an arbitrary property on each cell
- 117     of this `world` from the values in this (ideally greyscale) heightmap. + 123     of this `world` from the values in this (ideally greyscale) heightmap.
- 118   + 124  
- 119     * `world` a world, as defined in `world.clj`, q.v.; + 125     * `world` a world, as defined in `world.clj`, q.v.;
- 120     * `imagepath` a file path or URL which indicates an (ideally greyscale) image file; + 126     * `imagepath` a file path or URL which indicates an (ideally greyscale) image file;
- 121     * `property` the property of each cell whose value should be added to from the + 127     * `property` the property of each cell whose value should be added to from the
- 122        intensity of the corresponding cell of the image." + 128        intensity of the corresponding cell of the image."
- 123    [world imagepath property] + 129    [world imagepath property]
- 124      (let [heightmap (filter-image + 130      (let [heightmap (filter-image
- 125                        (load-image imagepath) + 131                        (load-image imagepath)
- 126                        (filters/grayscale))] + 132                        (filters/grayscale))]
- 127        (map-world world tag-property (list property heightmap)))) + 133        (map-world world tag-property (list property heightmap))))
diff --git a/docs/cloverage/mw_engine/render.clj.html b/docs/cloverage/mw_engine/render.clj.html new file mode 100644 index 0000000..4647116 --- /dev/null +++ b/docs/cloverage/mw_engine/render.clj.html @@ -0,0 +1,302 @@ + + + + mw_engine/render.clj + + + + 001  (ns mw-engine.render +
+ + 002    "Render a world as HTML. +
+ + 003      +
+ + 004     Adapted (simplified) from mw-ui.render-world; this is for visualisation, not +
+ + 005     interaction." +
+ + 006    ;; TODO: but possibly it would be better if there is to be a newer version of +
+ + 007    ;; mw-ui, to base it on this. +
+ + 008    (:require [hiccup2.core :refer [html]]) +
+ + 009    ) +
+ + 010   +
+ + 011  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 012  ;;;; +
+ + 013  ;;;; This program is free software; you can redistribute it and/or +
+ + 014  ;;;; modify it under the terms of the GNU General Public License +
+ + 015  ;;;; as published by the Free Software Foundation; either version 2 +
+ + 016  ;;;; of the License, or (at your option) any later version. +
+ + 017  ;;;; +
+ + 018  ;;;; This program is distributed in the hope that it will be useful, +
+ + 019  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +
+ + 020  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the +
+ + 021  ;;;; GNU General Public License for more details. +
+ + 022  ;;;; +
+ + 023  ;;;; You should have received a copy of the GNU General Public License +
+ + 024  ;;;; along with this program; if not, write to the Free Software +
+ + 025  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, +
+ + 026  ;;;; USA. +
+ + 027  ;;;; +
+ + 028  ;;;; Copyright (C) 2024 Simon Brooke +
+ + 029  ;;;; +
+ + 030  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +
+ + 031   +
+ + 032  (def ^:dynamic *state-images-relative-path* "img/tiles/") +
+ + 033   +
+ + 034  (defn format-css-class +
+ + 035    "Format this statekey, assumed to be a keyword indicating a state in the +
+ + 036     world, into a CSS class" +
+ + 037    [statekey] +
+ + 038    (name statekey)) +
+ + 039   +
+ + 040  (defn format-image-path +
+ + 041    "Render this statekey, assumed to be a keyword indicating a state in the +
+ + 042     world, into a path which should recover the corresponding image file." +
+ + 043    [statekey] +
+ + 044    (format "%s%s.png" *state-images-relative-path* (format-css-class statekey))) +
+ + 045   +
+ + 046  (defn format-mouseover [cell] +
+ + 047    (str cell)) +
+ + 048   +
+ + 049  (defn render-cell +
+ + 050    "Render this world cell as a Hiccup table cell." +
+ + 051    [cell] +
+ + 052    (let [state (:state cell)] +
+ + 053      [:td {:class (format-css-class state) :title (format-mouseover cell)} +
+ + 054        +
+ + 055        [:img {:alt (:state cell) :src (format-image-path state)}]])) +
+ + 056   +
+ + 057   +
+ + 058  (defn render-world-row +
+ + 059    "Render this world row as a Hiccup table row." +
+ + 060    [row] +
+ + 061    (apply vector (cons :tr (map render-cell row)))) +
+ + 062   +
+ + 063  (defn render-world-table +
+ + 064    "Render this `world` as a complete HTML table in a DIV. If  +
+ + 065     `state-images-relative-path` is passed, use that to override the default path." +
+ + 066    ([world]  +
+ + 067      [:div {:class "world"} +
+ + 068       (apply vector +
+ + 069              (cons :table +
+ + 070                    (map render-world-row world))) +
+ + 071       [:p +
+ + 072        (str "Generation " (:generation (first (flatten world))))]]) +
+ + 073    ([world state-images-relative-path] +
+ + 074     (binding [*state-images-relative-path* state-images-relative-path] +
+ + 075       (render-world-table world)))) +
+ + 076   +
+ + 077  (defn render-world-page +
+ + 078    ([world] +
+ + 079     [:html +
+ + 080      [:head +
+ + 081       [:title "Rendered world"] +
+ + 082       [:style "div.world table, div.world table tr td { +
+ + 083   padding: 0; +
+ + 084   margin: 0; +
+ + 085   border-collapse: collapse; +
+ + 086   border: none;}"]] +
+ + 087      [:body +
+ + 088       (render-world-table world)]]) +
+ + 089    ([world state-images-relative-path] +
+ + 090     (binding [*state-images-relative-path* state-images-relative-path] +
+ + 091       (render-world-page world)))) +
+ + 092   +
+ + 093  (defn world->html-file +
+ + 094    ([world output-path] +
+ + 095    (spit output-path (str (html (render-world-page world))))) +
+ + 096    ([world output-path state-images-relative-path] +
+ + 097     (binding [*state-images-relative-path* state-images-relative-path] +
+ + 098       (world->html-file world output-path)))) +
+ + diff --git a/docs/cloverage/mw_engine/utils.clj.html b/docs/cloverage/mw_engine/utils.clj.html index 0ff50d2..9a0bdf6 100644 --- a/docs/cloverage/mw_engine/utils.clj.html +++ b/docs/cloverage/mw_engine/utils.clj.html @@ -17,10 +17,10 @@ 004   mw-engine.utils
- 005    (:require + 005    (:require [clojure.math.combinatorics :as combo]
- 006     [clojure.math.combinatorics :as combo])) + 006              [clojure.string :refer [join]]))
007   @@ -101,7 +101,7 @@ 032    "Return 'true' if elt is a member of col, else 'false'."
- 033    [elt col]  + 033    [elt col]
034    (contains? (set col) elt)) @@ -124,7 +124,7 @@ 040    (let [value (map property)]
- + 041      (if (integer? value) value 0)))
@@ -424,8 +424,8 @@ 140  
- - 141  (defn get-num + + 141  (defmacro get-num
142    "Get the value of a property expected to be a number from a map; if not @@ -445,20 +445,20 @@ 147    [map key]
- - 148    (if (map? map) + + 148    `(if (map? ~map)
- - 149      (let [v (map key)] -
- - 150        (cond (and v (number? v)) v + + 149       (let [~'v (~map ~key)]
- 151              :else 0)) + 150         (cond (and ~'v (number? ~'v)) ~'v
- - 152      (throw (Exception. "No map passed?")))) + + 151               :else 0)) +
+ + 152       (throw (Exception. "No map passed?"))))
153   @@ -907,5 +907,239 @@ 301      world))
+ + 302   +
+ + 303  (defn rule-type +
+ + 304    "Return the rule-type of this compiled `rule`." +
+ + 305    [rule] +
+ + 306    (:rule-type (meta rule))) +
+ + 307   +
+ + 308  (defn add-history-event +
+ + 309    "If `cell` is non-nil, expect it to be a map representing a cell; add +
+ + 310     to its history an an event recording the firing of this rule. If +
+ + 311     `detail` is passed, treat it as a map of additional data to be +
+ + 312     added to the event." +
+ + 313    ([cell rule] +
+ + 314     (when cell (add-history-event cell rule {}))) +
+ + 315    ([result rule detail] +
+ + 316     (when result +
+ + 317       (let [rule-meta (meta rule) +
+ + 318             event {:rule (:source rule-meta) +
+ + 319                    :rule-type (:rule-type rule-meta) +
+ + 320                    :generation (get-int-or-zero +
+ + 321                                 result +
+ + 322                                 :generation)} +
+ + 323             event' (if detail (merge event detail) event)] +
+ + 324         (merge result +
+ + 325                {:history (concat +
+ + 326                           (:history result) +
+ + 327                           (list event'))}))))) +
+ + 328   +
+ + 329  (defn- event-narrative [event] +
+ + 330    (case (:rule-type event) +
+ + 331      :production (:rule event) +
+ + 332      :flow (format "%s %f units of %s %s %d,%d:\n    %s" +
+ + 333                    (name (:direction event)) +
+ + 334                    (:quantity event) +
+ + 335                    (:property event) +
+ + 336                    (if (= :sent (:direction event)) "to" "from") +
+ + 337                    (:x (:other event)) +
+ + 338                    (:y (:other event)) +
+ + 339                    (:rule event)))) +
+ + 340   +
+ + 341  (defn history-string +
+ + 342    "Return the history of this `cell` as a string for presentation to the user." +
+ + 343    [cell] +
+ + 344    (join "\n" +
+ + 345          (map #(format "%6d: %s" (:generation %) (event-narrative %)) +
+ + 346               (:history cell)))) +
+ + 347   +
+ + 348  (defn- extend-summary [summary rs rl event] +
+ + 349    (str summary +
+ + 350         (if rs (format "%d-%d (%d occurances): %s\n" rs +
+ + 351                        (:generation event) +
+ + 352                        rl +
+ + 353                        (event-narrative event)) +
+ + 354             (format "%d: %s\n" (:generation event) +
+ + 355                     (event-narrative event))))) +
+ + 356   +
+ + 357  (defn summarise-history +
+ + 358    "Return, as a string, a shorter summary of the history of this cell" +
+ + 359    [cell] +
+ + 360    (loop [history (rest (:history cell)) +
+ + 361           event (first (:history cell)) +
+ + 362           prev nil +
+ + 363           rs nil +
+ + 364           rl 0 +
+ + 365           summary ""] +
+ + 366      (cond (nil? event) (extend-summary summary rs rl prev) +
+ + 367            (= (:rule event) (:rule prev)) (recur +
+ + 368                                            (rest history) +
+ + 369                                            (first history) +
+ + 370                                            event +
+ + 371                                            (or rs (:generation event)) +
+ + 372                                            (inc rl) +
+ + 373                                            summary) +
+ + 374            :else (recur (rest history) +
+ + 375                         (first history) +
+ + 376                         event +
+ + 377                         nil +
+ + 378                         0 +
+ + 379                         (extend-summary summary rs (inc rl) event))))) +
diff --git a/docs/cloverage/mw_engine/world.clj.html b/docs/cloverage/mw_engine/world.clj.html index 2bfd094..3aa1a5b 100644 --- a/docs/cloverage/mw_engine/world.clj.html +++ b/docs/cloverage/mw_engine/world.clj.html @@ -115,161 +115,227 @@ 037  
- - 038  (defmacro make-cell + + 038  (defn cell?
- 039    "Create a minimal default cell at x, y + 039    "Return `true` if `obj` is a cell, as understood by MicroWorld, else `false`." +
+ + 040    [obj] +
+ + 041    (and (map? obj) ;; it's a map... +
+ + 042         ;; TODO: it's worth checking (and this does not) that cells have the +
+ + 043         ;; right co-ordinates! +
+ + 044         (pos-int? (:x obj)) ;; with an x co-ordinate... +
+ + 045         (pos-int? (:y obj)) ;; and a y co-ordinate... +
+ + 046         (keyword? (:state obj)))) ;; and a state which is a keyword.
- 040   + 047   +
+ + 048  (defn world?
- 041    * `x` the x coordinate at which this cell is created; + 049    "Return `true` if `obj` is a world, as understood by MicroWorld, else `false`."
- 042    * `y` the y coordinate at which this cell is created." + 050    [obj] +
+ + 051    (and (coll? obj) ;; it's a collection... +
+ + 052         (every? coll? obj) ;; of collections... +
+ + 053         (= 1 (count (set (map count obj)))) ;; all of which are the same length... +
+ + 054         (every? cell? (flatten obj)))) ;; and every element of each of those is a cell. +
+ + 055   +
+ + 056  (defmacro make-cell
- 043    [x y] + 057    "Create a minimal default cell at x, y +
+ + 058   +
+ + 059    * `x` the x coordinate at which this cell is created; +
+ + 060    * `y` the y coordinate at which this cell is created." +
+ + 061    [x y]
- 044    `{:x ~x :y ~y :state :new}) + 062    `{:x ~x :y ~y :state :new})
- 045   + 063  
- 046  (defn make-world + 064  (defn make-world
- 047    "Make a world width cells from east to west, and height cells from north to + 065    "Make a world width cells from east to west, and height cells from north to
- 048     south. + 066     south.
- 049   + 067  
- 050    * `width` a natural number representing the width of the matrix to be created; + 068    * `width` a natural number representing the width of the matrix to be created;
- 051    * `height` a natural number representing the height of the matrix to be created." + 069    * `height` a natural number representing the height of the matrix to be created."
- 052    [width height] + 070    [width height]
- 053    (apply vector + 071    (apply vector
- 054           (map (fn [h] + 072           (map (fn [h]
- 055                  (apply vector (map #(make-cell % h) (range width)))) + 073                  (apply vector (map #(make-cell % h) (range width))))
- 056                (range height)))) + 074                (range height))))
- 057   + 075  
- 058  (defn truncate-state + 076  (defn truncate-state
- 059    "Truncate the print name of the state of this cell to at most limit characters." + 077    "Truncate the print name of the state of this cell to at most limit characters."
- 060    [cell limit] + 078    [cell limit]
- 061    (let [s (:state cell)] -
- - 062      (cond (> (count (str s)) limit) (subs s 0 limit) + 079    (let [s (:state cell)]
- 063            :else s))) + 080      (try +
+ + 081        (cond (> (count (str s)) limit) (subs (name s) 0 limit) +
+ + 082            :else s) +
+ + 083        (catch Exception any  +
+ + 084          (throw (ex-info (.getMessage any)  +
+ + 085                          {:cell cell +
+ + 086                           :limit limit +
+ + 087                           :exception-class (.getClass any)}))))))
- 064   + 088  
- 065  (defn format-cell + 089  (defn format-cell
- 066    "Return a formatted string summarising the current state of this cell." + 090    "Return a formatted string summarising the current state of this cell."
- 067    [cell] + 091    [cell]
- 068    (format "%10s(%2d/%2d)" + 092    (format "%10s"
- 069            (truncate-state cell 10) -
- - 070            (population cell :deer) -
- - 071            (population cell :wolves))) + 093            (truncate-state cell 10)))
- 072   + 094  
- 073  (defn- format-world-row + 095  (defn- format-world-row
- 074    "Format one row in the state of a world for printing." + 096    "Format one row in the state of a world for printing."
- 075    [row] + 097    [row]
- 076    (string/join (map format-cell row))) + 098    (string/join (map format-cell row)))
- 077   + 099  
- 078  (defn print-world + 100  (defn print-world
- 079    "Print the current state of this world, and return nil. + 101    "Print the current state of this world, and return nil.
- 080   + 102  
- 081    * `world` a world as defined above." + 103    * `world` a world as defined above."
- 082    [world] + 104    [world]
- 083    (println) + 105    (println)
- 084    (dorun + 106    (dorun
- 085     (map + 107     (map
- 086      #(println + 108      #(println
- 087        (format-world-row %)) + 109        (format-world-row %))
- 088      world)) + 110      world))
- 089    nil) + 111    nil)
diff --git a/project.clj b/project.clj index 02eabd2..a11a4d0 100644 --- a/project.clj +++ b/project.clj @@ -4,7 +4,9 @@ :doc/format :markdown} :output-path "docs/codox" :source-uri "https://github.com/simon-brooke/mw-engine/blob/master/{filepath}#L{line}"} - :dependencies [[org.clojure/clojure "1.11.1"] + :dependencies [[com.github.pmonks/embroidery "0.1.20"] ;; better pmap? + [distributions "0.1.2"] ;; mainly for investigating drainage + [org.clojure/clojure "1.11.1"] [org.clojure/clojurescript "1.11.60" :scope "provided"] [org.clojure/math.combinatorics "0.2.0"] [org.clojure/tools.trace "0.7.11"] diff --git a/resources/heightmaps/20x20/crucible.png b/resources/heightmaps/20x20/crucible.png new file mode 100644 index 0000000000000000000000000000000000000000..a1f21a6863695032cba41f6be95885cb0813504b GIT binary patch literal 1356 zcmV-S1+)5zP)EX>4Tx04R}tkv&MmKp2MKrqzm69PFUt5TrWUMMWHI6^c+H)C#RSm|Xe?O&XFG z7e~Rh;NZ_<)xpJCR|i)?5c~mgc5qU3krKa43N2#1;4>lYR+PSPb7{p!>kf-5YKE@ z4bJ<-VOEq?;&b8&lP*a7$aTf#H_ioz1)do;)2VslFtJ$ZV5Ngu(bR~ii6g3}Q@)UK zS>?RNSu59A>z@3Dp`5<5%yn8LNMI35kRU=q4JDLOMU-}(6bmUjk9+us9lt~_g4!CxZD8-pA6ZQ9m!8i$mfCgGy0}1FmMa>uDN|{o#XTYNK>zpH^9Lm zFkYbSb&q%VboTAvnpXdQ09fjBoV9U@HUIzs24YJ`L;wH)0002_L%V+f000SaNLh0L z01FcU01FcV0GgZ_00007bV*G`2j~O_1~4cHRw(EI000?uMObu0Z*6U5Zgc=ca%Ew3 zWn>_CX>@2HM@dakSAh-}0009cNkl6EhTw)o-QDcREpm6?c*B)j+=au; z@SHh3dpI*A_`dJ+KYsFWMZ+-gJP%#hIXgR}QmN3{*-0{)q`SKtQ5651pkWvsA0Kma za>D57D2t1WJUl$GySs}hifEd~`1m-})6?|z_5Ch*b#=w&<|f5rk$Sz(>+372RElUc z%GcKyk|bfSS+%!vBAg32c~IaSr(>gVwxr|FE1#H60U=~ zWm$ZGf0N7QxV*dsXb3uv!_LkQhG9^z*RgFI%d)U-8^>|bb)9m#jOTgSwjCnie13ki zy}eDfT5SkEK0cDq=c(80Kj1hHnM{U(fdO<~XKro|UDtnb0&AY0o;Wx-Xn1&ccZX$J zIF5tkIJmBh<2a<#X|mZY!^6WwA`#;8IKJFDS{5CkHT2)(_%xUP#Ria+*vo=2%vYK={BaD3mVQmIg_RK5(x~$K$4`;CqWQG1l(XQ19WwDH8S)!BuPRPMc&@t zSY2Hu9*?7G8u$12xUL)4{|Qag8iIp^gD8rEEX&BUjN>@SvW)NhxUNgFSp0LeWEn}4 z!f-dQ$HvAQu}LPAq*AGnpeV|(P*oLGRYSfk%k=d0Fh4)v=ulNvW@l%)zP`ruywGex z5O7@=*LA}V1528PRaIqXW~O0XKpYwxVrglKXf#SB68V9)wzhB#=FOOxm>`qMG@59> zU_H;{^z@Xitu1P`S{U-?uA481Kx}1Yh4%LLR>2@sx3{u;NKR8IGcYt{00I#x2C=6Bu^ZTWErhvpis@G@~msIAYDir7EWTt3xX{4nm=jY@XDQJKx-JXFzGCaPkP zn~?xx77_=>goQ20Z*0DaB_*jK8Bm~s02>g40`xx+D}vbe4L}kY=s*k-2kGL3vVjzX z5)xYmiOq$?RzPBNBe8jq*t|$=ejpoU9}KVq86dks=Bq;4K#D;H#QqNiKw24zjhrZe z!Z5&80Am4ZSSWzZ1p=lX2n{A-av<>~Fmb8>Kie|^6sYU+YvNF-vnY}|xN8i}eY1Ln*{|yYw@A+67>8h(V z>{U`x*DuBrXv z|Eq0{wN+%3w!i&yr&dBnNz=$W?Eh42Lrq2L`WyfLKb|crrJ!zL=?D_jP?Rb-{p06_ z4iQOtb$ts5s5*m5yZ6npgs5})zY1)ggt)n*xQIB|Jg@)foj~@=NHU4NmynhR+H2SS z|7W?iG0=T-Ow#XV6;-tiEkj@Z|9{2J(nv>Lg-P+JvYNJ`x&1n(|L^~0n|kXRC;SHhIwlRA literal 0 HcmV?d00001 diff --git a/resources/test.edn b/resources/test.edn new file mode 100644 index 0000000..a7a8e05 --- /dev/null +++ b/resources/test.edn @@ -0,0 +1 @@ +{:hello "goodbye"} \ No newline at end of file diff --git a/src/cljc/mw_engine/core.clj b/src/cljc/mw_engine/core.clj index 11cf114..588aa25 100644 --- a/src/cljc/mw_engine/core.clj +++ b/src/cljc/mw_engine/core.clj @@ -22,7 +22,8 @@ further rules can be applied to that cell." :author "Simon Brooke"} mw-engine.core - (:require [mw-engine.flow :refer [flow-world]] + (:require [clojure.set :refer [difference]] + [mw-engine.flow :refer [flow-world]] [mw-engine.utils :refer [add-history-event get-int-or-zero map-world rule-type]] [taoensso.timbre :as l])) @@ -54,6 +55,10 @@ memory problems. Make it optional, but by default false." false) +(def known-rule-types + "Types of rules we know about." + #{:ad-hoc :flow :production}) + (defn apply-rule "Apply a single `rule` to a `cell`. What this is about is that I want to be able, for debugging purposes, to tag a cell with the rule text of the rule which @@ -119,27 +124,37 @@ ;; Yes, that `list` is there for a reason! (list (filter - #(= :production (rule-type %)) + #(#{:ad-hoc :production} (rule-type %)) rules)))) (defn run-world - "Run this world with these rules for this number of generations. + "Run this `world` with these `rules` for this number of `generations`. * `world` a world as discussed above; * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; * `rules` a sequence of rules as defined above, to be run iteratively for each generation; * `generations` an (integer) number of generations. - **NOTE THAT** all rules **must** be tagged with `rule-type` metadata, or thet **will not** + **NOTE THAT** all rules **must** be tagged with `rule-type` metadata, or they **will not** be executed. Return the final generation of the world." ([world rules generations] (run-world world rules rules (dec generations))) ([world init-rules rules generations] - (reduce (fn [world iteration] - (l/info "Running iteration " iteration) - (let [w' (transform-world world rules)] - (flow-world w' rules))) - (transform-world world init-rules) - (range generations)))) + + (let [found-types (map rule-type (concat init-rules rules))] + (if (every? known-rule-types found-types) + (reduce (fn [world iteration] + (l/info "Running iteration " iteration) + (let [w' (transform-world world rules)] + (flow-world w' rules))) + (transform-world world init-rules) + (range generations)) + (let [unexpected (difference (set found-types) known-rule-types)] + (throw + (ex-info (format + "Unexpected rule type(s) %s found. Expected types are %s" + unexpected + known-rule-types) + {:types unexpected}))))))) diff --git a/src/cljc/mw_engine/drainage.clj b/src/cljc/mw_engine/drainage.clj index 606282e..4280c05 100644 --- a/src/cljc/mw_engine/drainage.clj +++ b/src/cljc/mw_engine/drainage.clj @@ -2,12 +2,13 @@ compute drainage on a world, assumed to have altitudes already set from a heightmap." :author "Simon Brooke"} - mw-engine.drainage + mw-engine.drainage (:require [mw-engine.core :refer [run-world]] - [mw-engine.heightmap :as heightmap] + [mw-engine.heightmap :refer [apply-heightmap]] [mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours get-neighbours-with-property-value - map-world]])) + map-world]] + [taoensso.timbre :refer [info]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -42,17 +43,17 @@ "Compute rainfall for a cell with this `gradient` west-east, given `remaining` drops to distribute, and this overall map width." [gradient remaining map-width] - (cond + (cond ;; if there's no rain left in the cloud, it can't fall; - (zero? remaining) - 0 - (pos? gradient) + (zero? remaining) + 0 + (pos? gradient) ;; rain, on prevailing westerly wind, falls preferentially on rising ground; - (int (rand gradient)) + (int (rand gradient)) ;; rain falls randomly across the width of the map... - (zero? (int (rand map-width))) 1 - :else - 0)) + (zero? (int (rand map-width))) 1 + :else + 0)) (defn rain-row "Return a row like this `row`, across which rainfall has been distributed; @@ -71,12 +72,12 @@ rising (- alt previous-altitude) fall (rainfall rising drops-in-cloud map-width)] (cons - (assoc cell :rainfall fall) - (rain-row (rest row) map-width alt (- drops-in-cloud fall)))) + (assoc cell :rainfall fall) + (rain-row (rest row) map-width alt (- drops-in-cloud fall)))) :else (map - #(assoc % :rainfall 0) - row)))) + #(assoc % :rainfall 0) + row)))) (defn rain-world @@ -84,8 +85,8 @@ rain more on west-facing slopes, and less to the east of high ground" [world] (map - rain-row - world)) + rain-row + world)) (defn flow-contributors @@ -95,14 +96,14 @@ [cell world] (filter #(map? %) (map - (fn [n] - (cond - (= cell (get-least-cell (get-neighbours world n) :altitude)) n - (and (= (:altitude cell) (:altitude n)) - (> (or (:flow n) 0) (or (:flow cell) 0))) n)) - (get-neighbours-with-property-value - world (:x cell) (:y cell) 1 :altitude - (or (:altitude cell) 0) >=)))) + (fn [n] + (cond + (= cell (get-least-cell (get-neighbours world n) :altitude)) n + (and (= (:altitude cell) (:altitude n)) + (> (or (:flow n) 0) (or (:flow cell) 0))) n)) + (get-neighbours-with-property-value + world (:x cell) (:y cell) 1 :altitude + (or (:altitude cell) 0) >=)))) (defn is-hollow @@ -116,17 +117,17 @@ altitude (get-int-or-zero cell :altitude)] (= (count neighbours) (count (get-neighbours-with-property-value - world (:x cell) (:y cell) 1 :altitude altitude >))))) + world (:x cell) (:y cell) 1 :altitude altitude >))))) (defn flood-hollow "Raise the altitude of a copy of this `cell` of this `world` to the altitude of the lowest of its `neighbours`." ([_world cell neighbours] - (let [lowest (get-least-cell neighbours :altitude)] - (merge cell {:state :water :altitude (:altitude lowest)}))) + (let [lowest (get-least-cell neighbours :altitude)] + (merge cell {:state :water :altitude (:altitude lowest)}))) ([world cell] - (flood-hollow world cell (get-neighbours world cell)))) + (flood-hollow world cell (get-neighbours world cell)))) (defn flood-hollows @@ -146,14 +147,21 @@ `flow-world-nr`." [cell world] (when (= (- max-altitude (get-int-or-zero cell :generation)) - (get-int-or-zero cell :altitude)) - (merge cell - {:flow (reduce + - (map - #(+ (get-int-or-zero % :rainfall) - (get-int-or-zero % :flow)) - (flow-contributors cell world)))}))) + (get-int-or-zero cell :altitude)) + (let [contributors (flow-contributors cell world)] + (when contributors + (merge cell + {:flow (reduce + + (map + #(+ (get-int-or-zero % :rainfall) + (get-int-or-zero % :flow)) + contributors))}))))) +(defn flow-nr-wrapper + [cell world] + (do + (info (format "Flowing cell at %d, %d" (:x cell) (:y cell))) + (flow-nr cell world))) (def flow "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical @@ -165,20 +173,19 @@ (memoize (fn [cell world] (cond - (not (nil? (:flow cell))) cell - (<= (or (:altitude cell) 0) *sealevel*) cell - :else - (merge cell - {:flow (+ (:rainfall cell) - (apply + - (map (fn [neighbour] (:flow (flow neighbour world))) - (flow-contributors cell world))))}))))) - + (not (nil? (:flow cell))) cell + (<= (or (:altitude cell) 0) *sealevel*) cell + :else + (merge cell + {:flow (+ (:rainfall cell) + (apply + + (map (fn [neighbour] (:flow (flow neighbour world))) + (flow-contributors cell world))))}))))) (defn flow-world-nr "Experimental non-recursive flow-world algorithm" [world] - (run-world world nil (list flow-nr) max-altitude)) + (run-world world (list (vary-meta flow-nr assoc :rule-type :ad-hoc)) max-altitude)) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of @@ -189,8 +196,7 @@ (defn explore-lake "Return a sequence of cells starting with this `cell` in this `world` which form a contiguous lake" - [_world _cell] - ) + [_world _cell]) (defn is-lake? "If this `cell` in this `world` is not part of a lake, return nil. If it is, @@ -198,20 +204,21 @@ [world cell] (if ;; if it's already tagged as a lake, it's a lake - (:lake cell) cell - (let - [outflow (apply min (map :altitude (get-neighbours world cell)))] - (when-not - (> (:altitude cell) outflow) - (assoc cell :lake true))))) + (:lake cell) cell + (let + [outflow (apply min (map :altitude (get-neighbours world cell)))] + (when-not + (> (:altitude cell) outflow) + (assoc cell :lake true :state :lake))))) (defn find-lakes - [_world] - ) + [_world]) (defn run-drainage "Create a world from the heightmap `hmap`, rain on it, and then compute river flows." [hmap] - (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap))))) + (flow-world (rain-world (flood-hollows (apply-heightmap hmap))))) + +;; (run-drainage "resources/heightmaps/20x20/crucible.png") \ No newline at end of file diff --git a/src/cljc/mw_engine/heightmap.clj b/src/cljc/mw_engine/heightmap.clj index ea87d31..24c250d 100644 --- a/src/cljc/mw_engine/heightmap.clj +++ b/src/cljc/mw_engine/heightmap.clj @@ -32,12 +32,6 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defn abs - "Prior to Clojure 1.11, there is no native `abs` function. Afterwards, there - is." - [n] - (Math/abs n)) - (defn tag-property "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`. If the heightmap you supply is smaller than the world, this will break. diff --git a/src/cljc/mw_engine/render.clj b/src/cljc/mw_engine/render.clj index 2416a76..ba76005 100644 --- a/src/cljc/mw_engine/render.clj +++ b/src/cljc/mw_engine/render.clj @@ -35,7 +35,7 @@ "Format this statekey, assumed to be a keyword indicating a state in the world, into a CSS class" [statekey] - (name statekey)) + (when statekey (name statekey))) (defn format-image-path "Render this statekey, assumed to be a keyword indicating a state in the diff --git a/src/cljc/mw_engine/utils.clj b/src/cljc/mw_engine/utils.clj index ff2b066..a45ef0e 100644 --- a/src/cljc/mw_engine/utils.clj +++ b/src/cljc/mw_engine/utils.clj @@ -3,7 +3,8 @@ :author "Simon Brooke"} mw-engine.utils (:require [clojure.math.combinatorics :as combo] - [clojure.string :refer [join]])) + [clojure.string :refer [join]] + [embroidery.api :refer [pmap*]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -108,7 +109,7 @@ (map-world world function nil)) ([world function additional-args] (into [] - (pmap (fn [row] + (pmap* (fn [row] (into [] (map #(apply function (cons world (cons % additional-args))) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj deleted file mode 100644 index 866087d..0000000 --- a/src/mw_engine/core.clj +++ /dev/null @@ -1,134 +0,0 @@ -(ns ^{:doc "Functions to transform a world and run rules." - :author "Simon Brooke"} - mw-engine.core - (:require [clojure.core.reducers :as r] - [clojure.string :refer [join]] - [mw-engine.world :as world] - [mw-engine.utils :refer [get-int-or-zero map-world]] - [taoensso.timbre :as l])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; mw-engine: the state/transition engine of MicroWorld. -;;;; -;;;; This program is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU General Public License -;;;; as published by the Free Software Foundation; either version 2 -;;;; of the License, or (at your option) any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this program; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;;;; USA. -;;;; -;;;; Copyright (C) 2014 Simon Brooke -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; Every rule is a function of two arguments, a cell and a world. If the rule -;;;; fires, it returns a new cell, which should have the same values for :x and -;;;; :y as the old cell. Anything else can be modified. -;;;; -;;;; While any function of two arguments can be used as a rule, a special high -;;;; level rule language is provided by the `mw-parser` package, which compiles -;;;; rules expressed in a subset of English rules into suitable functions. -;;;; -;;;; A cell is a map containing at least values for the keys :x, :y, and :state; -;;;; a transformation should not alter the values of :x or :y, and should not -;;;; return a cell without a keyword as the value of :state. Anything else is -;;;; legal. -;;;; -;;;; A world is a two dimensional matrix (sequence of sequences) of cells, such -;;;; that every cell's :x and :y properties reflect its place in the matrix. -;;;; See `world.clj`. -;;;; -;;;; Each time the world is transformed (see `transform-world`, for each cell, -;;;; rules are applied in turn until one matches. Once one rule has matched no -;;;; further rules can be applied. -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn apply-rule - "Apply a single `rule` to a `cell`. What this is about is that I want to be able, - for debugging purposes, to tag a cell with the rule text of the rule which - fired (and especially so when an exception is thrown. So a rule may be either - an ifn, or a list (ifn source-text). This function deals with despatching - on those two possibilities. `world` is also passed in in order to be able - to access neighbours." - ([world cell rule] - (cond - (ifn? rule) (apply-rule world cell rule nil) - (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src)))) - ([world cell rule source] - (let [result (apply rule (list cell world))] - (cond - (and result source) (merge result {:rule source}) - true result)))) - - -(defn- apply-rules - "Derive a cell from this `cell` of this `world` by applying these `rules`." - [world cell rules] - (cond (empty? rules) cell - true (let [result (apply-rule world cell (first rules))] - (cond result result - true (apply-rules world cell (rest rules)))))) - - -(defn- transform-cell - "Derive a cell from this `cell` of this `world` by applying these `rules`. If an - exception is thrown, cache its message on the cell and set it's state to error" - [world cell rules] - (try - (merge - (apply-rules world cell rules) - {:generation (+ (get-int-or-zero cell :generation) 1)}) - (catch Exception e - (merge cell {:error - (format "%s at generation %d when in state %s" - (.getMessage e) - (:generation cell) - (:state cell)) - :stacktrace (map #(.toString %) (.getStackTrace e)) - :state :error})))) - - -(defn transform-world - "Return a world derived from this `world` by applying these `rules` to each cell." - [world rules] - (map-world world transform-cell (list rules))) - - -(defn- transform-world-state - "Consider this single argument as a map of `:world` and `:rules`; apply the rules - to transform the world, and return a map of the new, transformed `:world` and - these `:rules`. As a side effect, print the world." - [state] - (let [world (transform-world (:world state) (:rules state))] - ;;(world/print-world world) - {:world world :rules (:rules state)})) - - -(defn run-world - "Run this world with these rules for this number of generations. - - * `world` a world as discussed above; - * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; - * `rules` a sequence of rules as defined above, to be run iteratively for each generation; - * `generations` an (integer) number of generations. - - Return the final generation of the world." - [world init-rules rules generations] - (reduce (fn [world iteration] - (l/info "Running iteration " iteration) - (transform-world world rules)) - (transform-world world init-rules) - (range generations))) - - -