From e48ad3f891a5208b3975581ed4d3ae6636025f0e Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Fri, 25 Jul 2014 09:49:44 +0100
Subject: [PATCH] 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!

---
 buildall.sh                 |  1 +
 src/mw_engine/heightmap.clj | 48 +++++++++++++++++++++++++++----------
 src/mw_engine/utils.clj     | 13 ++++++++++
 3 files changed, 49 insertions(+), 13 deletions(-)

diff --git a/buildall.sh b/buildall.sh
index 64fe544..4db243e 100755
--- a/buildall.sh
+++ b/buildall.sh
@@ -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
diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj
index 5efed35..e60f1c4 100644
--- a/src/mw_engine/heightmap.clj
+++ b/src/mw_engine/heightmap.clj
@@ -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)))))
\ No newline at end of file
+      (map-world
+        (map-world world transform-altitude (list heigtmap))
+        tag-gradient))))
diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj
index a56574b..f6fa7ca 100644
--- a/src/mw_engine/utils.clj
+++ b/src/mw_engine/utils.clj
@@ -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.