diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 1d04a7a..d7eaa7a 100644 --- a/src/mw_engine/drainage.clj +++ b/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 diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index bfcf6af..a6d1f7d 100644 --- a/src/mw_engine/heightmap.clj +++ b/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. diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index f1d308d..eb53da9 100644 --- a/src/mw_engine/utils.clj +++ b/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))