Added a function to add gradient properties to cells when applying a

heightmap, and, in doing so, added a potentially useful generalised function
for mapping onto two dimensional arrays. Needs testing!
This commit is contained in:
Simon Brooke 2014-07-25 09:49:44 +01:00
parent 8e38dc5f87
commit e48ad3f891
3 changed files with 49 additions and 13 deletions

View file

@ -116,6 +116,7 @@ do
then then
lein ring uberwar lein ring uberwar
sudo cp target/microworld.war /var/lib/tomcat7/webapps sudo cp target/microworld.war /var/lib/tomcat7/webapps
echo "Deployed new WAR file to local Tomcat"
fi fi
popd popd
done done

View file

@ -24,14 +24,32 @@
[n] [n]
(cond (< n 0) (- 0 n) true n)) (cond (< n 0) (- 0 n) true n))
(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)})))
(defn tag-gradients
"Set the `gradient` property of each cell in this `world` to the difference in
altitude between its highest and lowest neghbours."
(map-world world tag-gradient))
(defn transform-altitude (defn transform-altitude
"Set the altitude of this cell from the corresponding pixel of this heightmap. "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. If the heightmap you supply is smaller than the world, this will break.
* `world` not actually used, but present to enable this function to be
passed as an argument to `mw-engine.utils/map-world`, q.v.
* `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map;
* `heightmap` an (ideally) greyscale image, whose x and y dimensions should * `heightmap` an (ideally) greyscale image, whose x and y dimensions should
exceed those of the world of which the `cell` forms part." exceed those of the world of which the `cell` forms part."
[cell heightmap] ([world cell heightmap]
(transform-altitude cell heightmap))
([cell heightmap]
(merge cell (merge cell
{:altitude {:altitude
(+ (get-int cell :altitude) (+ (get-int cell :altitude)
@ -40,7 +58,7 @@
(mod (mod
(.getRGB heightmap (.getRGB heightmap
(get-int cell :x) (get-int cell :x)
(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 "Set the altitude of each cell in this sequence from the corresponding pixel
@ -65,8 +83,12 @@
([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.
(let [heightmap (filter-image (grayscale)(load-image imagepath))] (let [heightmap (filter-image (grayscale)(load-image imagepath))]
(apply vector (map #(apply-heightmap-row % heightmap) world)))) (map-world
(map-world world transform-altitude (list heigtmap))
tag-gradient)))
([imagepath] ([imagepath]
(let [heightmap (filter-image (grayscale)(load-image imagepath)) (let [heightmap (filter-image (grayscale)(load-image imagepath))
world (make-world (.getWidth heightmap) (.getHeight heightmap))] world (make-world (.getWidth heightmap) (.getHeight heightmap))]
(apply vector (map #(apply-heightmap-row % heightmap) world))))) (map-world
(map-world world transform-altitude (list heigtmap))
tag-gradient))))

View file

@ -17,6 +17,19 @@
[world x y] [world x y]
(and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
(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
`additional-args` supplied"
([world function]
(map-world world function nil))
([world function additional-args]
(apply vector ;; vectors are more efficient for scanning, which we do a lot.
(for [row world]
(apply vector
(map #(apply function (cons world (cons % additional-args)))
row))))))
(defn get-cell (defn get-cell
"Return the cell a x, y in this world, if any. "Return the cell a x, y in this world, if any.