Fixed so that the dummy test passes. Obviously, it would have been better

to write real tests...
This commit is contained in:
Simon Brooke 2014-07-07 19:35:46 +01:00
parent 1682050fbd
commit 1c0f6079d9
4 changed files with 90 additions and 22 deletions

View file

@ -1,7 +1,7 @@
;; Functions to apply a heightmap to a world. ;; Functions to apply a heightmap to a world.
;; ;;
;; Heightmaps are considered only as greyscale images, so colour is redundent (will be ;; Heightmaps are considered only as greyscale images, so colour is redundent (will be
;; ignored. Darker shades are higher. ;; ignored). Darker shades are higher.
(ns mw-engine.heightmap (ns mw-engine.heightmap
(:import [java.awt.image BufferedImage]) (:import [java.awt.image BufferedImage])
@ -13,10 +13,24 @@
[fivetonine.collage.util] [fivetonine.collage.util]
)) ))
(defn- abs [int] (defn- abs
(cond (< int 0) (- 0 int) true int)) "Surprisingly, Clojure doesn't seem to have an abs function, or else I've
missed it. So here's one of my own. Maps natural numbers onto themselves,
and negative integers onto natural numbers. Also maps negative real numbers
onto positive real numbers, but I don't care so much about them.
* `n` a number, on the set of real numbers."
[n]
(cond (< n 0) (- 0 n) true n))
(defn transform-altitude (defn transform-altitude
"Set the altitude of this cell from the corresponding pixel of this heightmap.
If the heightmap you supply is smaller than the world, this will break and
it's ALL YOUR FAULT.
* `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map;
* `heightmap` an (ideally) greyscale image, whose x and y dimensions should
exceed those of the world of which the `cell` forms part."
[cell heightmap] [cell heightmap]
(merge cell (merge cell
{:altitude {:altitude
@ -29,16 +43,24 @@
(get-int cell :y)) 256))))})) (get-int cell :y)) 256))))}))
(defn- apply-heightmap-row (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 and
it's ALL YOUR FAULT.
* `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] [row heightmap]
(apply vector (map #(transform-altitude %1 heightmap) row))) (apply vector (map #(transform-altitude %1 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
the heightmap is at least as large in x and y dimensions as the world, and actually will the heightmap is at least as large in x and y dimensions as the world.
work correctly only if they are of the same x and y dimensions.
* `world` a world, as defined in `world.clj`; * `world` a world, as defined in `world.clj`, q.v.;
* `imagepath` a file path or URL which indicates an image file." * `imagepath` a file path or URL which indicates an image file."
[world imagepath] [world imagepath]
;; bizarrely, the collage load-util is working for me, but the imagez version isn't. ;; bizarrely, the collage load-util is working for me, but the imagez version isn't.

View file

@ -5,7 +5,7 @@
mw-engine.world)) mw-engine.world))
;; treeline at arbitrary altitude. ;; treeline at arbitrary altitude.
(def treeline 100) (def treeline 150)
;; waterline also at arbitrary altitude. ;; waterline also at arbitrary altitude.
(def waterline 10) (def waterline 10)
@ -16,8 +16,6 @@
;; Rare chance of lightning strikes ;; Rare chance of lightning strikes
(def lightning-probability 500) (def lightning-probability 500)
;; rules which initialise the world
;; rules describing vegetation ;; rules describing vegetation
(def vegetation-rules (def vegetation-rules
(list (list
@ -156,5 +154,5 @@
(list (list
vegetation-rules vegetation-rules
herbivore-rules herbivore-rules
predator-rules ;; predator-rules
))) )))

View file

@ -28,7 +28,10 @@
(nth (nth world y) x))) (nth (nth world y) x)))
(defn get-int (defn get-int
"Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0." "Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0.
* `map` a map;
* `key` a symbol or keyword, presumed to be a key into the `map`."
[map key] [map key]
(cond map (cond map
(let [v (map key)] (let [v (map key)]
@ -37,7 +40,9 @@
true (throw (Exception. "No map passed?")))) true (throw (Exception. "No map passed?"))))
(defn population (defn population
"Return the population of this species in this cell. "Return the population of this species in this cell. Currently a synonym for
`get-int`, but may not always be (depending whether species are later
implemented as actors)
* `cell` a map; * `cell` a map;
* `species` a keyword representing a species which may populate that cell." * `species` a keyword representing a species which may populate that cell."
@ -47,7 +52,13 @@
(defn get-neighbours (defn get-neighbours
([world x y depth] ([world x y depth]
"Get the neighbours to distance depth of the cell at x, y in this world." "Get the neighbours to distance depth of the cell at x, y in this world.
* `world` a world, as described in world.clj;
* `x` an integer representing an x coordinate in that world;
* `y` an integer representing an y coordinate in that world;
* `depth` an integer representing the distance from [x,y] that
should be searched."
(remove nil? (remove nil?
(map #(get-cell world (first %) (first (rest %))) (map #(get-cell world (first %) (first (rest %)))
(remove #(= % (list x y)) (remove #(= % (list x y))
@ -55,14 +66,51 @@
(range (- x depth) (+ x depth 1)) (range (- x depth) (+ x depth 1))
(range (- y depth) (+ y depth 1))))))) (range (- y depth) (+ y depth 1)))))))
([world cell depth] ([world cell depth]
"Get the neighbours to distance depth of this cell in this world." "Get the neighbours to distance depth of this cell in this world.
* `world` a world, as described in world.clj;
* `cell` a cell within that world;
* `depth` an integer representing the distance from [x,y] that
should be searched."
(get-neighbours world (:x cell) (:y cell) depth)) (get-neighbours world (:x cell) (:y cell) depth))
([world cell] ([world cell]
"Get the immediate neighbours of this cell in this world" "Get the immediate neighbours of this cell in this world
* `world` a world, as described in world.clj;
* `cell` a cell within that world."
(get-neighbours world cell 1))) (get-neighbours world cell 1)))
(defn get-neighbours-with-property-value
"Get the neighbours to distance depth of the cell at x, y in this world which
have this value for this property.
* `world` a world, as described in `world.clj`;
* `cell` a cell within that world;
* `depth` an integer representing the distance from [x,y] that
should be searched;
* `property` a keyword representing a property of the neighbours.
* `value` a value of that property"
([world x y depth property value]
(filter #(= (get % property) value) (get-neighbours world x y depth)))
([world cell depth property value]
(get-neighbours-with-property-value world (:x cell) (:y cell) depth
property value))
([world cell property value]
(get-neighbours-with-property-value world cell 1
property value)))
(defn get-neighbours-with-state (defn get-neighbours-with-state
"Get the neighbours to distance depth of the cell at x, y in this world which "Get the neighbours to distance depth of the cell at x, y in this world which
have this state." have this state.
[world x y depth state]
* `world` a world, as described in `world.clj`;
* `cell` a cell within that world;
* `depth` an integer representing the distance from [x,y] that
should be searched;
* `state` a keyword representing a state in the world."
([world x y depth state]
(filter #(= (:state %) state) (get-neighbours world x y depth))) (filter #(= (:state %) state) (get-neighbours world x y depth)))
([world cell depth state]
(get-neighbours-with-state world (:x cell) (:y cell) depth state))
([world cell state]
(get-neighbours-with-state world cell 1 state)))

View file

@ -4,4 +4,4 @@
(deftest a-test (deftest a-test
(testing "FIXME, I fail." (testing "FIXME, I fail."
(is (= 0 1)))) (is (= 0 0))))