Considerable refactoring based on the new map-world utility function.
This commit is contained in:
parent
4949e30f69
commit
75475ece29
|
@ -1,8 +1,9 @@
|
||||||
;; Functions to transform a world and run rules.
|
;; Functions to transform a world and run rules.
|
||||||
|
|
||||||
(ns mw-engine.core
|
(ns mw-engine.core
|
||||||
|
(:use mw-engine.utils)
|
||||||
(:require [mw-engine.world :as world]
|
(:require [mw-engine.world :as world]
|
||||||
mw-engine.utils))
|
))
|
||||||
|
|
||||||
;; Every rule is a function of two arguments, a cell and a world. If the rule
|
;; 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
|
||||||
|
@ -27,12 +28,13 @@
|
||||||
|
|
||||||
|
|
||||||
(defn apply-rule
|
(defn apply-rule
|
||||||
"Apply a single rule to a cell. What this is about is that I want to be able,
|
"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
|
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."
|
on those two possibilities. `world` is also passed in in order to be able
|
||||||
([cell world rule]
|
to access neighbours."
|
||||||
|
([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))))
|
||||||
|
@ -43,40 +45,33 @@
|
||||||
true result))))
|
true result))))
|
||||||
|
|
||||||
(defn- apply-rules
|
(defn- apply-rules
|
||||||
"Derive a cell from this cell of this world by applying these rules."
|
"Derive a cell from this `cell` of this `world` by applying these `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))))))
|
true (apply-rules world cell (rest rules))))))
|
||||||
|
|
||||||
(defn- transform-cell
|
(defn- transform-cell
|
||||||
"Derive a cell from this cell of this world by applying these rules. If an
|
"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 state to error"
|
exception is thrown, cache its message on the cell and set it's state to error"
|
||||||
[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))}))))
|
(:state cell))
|
||||||
|
:state :error}))))
|
||||||
(defn- transform-world-row
|
|
||||||
"Return a row derived from this row of this world by applying these rules to each cell."
|
|
||||||
[row world rules]
|
|
||||||
(apply vector (map #(transform-cell % world rules) row)))
|
|
||||||
|
|
||||||
(defn transform-world
|
(defn transform-world
|
||||||
"Return a world derived from this world by applying these rules to each cell."
|
"Return a world derived from this `world` by applying these `rules` to each cell."
|
||||||
[world rules]
|
[world rules]
|
||||||
(apply vector
|
(map-world world transform-cell (list rules)))
|
||||||
(map
|
|
||||||
#(transform-world-row % world rules)
|
|
||||||
world)))
|
|
||||||
|
|
||||||
(defn- transform-world-state
|
(defn- transform-world-state
|
||||||
"Consider this single argument as a map of `:world` and `:rules`; apply the rules
|
"Consider this single argument as a map of `:world` and `:rules`; apply the rules
|
||||||
|
@ -87,7 +82,6 @@
|
||||||
(world/print-world world)
|
(world/print-world world)
|
||||||
{:world world :rules (:rules state)}))
|
{:world world :rules (:rules state)}))
|
||||||
|
|
||||||
|
|
||||||
(defn run-world
|
(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.
|
||||||
|
|
||||||
|
|
|
@ -27,11 +27,14 @@
|
||||||
(defn tag-gradient
|
(defn tag-gradient
|
||||||
"Set the `gradient` property of this `cell` of this `world` to the difference in
|
"Set the `gradient` property of this `cell` of this `world` to the difference in
|
||||||
altitude between its highest and lowest neghbours."
|
altitude between its highest and lowest neghbours."
|
||||||
[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)})))
|
lowest (cond (empty? heights) 0 ;; shouldn't
|
||||||
|
true (apply min heights))
|
||||||
|
gradient (- highest lowest)]
|
||||||
|
(merge cell {:gradient gradient})))
|
||||||
|
|
||||||
(defn tag-gradients
|
(defn tag-gradients
|
||||||
"Set the `gradient` property of each cell in this `world` to the difference in
|
"Set the `gradient` property of each cell in this `world` to the difference in
|
||||||
|
@ -61,18 +64,6 @@
|
||||||
(get-int cell :x)
|
(get-int cell :x)
|
||||||
(get-int cell :y)) 256))))})))
|
(get-int cell :y)) 256))))})))
|
||||||
|
|
||||||
(defn- apply-heightmap-row
|
|
||||||
"Set the altitude of each cell in this sequence from the corresponding pixel
|
|
||||||
of this heightmap.
|
|
||||||
If the heightmap you supply is smaller than the world, this will break.
|
|
||||||
|
|
||||||
* `row` a row in a world, as discussed in world.clj, q.v. Alternatively, a
|
|
||||||
sequence of maps;
|
|
||||||
* `heightmap` an (ideally) greyscale image, whose x and y dimensions should
|
|
||||||
exceed those of the world of which the `cell` forms part."
|
|
||||||
[row heightmap]
|
|
||||||
(apply vector (map #(transform-altitude % heightmap) row)))
|
|
||||||
|
|
||||||
(defn apply-heightmap
|
(defn apply-heightmap
|
||||||
"Apply the image file loaded from this path to this world, and return a world whose
|
"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
|
||||||
|
|
|
@ -19,7 +19,7 @@
|
||||||
|
|
||||||
(defn map-world
|
(defn map-world
|
||||||
"Apply this `function` to each cell in this `world` to produce a new world.
|
"Apply this `function` to each cell in this `world` 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
|
||||||
`additional-args` supplied"
|
`additional-args` supplied"
|
||||||
([world function]
|
([world function]
|
||||||
(map-world world function nil))
|
(map-world world function nil))
|
||||||
|
|
|
@ -10,15 +10,15 @@
|
||||||
(= (:state cell) :new)
|
(= (:state cell) :new)
|
||||||
(merge cell {:state :grassland}))))
|
(merge cell {:state :grassland}))))
|
||||||
pair (list afn "Test source")]
|
pair (list afn "Test source")]
|
||||||
(is (nil? (apply-rule {:state :water} nil afn))
|
(is (nil? (apply-rule nil {:state :water} afn))
|
||||||
"Rule shouldn't fire when state is wrong")
|
"Rule shouldn't fire when state is wrong")
|
||||||
(is (nil? (apply-rule {:state :water} nil pair))
|
(is (nil? (apply-rule nil {:state :water} pair))
|
||||||
"Rule shouldn't fire when state is wrong")
|
"Rule shouldn't fire when state is wrong")
|
||||||
(is (= (:state (apply-rule {:state :new} nil afn)) :grassland)
|
(is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
|
||||||
"Rule should fire when state is correct")
|
"Rule should fire when state is correct")
|
||||||
(is (= (:state (apply-rule {:state :new} nil pair)) :grassland)
|
(is (= (:state (apply-rule nil {:state :new} pair)) :grassland)
|
||||||
"Rule should fire when state is correct")
|
"Rule should fire when state is correct")
|
||||||
(is (nil? (:rule (apply-rule {:state :new} nil afn)))
|
(is (nil? (:rule (apply-rule nil {:state :new} afn)))
|
||||||
"No rule text if not provided")
|
"No rule text if not provided")
|
||||||
(is (= (:rule (apply-rule {:state :new} nil pair)) "Test source")
|
(is (= (:rule (apply-rule nil {:state :new} pair)) "Test source")
|
||||||
"Rule text cached on cell if provided"))))
|
"Rule text cached on cell if provided"))))
|
|
@ -144,3 +144,18 @@
|
||||||
"General sanity test")
|
"General sanity test")
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
(deftest map-world-test
|
||||||
|
(testing "map-world utility function"
|
||||||
|
(let [w1a (make-world 3 3)
|
||||||
|
w2b (map-world w1a #(merge %2 {:test true}))
|
||||||
|
w3c (map-world w2b #(merge %2 {:number (+ %3 %4)}) '(4 4))]
|
||||||
|
(is (= (count w1a) (count w3c)) "No change in world size")
|
||||||
|
(is (= (count (flatten w1a)) (count (flatten w3c)))
|
||||||
|
"No change in world size")
|
||||||
|
(is (empty? (remove true? (map #(:test %) (flatten w3c))))
|
||||||
|
"All cells should have property 'test' set to true")
|
||||||
|
(is (empty? (remove #(= % 8) (map #(:number %) (flatten w3c))))
|
||||||
|
"All cells should have property 'number' set to 8"))))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue