Minor changes to render-world; changes to settlement ruleset to deal

with land empoverishment.
This commit is contained in:
Simon Brooke 2014-07-25 11:55:34 +01:00
parent 2695554607
commit b5e28496f3
4 changed files with 41 additions and 50 deletions

View file

@ -3032,8 +3032,8 @@ net.brehaut.ClojureTools = (function (SH) {
</div><div class="dependencies"><h3>dependencies</h3><table><tr><td class="dep-name">org.clojure/clojure</td><td class="dotted"><hr /></td><td class="dep-version">1.5.1</td></tr><tr><td class="dep-name">org.clojure/math.combinatorics</td><td class="dotted"><hr /></td><td class="dep-version">0.0.7</td></tr><tr><td class="dep-name">org.clojure/tools.trace</td><td class="dotted"><hr /></td><td class="dep-version">0.7.8</td></tr><tr><td class="dep-name">net.mikera/imagez</td><td class="dotted"><hr /></td><td class="dep-version">0.3.1</td></tr><tr><td class="dep-name">fivetonine/collage</td><td class="dotted"><hr /></td><td class="dep-version">0.2.1</td></tr></table></div></td><td class="codes" style="text-align: center; vertical-align: middle;color: #666;padding-right:20px"><br /><br /><br />(this space intentionally left almost blank)</td></tr><tr><td class="docs"><div class="toc"><a name="toc"><h3>namespaces</h3></a><ul><li><a href="#mw-engine.core">mw-engine.core</a></li><li><a href="#mw-engine.heightmap">mw-engine.heightmap</a></li><li><a href="#mw-engine.natural-rules">mw-engine.natural-rules</a></li><li><a href="#mw-engine.utils">mw-engine.utils</a></li><li><a href="#mw-engine.world">mw-engine.world</a></li></ul></div></td><td class="codes">&nbsp;</td></tr><tr><td class="docs"><div class="docs-header"><a class="anchor" href="#mw-engine.core" name="mw-engine.core"><h1 class="project-name">mw-engine.core</h1><a class="toc-link" href="#toc">toc</a></a></div></td><td class="codes" /></tr><tr><td class="docs"><p>Functions to transform a world and run rules.</p> </div><div class="dependencies"><h3>dependencies</h3><table><tr><td class="dep-name">org.clojure/clojure</td><td class="dotted"><hr /></td><td class="dep-version">1.5.1</td></tr><tr><td class="dep-name">org.clojure/math.combinatorics</td><td class="dotted"><hr /></td><td class="dep-version">0.0.7</td></tr><tr><td class="dep-name">org.clojure/tools.trace</td><td class="dotted"><hr /></td><td class="dep-version">0.7.8</td></tr><tr><td class="dep-name">net.mikera/imagez</td><td class="dotted"><hr /></td><td class="dep-version">0.3.1</td></tr><tr><td class="dep-name">fivetonine/collage</td><td class="dotted"><hr /></td><td class="dep-version">0.2.1</td></tr></table></div></td><td class="codes" style="text-align: center; vertical-align: middle;color: #666;padding-right:20px"><br /><br /><br />(this space intentionally left almost blank)</td></tr><tr><td class="docs"><div class="toc"><a name="toc"><h3>namespaces</h3></a><ul><li><a href="#mw-engine.core">mw-engine.core</a></li><li><a href="#mw-engine.heightmap">mw-engine.heightmap</a></li><li><a href="#mw-engine.natural-rules">mw-engine.natural-rules</a></li><li><a href="#mw-engine.utils">mw-engine.utils</a></li><li><a href="#mw-engine.world">mw-engine.world</a></li></ul></div></td><td class="codes">&nbsp;</td></tr><tr><td class="docs"><div class="docs-header"><a class="anchor" href="#mw-engine.core" name="mw-engine.core"><h1 class="project-name">mw-engine.core</h1><a class="toc-link" href="#toc">toc</a></a></div></td><td class="codes" /></tr><tr><td class="docs"><p>Functions to transform a world and run rules.</p>
</td><td class="codes"></td></tr><tr><td class="docs"> </td><td class="codes"></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(ns mw-engine.core </td><td class="codes"><pre class="brush: clojure">(ns mw-engine.core
(:require [mw-engine.world :as world] (:use mw-engine.utils)
mw-engine.utils))</pre></td></tr><tr><td class="docs"><p>Every rule is a function of two arguments, a cell and a world. If the rule (:require [mw-engine.world :as world]))</pre></td></tr><tr><td class="docs"><p>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 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.</p> :y as the old cell. Anything else can be modified.</p>
@ -3053,13 +3053,14 @@ See <code>world.clj</code>.</p>
<p>Each time the world is transformed (see <code>transform-world</code>, for each cell, <p>Each time the world is transformed (see <code>transform-world</code>, for each cell,
rules are applied in turn until one matches. Once one rule has matched no rules are applied in turn until one matches. Once one rule has matched no
further rules can be applied.</p> further rules can be applied.</p>
</td><td class="codes"></td></tr><tr><td class="docs"><p>Apply a single rule to a cell. What this is about is that I want to be able, </td><td class="codes"></td></tr><tr><td class="docs"><p>Apply a single <code>rule</code> to a <code>cell</code>. 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 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 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 an ifn, or a list (ifn source-text). This function deals with despatching
on those two possibilities.</p> on those two possibilities. <code>world</code> is also passed in in order to be able
to access neighbours.</p>
</td><td class="codes"><pre class="brush: clojure">(defn apply-rule </td><td class="codes"><pre class="brush: clojure">(defn apply-rule
([cell world rule] ([world cell rule]
(cond (cond
(ifn? rule) (apply-rule cell world rule nil) (ifn? rule) (apply-rule cell world rule nil)
(seq? rule) (let [[afn src] rule] (apply-rule cell world afn src)))) (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
@ -3067,35 +3068,30 @@ further rules can be applied.</p>
(let [result (apply rule (list cell world))] (let [result (apply rule (list cell world))]
(cond (cond
(and result source) (merge result {:rule source}) (and result source) (merge result {:rule source})
true result))))</pre></td></tr><tr><td class="docs"><p>Derive a cell from this cell of this world by applying these rules.</p> true result))))</pre></td></tr><tr><td class="docs"><p>Derive a cell from this <code>cell</code> of this <code>world</code> by applying these <code>rules</code>.</p>
</td><td class="codes"><pre class="brush: clojure">(defn- apply-rules </td><td class="codes"><pre class="brush: clojure">(defn- apply-rules
[cell world rules] [world cell rules]
(cond (empty? rules) cell (cond (empty? rules) cell
true (let [result (apply-rule cell world (first rules))] true (let [result (apply-rule world cell (first rules))]
(cond result result (cond result result
true (apply-rules cell world (rest rules))))))</pre></td></tr><tr><td class="docs"><p>Derive a cell from this cell of this world by applying these rules. If an true (apply-rules world cell (rest rules))))))</pre></td></tr><tr><td class="docs"><p>Derive a cell from this <code>cell</code> of this <code>world</code> by applying these <code>rules</code>. If an
exception is thrown, cache its message on the cell and set state to error</p> exception is thrown, cache its message on the cell and set it's state to error</p>
</td><td class="codes"><pre class="brush: clojure">(defn- transform-cell </td><td class="codes"><pre class="brush: clojure">(defn- transform-cell
[cell world rules] [world cell rules]
(try (try
(merge (merge
(apply-rules cell world rules) (apply-rules world cell rules)
{:generation (+ (or (:generation cell) 0) 1)}) {:generation (+ (or (:generation cell) 0) 1)})
(catch Exception e (catch Exception e
(merge cell {:error (merge cell {:error
(format &quot;%s at generation %d when in state %s&quot; (format &quot;%s at generation %d when in state %s&quot;
(.getMessage e) (.getMessage e)
(:generation cell) (:generation cell)
(:state cell))}))))</pre></td></tr><tr><td class="docs"><p>Return a row derived from this row of this world by applying these rules to each cell.</p> (:state cell))
</td><td class="codes"><pre class="brush: clojure">(defn- transform-world-row :state :error}))))</pre></td></tr><tr><td class="docs"><p>Return a world derived from this <code>world</code> by applying these <code>rules</code> to each cell.</p>
[row world rules]
(apply vector (map #(transform-cell % world rules) row)))</pre></td></tr><tr><td class="docs"><p>Return a world derived from this world by applying these rules to each cell.</p>
</td><td class="codes"><pre class="brush: clojure">(defn transform-world </td><td class="codes"><pre class="brush: clojure">(defn transform-world
[world rules] [world rules]
(apply vector (map-world world transform-cell (list rules)))</pre></td></tr><tr><td class="docs"><p>Consider this single argument as a map of <code>:world</code> and <code>:rules</code>; apply the rules
(map
#(transform-world-row % world rules)
world)))</pre></td></tr><tr><td class="docs"><p>Consider this single argument as a map of <code>:world</code> and <code>:rules</code>; apply the rules
to transform the world, and return a map of the new, transformed <code>:world</code> and to transform the world, and return a map of the new, transformed <code>:world</code> and
these <code>:rules</code>. As a side effect, print the world.</p> these <code>:rules</code>. As a side effect, print the world.</p>
</td><td class="codes"><pre class="brush: clojure">(defn- transform-world-state </td><td class="codes"><pre class="brush: clojure">(defn- transform-world-state
@ -3139,11 +3135,14 @@ ignored). Darker shades are higher.</p>
(cond (&lt; n 0) (- 0 n) true n))</pre></td></tr><tr><td class="docs"><p>Set the <code>gradient</code> property of this <code>cell</code> of this <code>world</code> to the difference in (cond (&lt; n 0) (- 0 n) true n))</pre></td></tr><tr><td class="docs"><p>Set the <code>gradient</code> property of this <code>cell</code> of this <code>world</code> to the difference in
altitude between its highest and lowest neghbours.</p> altitude between its highest and lowest neghbours.</p>
</td><td class="codes"><pre class="brush: clojure">(defn tag-gradient </td><td class="codes"><pre class="brush: clojure">(defn tag-gradient
[cell world] [world cell]
(let [heights (map '(:altitude %) (get-neighbours world cell)) (let [heights (remove nil? (map #(:altitude %) (get-neighbours world cell)))
highest (apply max heights) highest (cond (empty? heights) 0 ;; shouldn't happen
lowest (apply min heights)] true (apply max heights))
#(merge cell {:gradient (- highest lowest)})))</pre></td></tr><tr><td class="docs"><p>Set the <code>gradient</code> property of each cell in this <code>world</code> to the difference in lowest (cond (empty? heights) 0 ;; shouldn't
true (apply min heights))
gradient (- highest lowest)]
(merge cell {:gradient gradient})))</pre></td></tr><tr><td class="docs"><p>Set the <code>gradient</code> property of each cell in this <code>world</code> to the difference in
altitude between its highest and lowest neghbours.</p> altitude between its highest and lowest neghbours.</p>
</td><td class="codes"><pre class="brush: clojure">(defn tag-gradients </td><td class="codes"><pre class="brush: clojure">(defn tag-gradients
[world] [world]
@ -3169,19 +3168,7 @@ ignored). Darker shades are higher.</p>
(mod (mod
(.getRGB heightmap (.getRGB heightmap
(get-int cell :x) (get-int cell :x)
(get-int cell :y)) 256))))})))</pre></td></tr><tr><td class="docs"><p>Set the altitude of each cell in this sequence from the corresponding pixel (get-int cell :y)) 256))))})))</pre></td></tr><tr><td class="docs"><p>Apply the image file loaded from this path to this world, and return a world whose
of this heightmap.
If the heightmap you supply is smaller than the world, this will break.</p>
<ul>
<li><code>row</code> a row in a world, as discussed in world.clj, q.v. Alternatively, a
sequence of maps;</li>
<li><code>heightmap</code> an (ideally) greyscale image, whose x and y dimensions should
exceed those of the world of which the <code>cell</code> forms part.</li>
</ul>
</td><td class="codes"><pre class="brush: clojure">(defn- apply-heightmap-row
[row heightmap]
(apply vector (map #(transform-altitude % heightmap) row)))</pre></td></tr><tr><td class="docs"><p>Apply the image file loaded from this path to this world, and return a world whose
altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that
the heightmap is at least as large in x and y dimensions as the world.</p> the heightmap is at least as large in x and y dimensions as the world.</p>
@ -3359,7 +3346,7 @@ important.</p>
</td><td class="codes"><pre class="brush: clojure">(defn in-bounds </td><td class="codes"><pre class="brush: clojure">(defn in-bounds
[world x y] [world x y]
(and (&gt;= x 0)(&gt;= y 0)(&lt; y (count world))(&lt; x (count (first world)))))</pre></td></tr><tr><td class="docs"><p>Apply this <code>function</code> to each cell in this <code>world</code> to produce a new world. (and (&gt;= x 0)(&gt;= y 0)(&lt; y (count world))(&lt; x (count (first world)))))</pre></td></tr><tr><td class="docs"><p>Apply this <code>function</code> to each cell in this <code>world</code> to produce a new world.
the arguments to the function will be the cell, the world, and any the arguments to the function will be the world, the cell, and any
<code>additional-args</code> supplied</p> <code>additional-args</code> supplied</p>
</td><td class="codes"><pre class="brush: clojure">(defn map-world </td><td class="codes"><pre class="brush: clojure">(defn map-world
([world function] ([world function]

View file

@ -3146,7 +3146,7 @@ net.brehaut.ClojureTools = (function (SH) {
[:img {:alt (:state cell) :src (format-image-path state)}]]]))</pre></td></tr><tr><td class="docs"><p>Render this world row as a Hiccup table row.</p> [:img {:alt (:state cell) :src (format-image-path state)}]]]))</pre></td></tr><tr><td class="docs"><p>Render this world row as a Hiccup table row.</p>
</td><td class="codes"><pre class="brush: clojure">(defn render-world-row </td><td class="codes"><pre class="brush: clojure">(defn render-world-row
[row] [row]
(apply vector (cons :tr (map render-cell row))))</pre></td></tr><tr><td class="docs"><p>Render the world implied by the session as a complete HTML page.</p> (apply vector (cons :tr (map render-cell row))))</pre></td></tr><tr><td class="docs"><p>Render the world implied by the current session as a complete HTML table in a DIV.</p>
</td><td class="codes"><pre class="brush: clojure">(defn render-world-table </td><td class="codes"><pre class="brush: clojure">(defn render-world-table
[] []
(let [world (or (session/get :world) (let [world (or (session/get :world)
@ -3169,7 +3169,8 @@ net.brehaut.ClojureTools = (function (SH) {
(apply vector (apply vector
(cons :table (cons :table
(map render-world-row w2))) (map render-world-row w2)))
[:p (str &quot;Generation &quot; generation)]]))</pre></td></tr><tr><td class="docs"> [:p
(str &quot;Generation &quot; generation)]]))</pre></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(defn render-inspector </td><td class="codes"><pre class="brush: clojure">(defn render-inspector
[cell table] [cell table]
[:table {:class &quot;music-ruled&quot;} [:table {:class &quot;music-ruled&quot;}

View file

@ -34,8 +34,9 @@ if state is pasture and fertility is more than 10 and altitude is less than 100
if state is ploughland then state should be crop if state is ploughland then state should be crop
;; after the crop is harvested, the land is allowed to lie fallow ;; after the crop is harvested, the land is allowed to lie fallow. But cropping
if state is crop then state should be grassland ;; 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 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 in camp or abandoned and some neighbours are crop then state should be house
@ -126,3 +127,5 @@ if state is new and altitude is more than 200 then state should be snow
;; otherwise, we have grassland. ;; otherwise, we have grassland.
if state is new then state should be grassland if state is new then state should be grassland

View file

@ -37,7 +37,7 @@
(apply vector (cons :tr (map render-cell row)))) (apply vector (cons :tr (map render-cell row))))
(defn render-world-table (defn render-world-table
"Render the world implied by the session as a complete HTML page." "Render the world implied by the current session as a complete HTML table in a DIV."
[] []
(let [world (or (session/get :world) (let [world (or (session/get :world)
(engine/transform-world (engine/transform-world
@ -57,11 +57,11 @@
(session/put! :world w2) (session/put! :world w2)
(session/put! :generation generation) (session/put! :generation generation)
[:div {:class "world"} [:div {:class "world"}
(apply vector (apply vector
(cons :table (cons :table
(map render-world-row w2))) (map render-world-row w2)))
[:p (str "Generation " generation)]])) [:p
(str "Generation " generation)]]))
(defn render-inspector (defn render-inspector
[cell table] [cell table]