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.
|
||||
|
||||
(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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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"))))
|
|
@ -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"))))
|
||||
|
||||
|
||||
|
Loading…
Reference in a new issue