diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 8a0ca95..4d946a6 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -23,12 +23,12 @@ ;; that every cell's :x and :y properties reflect its place in the matrix. ;; See `world.clj`. ;; -;; Each time the world is transformed (see `transform-world`, for each cell, +;; Each time the world is transformed (see `transform-world`, for each cell, ;; rules are applied in turn until one matches. Once one rule has matched no ;; further rules can be applied. -(defn apply-rule +(defn apply-rule "Apply a single `rule` to a `cell`. What this is about is that I want to be able, for debugging purposes, to tag a cell with the rule text of the rule which fired (and especially so when an exception is thrown. So a rule may be either @@ -41,7 +41,7 @@ (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src)))) ([cell world rule source] (let [result (apply rule (list cell world))] - (cond + (cond (and result source) (merge result {:rule source}) true result)))) @@ -58,11 +58,11 @@ exception is thrown, cache its message on the cell and set it's state to error" [world cell rules] (try - (merge - (apply-rules world cell rules) + (merge + (apply-rules world cell rules) {:generation (+ (or (:generation cell) 0) 1)}) - (catch Exception e - (merge cell {:error + (catch Exception e + (merge cell {:error (format "%s at generation %d when in state %s" (.getMessage e) (:generation cell) @@ -93,28 +93,10 @@ * `generations` an (integer) number of generations. Return the final generation of the world." - [world init-rules rules generations] - (let [state {:world (transform-world world init-rules) :rules rules}] - (:world - (last - (doall - (take generations - (iterate transform-world-state state))))))) - -(defn run-world2 - "Doesn't work yet" [world init-rules rules generations] - (with-local-vars [r (ref (transform-world world init-rules))] - (dotimes [g generations] - (dosync - (ref-set r (transform-world (deref r) rules)))) - (deref r))) - -(defn run-world3 - [world init-rules rules generations] - (reduce (fn [world _iteration] + (reduce (fn [world _iteration] (transform-world world rules)) (transform-world world init-rules) (range generations))) - - + + diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index c9d5874..e50f6ad 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -2,9 +2,13 @@ ;; assumed to have altitudes already set from a heighmap. (ns mw-engine.drainage + (:require + [clojure.core.reducers :as r]) (:use mw-engine.utils mw-engine.world)) +(def ^:dynamic *sealevel* 10) + (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" @@ -16,12 +20,13 @@ `cell` and for which this cell is the lowest neighbour" [world cell] (remove nil? - (map - (fn [n] - (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n)) - (get-neighbours-with-property-value world (:x cell) (:y cell) 1 + (into [] + (r/map + (fn [n] + (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n)) + (get-neighbours-with-property-value world (:x cell) (:y cell) 1 :altitude - (or (:altitude cell) 0) >)))) + (or (:altitude cell) 0) >))))) (defn flow "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical @@ -29,11 +34,14 @@ Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher." [world cell] + (cond + (> (or (:altitude cell) 0) *sealevel*) (merge cell {:flow (+ (:rainfall cell) (apply + (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))})) + (flow-contributors world cell))))}) + true cell)) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 8c6fee5..3cdf94b 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,7 +1,7 @@ ;; Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule. (ns mw-engine.utils - (:require + (:require [clojure.core.reducers :as r] [clojure.math.combinatorics :as combo])) @@ -36,10 +36,10 @@ ([world function] (map-world world function nil)) ([world function additional-args] - (into [] ;; vectors are more efficient for scanning, which we do a lot. + (into [] (r/map (fn [row] - (into [] (r/map - #(apply function + (into [] (r/map + #(apply function (cons world (cons % additional-args))) row))) world))))