Fixed so that the dummy test passes. Obviously, it would have been better
to write real tests...
This commit is contained in:
parent
1682050fbd
commit
1c0f6079d9
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
)))
|
)))
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -4,4 +4,4 @@
|
||||||
|
|
||||||
(deftest a-test
|
(deftest a-test
|
||||||
(testing "FIXME, I fail."
|
(testing "FIXME, I fail."
|
||||||
(is (= 0 1))))
|
(is (= 0 0))))
|
||||||
|
|
Loading…
Reference in a new issue