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
lein ring uberwar
sudo cp target/microworld.war /var/lib/tomcat7/webapps
echo "Deployed new WAR file to local Tomcat"
fi
popd
done

View file

@ -24,23 +24,41 @@
[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
"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.
* `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;
* `heightmap` an (ideally) greyscale image, whose x and y dimensions should
exceed those of the world of which the `cell` forms part."
[cell heightmap]
(merge cell
{:altitude
(+ (get-int cell :altitude)
(- 256
(abs
(mod
(.getRGB heightmap
(get-int cell :x)
(get-int cell :y)) 256))))}))
([world cell heightmap]
(transform-altitude cell heightmap))
([cell heightmap]
(merge cell
{:altitude
(+ (get-int cell :altitude)
(- 256
(abs
(mod
(.getRGB heightmap
(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
@ -65,8 +83,12 @@
([world imagepath]
;; bizarrely, the collage load-util is working for me, but the imagez version isn't.
(let [heightmap (filter-image (grayscale)(load-image imagepath))]
(apply vector (map #(apply-heightmap-row % heightmap) world))))
([imagepath]
(map-world
(map-world world transform-altitude (list heigtmap))
tag-gradient)))
([imagepath]
(let [heightmap (filter-image (grayscale)(load-image imagepath))
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]
(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
"Return the cell a x, y in this world, if any.