Added merge-cell, and tests for it. Still trying to solve the Falls of Clyde

problem

project.clj

@@ -16,5 +16,6 @@
                  [org.clojure/math.combinatorics "0.0.7"]
                  [org.clojure/tools.trace "0.7.8"]
                  [org.clojure/tools.namespace "0.2.4"]
+                 [hiccup "1.0.5"]
                  [net.mikera/imagez "0.3.1"]
                  [fivetonine/collage "0.2.0"]])

src/mw_engine/drainage.clj

@@ -3,7 +3,8 @@
 
 (ns mw-engine.drainage
   (:use mw-engine.utils
-        mw-engine.world))
+        mw-engine.world)
+  (:require [mw-engine.heightmap :as heightmap]))
 
 (def ^:dynamic *sealevel* 10)
 
@@ -18,22 +19,25 @@
 
 (defn flow-contributors
   "Return a list of the cells in this `world` which are higher than this
-  `cell` and for which this cell is the lowest neighbour"
+  `cell` and for which this cell is the lowest neighbour, or which are at the 
+   same altitude and have greater flow"
   [world cell]
   (remove nil?
           (into []
             (map
              (fn [n]
-               (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n))
+               (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n
+                 (and (= (:altitude cell) (:altitude n))(> (or (:flow n) 0) (or (:flow cell) 0))) n))
              (get-neighbours-with-property-value world (:x cell) (:y cell) 1
                                                                   :altitude
-                                                                  (or (:altitude cell) 0) >)))))
+                                                                  (or (:altitude cell) 0) >=)))))
 
 (defn flood-hollow
   "Raise the altitude of a copy of this `cell` of this `world` to one unit above the lowest of these `neighbours`, and reflow."
   [cell world neighbours]
   (let [lowest (get-least-cell neighbours :altitude)]
-    (flow (merge cell {:altitude (+ (:altitude lowest) 1)}))))
+    (flow world (merge cell {:altitude (+ (:altitude lowest) 1)}))))
+;;  cell)
 
 (def flow
   "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
@@ -49,19 +53,25 @@
       (<= (or (:altitude cell) 0) *sealevel*) cell
       true
       (let [contributors (flow-contributors world cell)]
-        (if
-          (= (count contributors) 8)
+;;        (if
+;;          (= (count contributors) 8)
           ;; local lowspot - lake bottom
-          (flood-hollow cell world contributors)
+;;          (flood-hollow cell world contributors)
           ;; otherwise...
           (merge cell
                  {:flow (+ (:rainfall cell)
                            (apply +
                                   (map (fn [neighbour] (:flow (flow world neighbour)))
-                                       (flow-contributors world cell))))})))))))
+                                       (flow-contributors world cell))))}))))))
 
 (defn flow-world
   "Return a world like this `world`, but with cells tagged with the amount of
    water flowing through them."
   [world]
   (map-world (rain-world world) flow))
+
+(defn run-drainage
+  [hmap]
+  "Create a world from the heightmap `hmap`, rain on it, and then compute river 
+   flows."
+  (flow-world (rain-world (heightmap/apply-heightmap hmap))))

src/mw_engine/heightmap.clj

@@ -6,8 +6,7 @@
 (ns mw-engine.heightmap
   (:import [java.awt.image BufferedImage])
   (:use mw-engine.utils
-        mw-engine.world
-        mw-engine.drainage)
+        mw-engine.world)
   (:require [fivetonine.collage.util :as collage :only [load-image]]
             [mikera.image.core :as imagez :only [filter-image get-pixels]]
             [mikera.image.filters :as filters]))

src/mw_engine/utils.clj

@@ -13,7 +13,7 @@
 
    * `n` a number, on the set of real numbers."
   [n]
-  (cond (neg? n) (- 0 n) true n))
+  (if (neg? n) (- 0 n) n))
 
 (defn member?
   "True if elt is a member of col."
@@ -225,4 +225,16 @@
                  row)))
         world))))
 
-
+(defn merge-cell
+  "Return a world like this `world`, but merge the values from this `cell` with
+   those from the cell in the world with the same co-ordinates"
+  [world cell]
+  (if (in-bounds world (:x cell) (:y cell))
+    (map-world world
+               #(if 
+                  (and
+                    (= (:x cell)(:x %2))
+                    (= (:y cell)(:y %2)))
+                  (merge %2 cell)
+                  %2))
+    world))

test/mw_engine/utils_test.clj

@@ -165,5 +165,17 @@
              (is (empty? (remove #(= % 8) (map #(:number %) (flatten w3c))))
                  "All cells should have property 'number' set to 8"))))
 
+(deftest merge-cell-test
+  (testing "merge-cell utility function"
+           (let [w1a (make-world 3 3)
+                 w2b (merge-cell w1a {:x 5 :y 5 :out-of-bounds true})
+                 w3c (merge-cell w1a {:x 2 :y 2 :test true})]
+             (is (= w1a w2b) "Out of bound cell makes no difference")
+             (is (empty? (filter #(:out-of-bounds %) (flatten w2b)))
+                 "No cell has :out-of-bounds set")
+             (is (= 1 (count (filter #(:test %) (flatten w3c))))
+                 "Exactly one cell has :test set")
+             (is (:test (get-cell w3c 2 2))
+                 "The cell with :test set is at 2, 2"))))