Merge branch 'master' of ssh://goldsmith.journeyman.cc/srv/git/mw-engine

src/mw_engine/drainage.clj

@@ -7,6 +7,9 @@
 
 (def ^:dynamic *sealevel* 10)
 
+;; forward declaration of flow, to allow for a wee bit of mutual recursion.
+(declare flow)
+
 (defn rain-world
   "Simulate rainfall on this `world`. TODO: Doesn't really work just now - should
    rain more on west-facing slopes, and less to the east of high ground"
@@ -26,24 +29,36 @@
                                                                   :altitude
                                                                   (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)}))))
+
 (def flow
   "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
-   to this one but having a value of its flow property set from that computation. The function is
-   memoised because the consequence of mapping a recursive function across an array is that many
-   cells will be revisited - potentially many times.
+  to this one but having a value of its flow property set from that computation. The function is
+  memoised because the consequence of mapping a recursive function across an array is that many
+  cells will be revisited - potentially many times.
 
-   Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
-   (memoize
-     (fn [world cell]
-       (cond
-         (not (nil? (:flow cell))) cell
-         (<= (or (:altitude cell) 0) *sealevel*) cell
-         true
-         (merge cell
-                {:flow (+ (:rainfall cell)
-                          (apply +
-                                 (map (fn [neighbour] (:flow (flow world neighbour)))
-                                      (flow-contributors world cell))))})))))
+  Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
+  (memoize
+   (fn [world cell]
+     (cond
+      (not (nil? (:flow cell))) cell
+      (<= (or (:altitude cell) 0) *sealevel*) cell
+      true
+      (let [contributors (flow-contributors world cell)]
+        (if
+          (= (count contributors) 8)
+          ;; local lowspot - lake bottom
+          (flood-hollow cell world contributors)
+          ;; otherwise...
+          (merge cell
+                 {:flow (+ (:rainfall cell)
+                           (apply +
+                                  (map (fn [neighbour] (:flow (flow world neighbour)))
+                                       (flow-contributors world cell))))})))))))
 
 (defn flow-world
   "Return a world like this `world`, but with cells tagged with the amount of

src/mw_engine/heightmap.clj

@@ -13,7 +13,7 @@
             [mikera.image.filters :as filters]))
 
 
-(defn- tag-property
+(defn tag-property
   "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`.
    If the heightmap you supply is smaller than the world, this will break.
 
@@ -36,7 +36,7 @@
                         (get-int cell :x)
                         (get-int cell :y)) 256))))})))
 
-(defn- tag-gradient
+(defn tag-gradient
   "Set the `gradient` property of this `cell` of this `world` to the difference in
    altitude between its highest and lowest neghbours."
   [world cell]
@@ -54,7 +54,7 @@
   [world]
   (map-world world tag-gradient))
 
-(defn- tag-altitude
+(defn tag-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.
 

src/mw_engine/utils.clj

@@ -29,12 +29,39 @@
   [world x y]
   (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
 
+(defn map-world-n-n
+  "Wholly non-parallel map world implementation"
+  ([world function]
+    (map-world-n-n world function nil))
+  ([world function additional-args]
+    (into []
+           (map (fn [row]
+                    (into [] (map
+                             #(apply function
+                                     (cons world (cons % additional-args)))
+                             row)))
+                  world))))
+
+(defn map-world-p-p
+  "Wholly parallel map world implementation"
+  ([world function]
+    (map-world-p-p world function nil))
+  ([world function additional-args]
+    (into []
+           (pmap (fn [row]
+                    (into [] (pmap
+                             #(apply function
+                                     (cons world (cons % additional-args)))
+                             row)))
+                  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 world, the cell, and any
    `additional-args` supplied. Note that we parallel map over rows but
    just map over cells within a row. That's because it isn't worth starting
-   a new thread for each cell, but there may be efficiency gains in 
+   a new thread for each cell, but there may be efficiency gains in
    running rows in parallel."
   ([world function]
     (map-world world function nil))