Minor changes to render-world; changes to settlement ruleset to deal
with land empoverishment.
This commit is contained in:
parent
2695554607
commit
b5e28496f3
|
@ -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"> </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"> </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 "%s at generation %d when in state %s"
|
(format "%s at generation %d when in state %s"
|
||||||
(.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 (< 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 (< 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 (>= x 0)(>= y 0)(< y (count world))(< 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 (>= x 0)(>= y 0)(< y (count world))(< 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]
|
||||||
|
|
|
@ -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 "Generation " generation)]]))</pre></td></tr><tr><td class="docs">
|
[:p
|
||||||
|
(str "Generation " 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 "music-ruled"}
|
[:table {:class "music-ruled"}
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in a new issue