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:
parent
8e38dc5f87
commit
e48ad3f891
|
@ -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
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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.
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue