diff --git a/project.clj b/project.clj index f43e2d3..a2739ff 100644 --- a/project.clj +++ b/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"]]) diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index d7eaa7a..8b46248 100644 --- a/src/mw_engine/drainage.clj +++ b/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)))) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index a6d1f7d..403cad0 100644 --- a/src/mw_engine/heightmap.clj +++ b/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])) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index eb53da9..6abc166 100644 --- a/src/mw_engine/utils.clj +++ b/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)) diff --git a/test/mw_engine/utils_test.clj b/test/mw_engine/utils_test.clj index 977abbb..0077ceb 100644 --- a/test/mw_engine/utils_test.clj +++ b/test/mw_engine/utils_test.clj @@ -164,6 +164,18 @@ "All cells should have property 'test' set to true") (is (empty? (remove #(= % 8) (map #(:number %) (flatten w3c)))) "All cells should have property 'number' set to 8")))) - - - \ No newline at end of file + +(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")))) + + \ No newline at end of file