Considerable refactoring based on the new map-world utility function.

This commit is contained in:
Simon Brooke 2014-07-25 11:49:50 +01:00
parent 4949e30f69
commit 75475ece29
5 changed files with 51 additions and 51 deletions

View file

@ -1,8 +1,9 @@
;; Functions to transform a world and run rules.
(ns mw-engine.core
(:use mw-engine.utils)
(: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
;; fires, it returns a new cell, which should have the same values for :x and
@ -27,12 +28,13 @@
(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
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."
([cell world rule]
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 cell world rule nil)
(seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
@ -43,40 +45,33 @@
true result))))
(defn- apply-rules
"Derive a cell from this cell of this world by applying these rules."
[cell world 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 cell world (first rules))]
true (let [result (apply-rule world cell (first rules))]
(cond result result
true (apply-rules cell world (rest rules))))))
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 state to error"
[cell world rules]
"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 cell world rules)
(apply-rules world cell rules)
{:generation (+ (or (:generation cell) 0) 1)})
(catch Exception e
(merge cell {:error
(format "%s at generation %d when in state %s"
(.getMessage e)
(:generation cell)
(:state cell))}))))
(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)))
(:state cell))
:state :error}))))
(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]
(apply vector
(map
#(transform-world-row % world rules)
world)))
(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
@ -87,7 +82,6 @@
(world/print-world world)
{:world world :rules (:rules state)}))
(defn run-world
"Run this world with these rules for this number of generations.

View file

@ -27,11 +27,14 @@
(defn tag-gradient
"Set the `gradient` property of this `cell` of this `world` to the difference in
altitude between its highest and lowest neghbours."
[cell world]
(let [heights (map '(:altitude %) (get-neighbours world cell))
highest (apply max heights)
lowest (apply min heights)]
#(merge cell {:gradient (- highest lowest)})))
[world cell]
(let [heights (remove nil? (map #(:altitude %) (get-neighbours world cell)))
highest (cond (empty? heights) 0 ;; shouldn't happen
true (apply max heights))
lowest (cond (empty? heights) 0 ;; shouldn't
true (apply min heights))
gradient (- highest lowest)]
(merge cell {:gradient gradient})))
(defn tag-gradients
"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 :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
"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

View file

@ -19,7 +19,7 @@
(defn map-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"
([world function]
(map-world world function nil))

View file

@ -10,15 +10,15 @@
(= (:state cell) :new)
(merge cell {:state :grassland}))))
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")
(is (nil? (apply-rule {:state :water} nil pair))
(is (nil? (apply-rule nil {:state :water} pair))
"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")
(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")
(is (nil? (:rule (apply-rule {:state :new} nil afn)))
(is (nil? (:rule (apply-rule nil {:state :new} afn)))
"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"))))

View file

@ -144,3 +144,18 @@
"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"))))