From 21cdff764fb8f2db36d08d3265714a80458cd3d0 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 13 Aug 2016 17:39:07 +0100 Subject: [PATCH 1/9] Added namespace documentation conforming to better practice; added GPL declaration; changed 'use' to 'require' passim. All tests pass but that's not proof we're all good yet. --- src/mw_engine/core.clj | 43 +++++++++++++++---- src/mw_engine/display.clj | 34 +++++++++++++-- src/mw_engine/drainage.clj | 74 +++++++++++++++++++++++---------- src/mw_engine/heightmap.clj | 44 ++++++++++++++++---- src/mw_engine/natural_rules.clj | 51 +++++++++++++++++------ src/mw_engine/utils.clj | 46 ++++++++++++++++---- src/mw_engine/version.clj | 10 +++-- src/mw_engine/world.clj | 36 ++++++++++++++-- 8 files changed, 267 insertions(+), 71 deletions(-) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 9b95b55..d471e08 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -1,11 +1,30 @@ -;; Functions to transform a world and run rules. - -(ns mw-engine.core - (:use mw-engine.utils) +(ns ^{:doc "Functions to transform a world and run rules." + :author "Simon Brooke"} + mw-engine.core (:require [clojure.core.reducers :as r] - [mw-engine.world :as world]) + [mw-engine.world :as world] + [mw-engine.utils :refer [get-int-or-zero map-world]]) (:gen-class)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; Every rule is a function of two arguments, a cell and a world. If the rule ;; fires, it returns a new cell, which should have the same values for :x and ;; :y as the old cell. Anything else can be modified. @@ -26,7 +45,8 @@ ;; 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 "Apply a single `rule` to a `cell`. What this is about is that I want to be able, @@ -37,14 +57,15 @@ to access neighbours." ([world cell rule] (cond - (ifn? rule) (apply-rule cell world rule nil) - (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src)))) - ([cell world rule source] + (ifn? rule) (apply-rule world cell rule nil) + (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src)))) + ([world cell rule source] (let [result (apply rule (list cell world))] (cond (and result source) (merge result {:rule source}) true result)))) + (defn- apply-rules "Derive a cell from this `cell` of this `world` by applying these `rules`." [world cell rules] @@ -53,6 +74,7 @@ (cond result result true (apply-rules world cell (rest rules)))))) + (defn- transform-cell "Derive a cell from this `cell` of this `world` by applying these `rules`. If an exception is thrown, cache its message on the cell and set it's state to error" @@ -67,13 +89,16 @@ (.getMessage e) (:generation cell) (:state cell)) + :stacktrace (map #(.toString %) (.getStackTrace e)) :state :error})))) + (defn transform-world "Return a world derived from this `world` by applying these `rules` to each cell." [world rules] (map-world world transform-cell (list rules))) + (defn- transform-world-state "Consider this single argument as a map of `:world` and `:rules`; apply the rules to transform the world, and return a map of the new, transformed `:world` and diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj index 0ad65e6..9c1f1c6 100644 --- a/src/mw_engine/display.clj +++ b/src/mw_engine/display.clj @@ -1,22 +1,46 @@ -(ns mw-engine.display - (:use mw-engine.utils - mw-engine.world) - (:require [hiccup.core :refer [html]])) +(ns ^{:doc "Simple functions to allow a world to be visualised." + :author "Simon Brooke"} + mw-engine.display + (:require [hiccup.core :refer [html]] + mw-engine.utils + mw-engine.world)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn format-css-class [state] "Format this `state`, assumed to be a keyword indicating a state in the world, into a CSS class" (subs (str state) 1)) + (defn format-image-path "Render this `state`, assumed to be a keyword indicating a state in the world, into a path which should recover the corresponding image file." [state] (format "img/tiles/%s.png" (format-css-class state))) + (defn format-mouseover [cell] (str cell)) + (defn render-cell "Render this world cell as a Hiccup table cell." [cell] @@ -25,11 +49,13 @@ [:a {:href (format "inspect?x=%d&y=%d" (:x cell) (:y cell))} [:img {:alt (:state cell) :width 32 :height 32 :src (format-image-path state)}]]])) + (defn render-world-row "Render this world `row` as a Hiccup table row." [row] (apply vector (cons :tr (map render-cell row)))) + (defn render-world-table "Render this `world` as a Hiccup table." [world] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 925b1a0..4e844c4 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -1,11 +1,33 @@ -;; Experimental, probably of no interest to anyone else; attempt to compute drainage on a world, -;; assumed to have altitudes already set from a heighmap. +(ns ^{:doc "Experimental, probably of no interest to anyone else; attempt to + compute drainage on a world, assumed to have altitudes already set + from a heightmap." + :author "Simon Brooke"} + mw-engine.drainage + (:require [mw-engine.core :refer [run-world]] + [mw-engine.heightmap :as heightmap] + [mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours + get-neighbours-with-property-value + map-world]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ns mw-engine.drainage - (:use mw-engine.utils - mw-engine.world - mw-engine.core) - (:require [mw-engine.heightmap :as heightmap])) (def ^:dynamic *sealevel* 10) @@ -18,37 +40,40 @@ [world] (map-world world (fn [world cell] (merge cell {:rainfall 1})))) + (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, or which are at the + `cell` and for which this cell is the lowest neighbour, or which are at the same altitude and have greater flow" [cell world] (filter #(map? %) (map (fn [n] - (cond + (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 + (get-neighbours-with-property-value world (:x cell) (:y cell) 1 :altitude (or (:altitude cell) 0) >=)))) + (defn is-hollow - "Detects point hollows - that is, individual cells all of whose neighbours - are higher. Return true if this `cell` has an altitude lower than any of - its neighbours in this `world`" + "Detects point hollows - that is, individual cells all of whose neighbours + are higher. Return true if this `cell` has an altitude lower than any of + its neighbours in this `world`" [world cell] ;; quicker to count the elements of the list and compare equality of numbers ;; than recursive equality check on members, I think. But worth benchmarking. (let [neighbours (get-neighbours world cell) altitude (get-int-or-zero cell :altitude)] (= (count neighbours) - (count (get-neighbours-with-property-value + (count (get-neighbours-with-property-value world (:x cell) (:y cell) 1 :altitude altitude >))))) + (defn flood-hollow - "Raise the altitude of a copy of this `cell` of this `world` to the altitude + "Raise the altitude of a copy of this `cell` of this `world` to the altitude of the lowest of its `neighbours`." ([world cell neighbours] (let [lowest (get-least-cell neighbours :altitude)] @@ -56,30 +81,33 @@ ([world cell] (flood-hollow world cell (get-neighbours world cell)))) -(defn flood-hollows + +(defn flood-hollows "Flood all local hollows in this `world`. At this stage only floods single cell hollows." [world] - (map-world world + (map-world world #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2))) + (def max-altitude 255) (defn flow-nr - "Experimental non recursive flow algorithm, needs to be run on a world as + "Experimental non recursive flow algorithm, needs to be run on a world as many times as there are distinct altitude values. This algorithm works only if applied sequentially from the highest altitude to the lowest, see `flow-world-nr`." [cell world] (if (= (- max-altitude (get-int-or-zero cell :generation)) (get-int-or-zero cell :altitude)) - (merge cell - {:flow (reduce + - (map + (merge cell + {:flow (reduce + + (map #(+ (get-int-or-zero % :rainfall) (get-int-or-zero % :flow)) (flow-contributors cell world)))}))) + (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 @@ -99,6 +127,7 @@ (map (fn [neighbour] (:flow (flow neighbour world))) (flow-contributors cell world))))}))))) + (defn flow-world-nr "Experimental non-recursive flow-world algorithm" [world] @@ -110,8 +139,9 @@ [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 + "Create a world from the heightmap `hmap`, rain on it, and then compute river flows." (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap))))) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index 403cad0..d6009cb 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/mw_engine/heightmap.clj @@ -1,15 +1,36 @@ -;; Functions to apply a heightmap to a world. +(ns ^{:doc "Functions to apply a heightmap to a world." + :author "Simon Brooke"} + mw-engine.heightmap + (:import [java.awt.image BufferedImage]) + (:require [fivetonine.collage.util :as collage :only [load-image]] + [mikera.image.core :as imagez :only [filter-image get-pixels]] + [mikera.image.filters :as filters] + [mw-engine.utils :refer [abs get-int get-neighbours map-world]] + [mw-engine.world :refer [make-world]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Heightmaps are considered only as greyscale images, so colour is redundent (will be ;; ignored). Darker shades are higher. - -(ns mw-engine.heightmap - (:import [java.awt.image BufferedImage]) - (:use mw-engine.utils - 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])) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn tag-property @@ -35,6 +56,7 @@ (get-int cell :x) (get-int cell :y)) 256))))}))) + (defn tag-gradient "Set the `gradient` property of this `cell` of this `world` to the difference in altitude between its highest and lowest neghbours." @@ -47,12 +69,14 @@ gradient (- highest lowest)] (merge cell {:gradient gradient}))) + (defn tag-gradients "Set the `gradient` property of each cell in this `world` to the difference in altitude between its highest and lowest neghbours." [world] (map-world world tag-gradient)) + (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. @@ -67,6 +91,7 @@ ([cell heightmap] (tag-property cell :altitude heightmap))) + (defn apply-heightmap "Apply the image file loaded from this path to this world, and return a world whose altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that @@ -92,6 +117,7 @@ (map-world world tag-altitude (list heightmap)) tag-gradient)))) + (defn apply-valuemap "Generalised from apply-heightmap, set an arbitrary property on each cell of this `world` from the values in this (ideally greyscale) heightmap. diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index 6032ca3..fd5f987 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -1,26 +1,52 @@ -;; A set of MicroWorld rules describing a simplified natural ecosystem. +(ns ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem." + :author "Simon Brooke"} + mw-engine.natural-rules + (:require mw-engine.utils + mw-engine.world)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; Since the completion of the rule language this is more or less obsolete - +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Since the completion of the rule language this is more or less obsolete - ;; there are still a few things that you can do with rules written in Clojure ;; that you can't do in the rule language, but not many and I doubt they're ;; important. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ns mw-engine.natural-rules - (:use mw-engine.utils - mw-engine.world)) ;; treeline at arbitrary altitude. (def treeline 150) + ;; waterline also at arbitrary altitude. (def waterline 10) + ;; and finally snowline is also arbitrary. (def snowline 200) + ;; Rare chance of lightning strikes (def lightning-probability 500) + ;; rules describing vegetation (def vegetation-rules (list @@ -72,8 +98,8 @@ ;; Forest increases soil fertility (fn [cell world] (cond (member? (:state cell) '(:forest :climax)) - (merge cell {:fertility (+ (get-int cell :fertility) 1)}))) - )) + (merge cell {:fertility (+ (get-int cell :fertility) 1)}))))) + ;; rules describing herbivore behaviour (def herbivore-rules @@ -139,8 +165,8 @@ (fn [cell world] (cond (>= (get-int cell :wolves) 2) - (merge cell {:wolves (int (* (:wolves cell) 2))}))) - )) + (merge cell {:wolves (int (* (:wolves cell) 2))}))))) + ;; rules which initialise the world (def init-rules @@ -152,12 +178,11 @@ (fn [cell world] (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow}))) ;; in between, we have a wasteland. - (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland})) - ))) + (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland}))))) + (def natural-rules (flatten (list vegetation-rules herbivore-rules - ;; predator-rules - ))) + predator-rules))) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 279ec18..fca4e3b 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,11 +1,29 @@ -;; Utility functions needed by MicroWorld and, specifically, in the -;; interpretation of MicroWorld rule. - -(ns mw-engine.utils +(ns ^{:doc " Utility functions needed by MicroWorld and, specifically, in the + interpretation of MicroWorld rule." + :author "Simon Brooke"} + mw-engine.utils (:require -;; [clojure.core.reducers :as r] [clojure.math.combinatorics :as combo])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defn abs "Surprisingly, Clojure doesn't seem to have an abs function, or else I've missed it. So here's one of my own. Maps natural numbers onto themselves, @@ -16,10 +34,12 @@ [n] (if (neg? n) (- 0 n) n)) + (defn member? "True if elt is a member of col." [elt col] (some #(= elt %) col)) + (defn get-int-or-zero "Return the value of this `property` from this `map` if it is a integer; otherwise return zero." @@ -27,6 +47,7 @@ (let [value (map property)] (if (integer? value) value 0))) + (defn init-generation "Return a cell like this `cell`, but having a value for :generation, zero if the cell passed had no integer value for generation, otherwise the value @@ -46,8 +67,9 @@ [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" + "Wholly non-parallel map world implementation; see documentation for `map-world`." ([world function] (map-world-n-n world function nil)) ([world function additional-args] @@ -59,8 +81,9 @@ row))) world)))) + (defn map-world-p-p - "Wholly parallel map world implementation" + "Wholly parallel map-world implementation; see documentation for `map-world`." ([world function] (map-world-p-p world function nil)) ([world function additional-args] @@ -91,6 +114,7 @@ row))) world)))) + (defn get-cell "Return the cell a x, y in this world, if any. @@ -101,6 +125,7 @@ (cond (in-bounds world x y) (nth (nth world y) x))) + (defn get-int "Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0. @@ -113,6 +138,7 @@ true 0)) true (throw (Exception. "No map passed?")))) + (defn population "Return the population of this species in this cell. Currently a synonym for `get-int`, but may not always be (depending whether species are later @@ -123,6 +149,7 @@ [cell species] (get-int cell species)) + (def memo-get-neighbours "Memoised get neighbours is more efficient when running deeply recursive algorithms on the same world. But it's less efficient when running the @@ -137,6 +164,7 @@ (range (- x depth) (+ x depth 1)) (range (- y depth) (+ y depth 1))))))))) + (defn get-neighbours "Get the neighbours to distance depth of a cell in this world. @@ -170,6 +198,7 @@ ([world cell] (get-neighbours world cell 1))) + (defn get-neighbours-with-property-value "Get the neighbours to distance depth of the cell at x, y in this world which have this value for this property. @@ -215,6 +244,7 @@ ([world cell state] (get-neighbours-with-state world cell 1 state))) + (defn get-least-cell "Return the cell from among these `cells` which has the lowest numeric value for this `property`; if the property is absent or not a number, use this @@ -242,6 +272,7 @@ true cell)) + (defn set-property "Return a world like this `world` but with the value of exactly one `property` of one `cell` changed to this `value`" @@ -258,6 +289,7 @@ 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" diff --git a/src/mw_engine/version.clj b/src/mw_engine/version.clj index d3fa41d..297456d 100644 --- a/src/mw_engine/version.clj +++ b/src/mw_engine/version.clj @@ -1,13 +1,15 @@ -(ns mw-engine.version +(ns ^{:doc "package documentation." + :author "Simon Brooke"} + mw-engine.version (:gen-class)) -(defn get-implementation-version +(defn get-implementation-version "Get the implementation version from the package of this namespace, which must - be compiled into a class (see clojure.java.interop). See + be compiled into a class (see clojure.java.interop). See http://stackoverflow.com/questions/12599889/how-to-get-runtime-access-to-version-number-of-a-running-clojure-application TODO: doesn't work yet." [] - (try + (try (.getImplementationVersion (.getPackage (eval 'mw-engine.version))) (catch Exception any "Unknown") )) diff --git a/src/mw_engine/world.clj b/src/mw_engine/world.clj index 2aa515f..a10289f 100644 --- a/src/mw_engine/world.clj +++ b/src/mw_engine/world.clj @@ -1,3 +1,28 @@ +(ns ^{:doc "Functions to create and to print two dimensional cellular automata." + :author "Simon Brooke"} + mw-engine.world + (:require [clojure.string :as string :only [join]] + [mw-engine.utils :refer [population]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;; USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; Functions to create and to print two dimensional cellular automata. Nothing in this ;; file should determine what states are possible within the automaton, except for the ;; initial state, :new. @@ -6,10 +31,9 @@ ;; ;; A world is a two dimensional matrix (sequence of sequences) of cells, such ;; that every cell's :x and :y properties reflect its place in the matrix. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ns mw-engine.world - (:use mw-engine.utils) - (:require [clojure.string :as string :only [join]])) (defn- make-cell "Create a minimal default cell at x, y @@ -19,6 +43,7 @@ [x y] {:x x :y y :state :new}) + (defn- make-world-row "Make the (remaining) cells in a row at this height in a world of this width. @@ -30,6 +55,7 @@ true (cons (make-cell index height) (make-world-row (inc index) width height)))) + (defn- make-world-rows "Make the (remaining) rows in a world of this width and height, from this index. @@ -51,6 +77,7 @@ [width height] (apply vector (make-world-rows 0 width height))) + (defn truncate-state "Truncate the print name of the state of this cell to at most limit characters." [cell limit] @@ -58,6 +85,7 @@ (cond (> (count (str s)) limit) (subs s 0 limit) true s))) + (defn format-cell "Return a formatted string summarising the current state of this cell." [cell] @@ -66,11 +94,13 @@ (population cell :deer) (population cell :wolves))) + (defn- format-world-row "Format one row in the state of a world for printing." [row] (string/join (map format-cell row))) + (defn print-world "Print the current state of this world, and return nil. From 944b54fc890d5a3ceeb6de7fe054eb62649a1028 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 13 Aug 2016 17:41:53 +0100 Subject: [PATCH 2/9] Deleted version.clj, which did not work anyway. --- src/mw_engine/version.clj | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 src/mw_engine/version.clj diff --git a/src/mw_engine/version.clj b/src/mw_engine/version.clj deleted file mode 100644 index 297456d..0000000 --- a/src/mw_engine/version.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns ^{:doc "package documentation." - :author "Simon Brooke"} - mw-engine.version - (:gen-class)) - -(defn get-implementation-version - "Get the implementation version from the package of this namespace, which must - be compiled into a class (see clojure.java.interop). See - http://stackoverflow.com/questions/12599889/how-to-get-runtime-access-to-version-number-of-a-running-clojure-application - TODO: doesn't work yet." - [] - (try - (.getImplementationVersion (.getPackage (eval 'mw-engine.version))) - (catch Exception any "Unknown") - )) - -(defn -main [] - (get-implementation-version )) From f1b35dc9487c3d8da7d4f2a48fd2a0ddce3ec18c Mon Sep 17 00:00:00 2001 From: simon Date: Sun, 21 Aug 2016 14:17:30 +0100 Subject: [PATCH 3/9] Standardised header documentation in line with current best practice. --- src/mw_engine/core.clj | 80 +++++++++++++++++---------------- src/mw_engine/display.clj | 36 ++++++++------- src/mw_engine/drainage.clj | 36 ++++++++------- src/mw_engine/heightmap.clj | 44 +++++++++--------- src/mw_engine/natural_rules.clj | 48 +++++++++++--------- src/mw_engine/utils.clj | 36 ++++++++------- src/mw_engine/world.clj | 56 ++++++++++++----------- 7 files changed, 182 insertions(+), 154 deletions(-) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index d471e08..83c1a2e 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -7,45 +7,49 @@ (:gen-class)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Every rule is a function of two arguments, a cell and a world. If the rule -;; fires, it returns a new cell, which should have the same values for :x and -;; :y as the old cell. Anything else can be modified. -;; -;; While any function of two arguments can be used as a rule, a special high -;; level rule language is provided by the `mw-parser` package, which compiles -;; rules expressed in a subset of English rules into suitable functions. -;; -;; A cell is a map containing at least values for the keys :x, :y, and :state; -;; a transformation should not alter the values of :x or :y, and should not -;; return a cell without a keyword as the value of :state. Anything else is -;; legal. -;; -;; A world is a two dimensional matrix (sequence of sequences) of cells, such -;; 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, -;; rules are applied in turn until one matches. Once one rule has matched no -;; further rules can be applied. -;; +;;;; +;;;; Every rule is a function of two arguments, a cell and a world. If the rule +;;;; fires, it returns a new cell, which should have the same values for :x and +;;;; :y as the old cell. Anything else can be modified. +;;;; +;;;; While any function of two arguments can be used as a rule, a special high +;;;; level rule language is provided by the `mw-parser` package, which compiles +;;;; rules expressed in a subset of English rules into suitable functions. +;;;; +;;;; A cell is a map containing at least values for the keys :x, :y, and :state; +;;;; a transformation should not alter the values of :x or :y, and should not +;;;; return a cell without a keyword as the value of :state. Anything else is +;;;; legal. +;;;; +;;;; A world is a two dimensional matrix (sequence of sequences) of cells, such +;;;; 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, +;;;; rules are applied in turn until one matches. Once one rule has matched no +;;;; further rules can be applied. +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn apply-rule diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj index 9c1f1c6..7dca8ff 100644 --- a/src/mw_engine/display.clj +++ b/src/mw_engine/display.clj @@ -6,22 +6,26 @@ mw-engine.world)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn format-css-class [state] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 4e844c4..87a7207 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -10,22 +10,26 @@ map-world]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index d6009cb..cde7002 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/mw_engine/heightmap.clj @@ -9,27 +9,31 @@ [mw-engine.world :refer [make-world]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Heightmaps are considered only as greyscale images, so colour is redundent (will be -;; ignored). Darker shades are higher. -;; +;;;; +;;;; Heightmaps are considered only as greyscale images, so colour is redundent +;;;; (will be ignored). Darker shades are higher. +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index fd5f987..af4a124 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -5,29 +5,33 @@ mw-engine.world)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Since the completion of the rule language this is more or less obsolete - -;; there are still a few things that you can do with rules written in Clojure -;; that you can't do in the rule language, but not many and I doubt they're -;; important. -;; +;;;; +;;;; Since the completion of the rule language this is more or less obsolete - +;;;; there are still a few things that you can do with rules written in Clojure +;;;; that you can't do in the rule language, but not many and I doubt they're +;;;; important. +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index fca4e3b..53c359f 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -6,22 +6,26 @@ [clojure.math.combinatorics :as combo])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn abs diff --git a/src/mw_engine/world.clj b/src/mw_engine/world.clj index a10289f..9001ed6 100644 --- a/src/mw_engine/world.clj +++ b/src/mw_engine/world.clj @@ -5,33 +5,37 @@ [mw-engine.utils :refer [population]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;; USA. -;; +;;;; +;;;; mw-engine: the state/transition engine of MicroWorld. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU General Public License +;;;; as published by the Free Software Foundation; either version 2 +;;;; of the License, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. +;;;; +;;;; Copyright (C) 2014 Simon Brooke +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Functions to create and to print two dimensional cellular automata. Nothing in this -;; file should determine what states are possible within the automaton, except for the -;; initial state, :new. -;; -;; A cell is a map containing at least values for the keys :x, :y, and :state. -;; -;; A world is a two dimensional matrix (sequence of sequences) of cells, such -;; that every cell's :x and :y properties reflect its place in the matrix. -;; +;;;; +;;;; Functions to create and to print two dimensional cellular automata. +;;;; Nothing in this namespace should determine what states are possible within +;;;; the automaton, except for the initial state, :new. +;;;; +;;;; A cell is a map containing at least values for the keys :x, :y, and :state. +;;;; +;;;; A world is a two dimensional matrix (sequence of sequences) of cells, such +;;;; that every cell's :x and :y properties reflect its place in the matrix. +;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 39b7cd608c8d66f5c5e935d5fd9b3ea3b17debcd Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 15:22:41 +0000 Subject: [PATCH 4/9] Added Docker stuff; corrected usage message. --- buildall.sh | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/buildall.sh b/buildall.sh index 0eabd8e..2f19975 100755 --- a/buildall.sh +++ b/buildall.sh @@ -72,8 +72,9 @@ if [ $# -lt 1 ] then cat <<-EOF 1>&2 Usage: - -archive Create a tar archive of the current state of the source. - -build Build all components and commit to master. + -archive Create a tar archive of the current state of the source. + -build Build all components, commit and push to origin. + -docker Build and push a Docker image. -email [ADDRESS] Your email address, to be recorded in the build signature. -fullname [NAME] Your full name, to be recorded in the build signature. -pull Pull from remote git repository @@ -87,12 +88,14 @@ fi while (( "$#" )) do case $1 in - -a|-archive) - archive="TRUE";; + -a|-archive) + archive="TRUE";; -b|-build) # 'build' is the expected normal case. trial="FALSE"; ;; + -d|-docker) + docker="TRUE";; -e|-email) shift; email=$1;; @@ -126,7 +129,7 @@ do shift done -echo "Trial: ${trial}; email: ${email}; fullname ${fullname}; release: ${release}; webapps: $webappsdir" +echo "Trial: ${trial}; docker: ${docker}; email: ${email}; fullname ${fullname}; release: ${release}; webapps: $webappsdir" ls mw-* > /dev/null 2>&1 if [ $? -ne 0 ] @@ -200,12 +203,18 @@ do # probably deploy it to local Tomcat for test if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ] then - lein ring uberwar + lein ring uberwar sudo cp target/microworld.war "${webappsdir}" echo "Deployed new WAR file to local Tomcat at ${webappsdir}" fi - # Then unset manifest properties prior to committing. + if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ] + then + lein docker build + lein docker push + fi + + # Then unset manifest properties prior to committing. cat project.clj > ${tmp}/project.bak.2 setup-build-sig sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj From 47caea3eb81b4eae5c3ad36f0cf12d731a93dfd6 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 15:44:57 +0000 Subject: [PATCH 5/9] Don't do anything with mw-explore during buildall - it contains unreliable junk. --- buildall.sh | 263 ++++++++++++++++++++++++++-------------------------- 1 file changed, 133 insertions(+), 130 deletions(-) diff --git a/buildall.sh b/buildall.sh index 2f19975..6152aed 100755 --- a/buildall.sh +++ b/buildall.sh @@ -140,138 +140,141 @@ fi for dir in mw-* do - pushd ${dir} - - # Make a temporary directory to keep the work-in-progress files. - if [ ! -d "${tmp}" ] - then - rm -f "${tmp}" - mkdir "${tmp}" - fi - - cat project.clj > ${tmp}/project.bak.1 - old=`cat project.clj | grep 'defproject mw' | sed 's/.*defproject mw-[a-z]* "\([A-Za-z0-9_.-]*\)".*/\1/'` - - if [ "${release}" != "" ] - then - message="Preparing ${old} for release" - - # Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does! - echo "${old}" | grep 'SNAPSHOT' - if [ $? -eq 0 ] - then - # It does... - interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'` - if [ "${interim}" = "" ] - then - echo "Failed to compute interim version tag from '${old}'" 1>&2 - exit 1; - fi - setup-build-sig "${old}" "${interim}" "${fullname}" "${email}" - message="Upversioned from ${old} to ${interim} for release" - old=${interim} - else - setup-build-sig "unset" "${old}" "${fullname}" "${email}" - fi - else - setup-build-sig "unset" "${old}" "${fullname}" "${email}" - fi - - sed -f ${tmp}/manifest.sed ${tmp}/project.bak.1 > project.clj - - echo $message - - lein clean - lein compile - if [ $? -ne 0 ] - then - echo "Sub-project ${dir} failed in compile" 1>&2 - exit 1 - fi - - lein test - if [ $? -ne 0 ] - then - echo "Sub-project ${dir} failed in test" 1>&2 - exit 1 - fi - - lein marg - lein install - - # If we're in the UI project, build the uberwar - and should - # probably deploy it to local Tomcat for test - if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ] - then - lein ring uberwar - sudo cp target/microworld.war "${webappsdir}" - echo "Deployed new WAR file to local Tomcat at ${webappsdir}" - fi - - if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ] + if [ "${dir}" != "mw-explore" ] then - lein docker build - lein docker push + pushd ${dir} + + # Make a temporary directory to keep the work-in-progress files. + if [ ! -d "${tmp}" ] + then + rm -f "${tmp}" + mkdir "${tmp}" + fi + + cat project.clj > ${tmp}/project.bak.1 + old=`cat project.clj | grep 'defproject mw' | sed 's/.*defproject mw-[a-z]* "\([A-Za-z0-9_.-]*\)".*/\1/'` + + if [ "${release}" != "" ] + then + message="Preparing ${old} for release" + + # Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does! + echo "${old}" | grep 'SNAPSHOT' + if [ $? -eq 0 ] + then + # It does... + interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'` + if [ "${interim}" = "" ] + then + echo "Failed to compute interim version tag from '${old}'" 1>&2 + exit 1; + fi + setup-build-sig "${old}" "${interim}" "${fullname}" "${email}" + message="Upversioned from ${old} to ${interim} for release" + old=${interim} + else + setup-build-sig "unset" "${old}" "${fullname}" "${email}" + fi + else + setup-build-sig "unset" "${old}" "${fullname}" "${email}" + fi + + sed -f ${tmp}/manifest.sed ${tmp}/project.bak.1 > project.clj + + echo $message + + lein clean + lein compile + if [ $? -ne 0 ] + then + echo "Sub-project ${dir} failed in compile" 1>&2 + exit 1 + fi + + lein test + if [ $? -ne 0 ] + then + echo "Sub-project ${dir} failed in test" 1>&2 + exit 1 + fi + + lein marg + lein install + + # If we're in the UI project, build the uberwar - and should + # probably deploy it to local Tomcat for test + if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ] + then + lein ring uberwar + sudo cp target/microworld.war "${webappsdir}" + echo "Deployed new WAR file to local Tomcat at ${webappsdir}" + fi + + if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ] + then + lein docker build + lein docker push + fi + + # Then unset manifest properties prior to committing. + cat project.clj > ${tmp}/project.bak.2 + setup-build-sig + sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj + + if [ "${trial}" = "FALSE" ] + then + if [ "${message}" = "" ] + then + git commit -a + else + git commit -a -m "$message" + fi + git push origin master + fi + + if [ "${release}" != "" ] + then + branch="${old}_MAINTENANCE" + if [ "${trial}" = "FALSE" ] + then + git branch "${branch}" + git push origin "${branch}" + fi + + cat project.clj > ${tmp}/project.bak.3 + setup-build-sig "${old}" "${release}-SNAPSHOT" "${fullname}" "${email}" + sed -f ${tmp}/manifest.sed ${tmp}/project.bak.3 > project.clj + message="Upversioned from ${interim} to ${release}-SNAPSHOT" + + echo $message + + lein clean + lein compile + if [ $? -ne 0 ] + then + echo "Sub-project ${dir} failed in compile after branch to ${release}!" 1>&2 + exit 1 + fi + lein marg + lein install + + # Then unset manifest properties prior to committing. + cat project.clj > ${tmp}/project.bak.4 + setup-build-sig + sed -f ${tmp}/manifest.sed ${tmp}/project.bak.4 > project.clj + + if [ "${trial}" = "FALSE" ] + then + git commit -a -m "${message}" + echo ${message} + git push origin master + fi + fi + + # if nothing broke so far, clean up... + rm -rf "${tmp}" + popd fi - - # Then unset manifest properties prior to committing. - cat project.clj > ${tmp}/project.bak.2 - setup-build-sig - sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj - - if [ "${trial}" = "FALSE" ] - then - if [ "${message}" = "" ] - then - git commit -a - else - git commit -a -m "$message" - fi - git push origin master - fi - - if [ "${release}" != "" ] - then - branch="${old}_MAINTENANCE" - if [ "${trial}" = "FALSE" ] - then - git branch "${branch}" - git push origin "${branch}" - fi - - cat project.clj > ${tmp}/project.bak.3 - setup-build-sig "${old}" "${release}-SNAPSHOT" "${fullname}" "${email}" - sed -f ${tmp}/manifest.sed ${tmp}/project.bak.3 > project.clj - message="Upversioned from ${interim} to ${release}-SNAPSHOT" - - echo $message - - lein clean - lein compile - if [ $? -ne 0 ] - then - echo "Sub-project ${dir} failed in compile after branch to ${release}!" 1>&2 - exit 1 - fi - lein marg - lein install - - # Then unset manifest properties prior to committing. - cat project.clj > ${tmp}/project.bak.4 - setup-build-sig - sed -f ${tmp}/manifest.sed ${tmp}/project.bak.4 > project.clj - - if [ "${trial}" = "FALSE" ] - then - git commit -a -m "${message}" - echo ${message} - git push origin master - fi - fi - - # if nothing broke so far, clean up... - rm -rf "${tmp}" - popd done From 3ca247e4710d164a7ef8a0510bc5192afbd8107f Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 16:18:10 +0000 Subject: [PATCH 6/9] Upversioned from 0.1.5-SNAPSHOT to 0.1.5 for release --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index a2739ff..4a9ccb9 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.5-SNAPSHOT" +(defproject mw-engine "0.1.5" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From 519ca4e3bdb3756631f8f668ed20ce28d78b2393 Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 27 Dec 2016 16:18:38 +0000 Subject: [PATCH 7/9] Upversioned from 0.1.5 to 0.1.6-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 4a9ccb9..70cfad8 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.5" +(defproject mw-engine "0.1.6-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From 2f2463da0e75077d55e06de6f91475de6ff02f29 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 3 Jun 2020 10:47:28 +0100 Subject: [PATCH 8/9] Sweep up of minor changes --- .gitignore | 10 + docs/uberdoc.html | 3997 +++++++++++++++++++++++++++++++ project.clj | 7 +- src/mw_engine/core.clj | 9 +- src/mw_engine/display.clj | 6 +- src/mw_engine/drainage.clj | 68 +- src/mw_engine/natural_rules.clj | 4 +- 7 files changed, 4092 insertions(+), 9 deletions(-) create mode 100644 .gitignore create mode 100644 docs/uberdoc.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f553393 --- /dev/null +++ b/.gitignore @@ -0,0 +1,10 @@ + +target/ + +pom.xml + +.lein-repl-history + +.lein-failures + +eastwood.txt diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..91fdaea --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3997 @@ + +mw-engine -- Marginalia

mw-engine

0.1.6-SNAPSHOT


Cellular automaton world builder.

+

dependencies

org.clojure/clojure
1.6.0
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



(this space intentionally left almost blank)

namespaces

 

mw-engine.core

toc

Functions to transform a world and run rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.core
+  (:require [clojure.core.reducers :as r]
+            [mw-engine.world :as world]
+            [mw-engine.utils :refer [get-int-or-zero map-world]])
+  (:gen-class))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Every rule is a function of two arguments, a cell and a world. If the rule +fires, it returns a new cell, which should have the same values for :x and +:y as the old cell. Anything else can be modified.

+ +

While any function of two arguments can be used as a rule, a special high +level rule language is provided by the mw-parser package, which compiles +rules expressed in a subset of English rules into suitable functions.

+ +

A cell is a map containing at least values for the keys :x, :y, and :state; +a transformation should not alter the values of :x or :y, and should not +return a cell without a keyword as the value of :state. Anything else is +legal.

+ +

A world is a two dimensional matrix (sequence of sequences) of cells, such +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, +rules are applied in turn until one matches. Once one rule has matched no +further rules can be applied.

+

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 + an ifn, or a list (ifn source-text). This function deals with despatching + on those two possibilities. world is also passed in in order to be able + to access neighbours.

+
(defn apply-rule
+  ([world cell rule]
+   (cond
+     (ifn? rule) (apply-rule world cell rule nil)
+     (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
+  ([world cell rule source]
+    (let [result (apply rule (list cell world))]
+      (cond
+        (and result source) (merge result {:rule source})
+        true result))))

Derive a cell from this cell of this world by applying these rules.

+
(defn- apply-rules
+  [world cell rules]
+  (cond (empty? rules) cell
+    true (let [result (apply-rule world cell (first rules))]
+           (cond result result
+             true (apply-rules world cell (rest rules))))))

Derive a cell from this cell of this world by applying these rules. If an + exception is thrown, cache its message on the cell and set it's state to error

+
(defn- transform-cell
+  [world cell rules]
+  (try
+    (merge
+      (apply-rules world cell rules)
+      {:generation (+ (get-int-or-zero cell :generation) 1)})
+    (catch Exception e
+      (merge cell {:error
+                   (format "%s at generation %d when in state %s"
+                           (.getMessage e)
+                           (:generation cell)
+                           (:state cell))
+                   :stacktrace (map #(.toString %) (.getStackTrace e))
+                   :state :error}))))

Return a world derived from this world by applying these rules to each cell.

+
(defn transform-world
+  [world rules]
+  (map-world world transform-cell (list rules)))

Consider this single argument as a map of :world and :rules; apply the rules + to transform the world, and return a map of the new, transformed :world and + these :rules. As a side effect, print the world.

+
(defn- transform-world-state
+  [state]
+  (let [world (transform-world (:world state) (:rules state))]
+    ;;(world/print-world world)
+    {:world world :rules (:rules state)}))

Run this world with these rules for this number of generations.

+ +
    +
  • world a world as discussed above;
    • +
  • init-rules a sequence of rules as defined above, to be run once to initialise the world;
    • +
  • rules a sequence of rules as defined above, to be run iteratively for each generation;
    • +

  • generations an (integer) number of generations.

    + +

    Return the final generation of the world.

    • +
+
(defn run-world
+  [world init-rules rules generations]
+  (reduce (fn [world _iteration]
+            (transform-world world rules))
+        (transform-world world init-rules)
+        (range generations)))
 

mw-engine.display

toc

Simple functions to allow a world to be visualised.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.display
+  (:require [hiccup.core :refer [html]]
+            mw-engine.utils
+            mw-engine.world))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(defn format-css-class [state]
+  "Format this `state`, assumed to be a keyword indicating a state in the
+   world, into a CSS class"
+  (subs (str state) 1))

Render this state, assumed to be a keyword indicating a state in the + world, into a path which should recover the corresponding image file.

+
(defn format-image-path
+  [state]
+  (format "img/tiles/%s.png" (format-css-class state)))
+
(defn format-mouseover [cell]
+  (str cell))

Render this world cell as a Hiccup table cell.

+
(defn render-cell
+  [cell]
+  (let [state (:state cell)]
+    [:td {:class (format-css-class state) :title (format-mouseover cell)}
+     [:a {:href (format "inspect?x=%d&y=%d" (:x cell) (:y cell))}
+      [:img {:alt (:state cell) :width 32 :height 32 :src (format-image-path state)}]]]))

Render this world row as a Hiccup table row.

+
(defn render-world-row
+  [row]
+  (apply vector (cons :tr (map render-cell row))))

Render this world as a Hiccup table.

+
(defn render-world-table
+  [world]
+  (apply vector
+    (cons :table
+      (map render-world-row world))))
 

mw-engine.drainage

toc

Experimental, probably of no interest to anyone else; attempt to + compute drainage on a world, assumed to have altitudes already set + from a heightmap.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.drainage
+  (:require [mw-engine.core :refer [run-world]]
+            [mw-engine.heightmap :as heightmap]
+            [mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours
+                                     get-neighbours-with-property-value
+                                     map-world]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(def ^:dynamic *sealevel* 10)

forward declaration of flow, to allow for a wee bit of mutual recursion.

+
(declare flow)

Compute rainfall for a cell with this gradient west-east, given + remaining drops to distribute, and this overall map width.

+
(defn rainfall
+  [gradient remaining map-width]
+    (cond
+      ;; if there's no rain left in the cloud, it can't fall;
+      (zero? remaining)
+      0
+      (pos? gradient)
+      ;; rain, on prevailing westerly wind, falls preferentially on rising ground;
+      (int (rand gradient))
+      ;; rain falls randomly across the width of the map...
+      (zero? (int (rand map-width))) 1
+      :else
+      0))

Return a row like this row, across which rainfall has been distributed; + if rain-probability is specified, it is the probable rainfall on a cell + with no gradient.

+
(defn rain-row
+  ([row]
+   (rain-row row 1))
+  ([row rain-probability]
+   (rain-row row (count row) 0 (int (* (count row) rain-probability))))
+  ([row map-width previous-altitude drops-in-cloud]
+   (cond
+     (empty? row) nil
+     (pos? drops-in-cloud)
+     (let [cell (first row)
+           alt (or (:altitude cell) 0)
+           rising (- alt previous-altitude)
+           fall (rainfall rising drops-in-cloud map-width)]
+       (cons
+         (assoc cell :rainfall fall)
+         (rain-row (rest row) map-width alt (- drops-in-cloud fall))))
+     :else
+     (map
+       #(assoc % :rainfall 0)
+       row))))

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

+
(defn rain-world
+  [world]
+  (map
+    rain-row
+    world))

Return a list of the cells in this world which are higher than this + cell and for which this cell is the lowest neighbour, or which are at the + same altitude and have greater flow

+
(defn flow-contributors
+  [cell world]
+  (filter #(map? %)
+          (map
+            (fn [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) >=))))

Detects point hollows - that is, individual cells all of whose neighbours + are higher. Return true if this cell has an altitude lower than any of + its neighbours in this world

+
(defn is-hollow
+  [world cell]
+  ;; quicker to count the elements of the list and compare equality of numbers
+  ;; than recursive equality check on members, I think. But worth benchmarking.
+  (let [neighbours (get-neighbours world cell)
+        altitude (get-int-or-zero cell :altitude)]
+    (= (count neighbours)
+       (count (get-neighbours-with-property-value
+                world (:x cell) (:y cell) 1 :altitude altitude >)))))

Raise the altitude of a copy of this cell of this world to the altitude + of the lowest of its neighbours.

+
(defn flood-hollow
+  ([world cell neighbours]
+    (let [lowest (get-least-cell neighbours :altitude)]
+      (merge cell {:state :water :altitude (:altitude lowest)})))
+  ([world cell]
+    (flood-hollow world cell (get-neighbours world cell))))

Flood all local hollows in this world. At this stage only floods single + cell hollows.

+
(defn flood-hollows
+  [world]
+  (map-world world
+             #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
+
(def max-altitude 255)

Experimental non recursive flow algorithm, needs to be run on a world as + many times as there are distinct altitude values. This algorithm works only + if applied sequentially from the highest altitude to the lowest, see + flow-world-nr.

+
(defn flow-nr
+  [cell world]
+  (if (= (- max-altitude (get-int-or-zero cell :generation))
+         (get-int-or-zero cell :altitude))
+    (merge cell
+           {:flow (reduce +
+                          (map
+                            #(+ (get-int-or-zero % :rainfall)
+                                (get-int-or-zero % :flow))
+                            (flow-contributors cell world)))})))

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.

+ +

Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher.

+
(def flow
+  (memoize
+   (fn [cell world]
+     (cond
+      (not (nil? (:flow cell))) cell
+      (<= (or (:altitude cell) 0) *sealevel*) cell
+      true
+      (merge cell
+             {:flow (+ (:rainfall cell)
+                       (apply +
+                              (map (fn [neighbour] (:flow (flow neighbour world)))
+                                   (flow-contributors cell world))))})))))

Experimental non-recursive flow-world algorithm

+
(defn flow-world-nr
+  [world]
+  (run-world world nil (list flow-nr) max-altitude))

Return a world like this world, but with cells tagged with the amount of + water flowing through them.

+
(defn flow-world
+  [world]
+  (map-world (rain-world world) flow))

Return a sequence of cells starting with this cell in this world which + form a contiguous lake

+
(defn explore-lake
+  [world cell])

If this cell in this world is not part of a lake, return nil. If it is, + return a cell like this cell tagged as part of a lake.

+
(defn is-lake?
+  [world cell]
+  (if
+    ;; if it's already tagged as a lake, it's a lake
+    (:lake cell) cell
+    (let
+      [outflow (min (map :altitude (get-neighbours world cell)))]
+      (if-not
+        (> (:altitude cell) outflow)
+        (assoc cell :lake true)))))
+
(defn find-lakes
+  [world])
+
(defn run-drainage
+  [hmap]
+  "Create a world from the heightmap `hmap`, rain on it, and then compute river
+   flows."
+  (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))
 

mw-engine.heightmap

toc

Functions to apply a heightmap to a world.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.heightmap
+  (:import [java.awt.image BufferedImage])
+  (:require [fivetonine.collage.util :as collage :only [load-image]]
+            [mikera.image.core :as imagez :only [filter-image get-pixels]]
+            [mikera.image.filters :as filters]
+            [mw-engine.utils :refer [abs get-int get-neighbours map-world]]
+            [mw-engine.world :refer [make-world]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Heightmaps are considered only as greyscale images, so colour is redundent +(will be ignored). Darker shades are higher.

+

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.

+ +
    +
  • world not actually used, but present to enable this function to be + passed as an argument to mw-engine.utils/map-world, q.v.
    • +
  • cell a cell, as discussed in world.clj, q.v. Alternatively, a map;
    • +
  • property the property (normally a keyword) whose value will be set on the cell.
    • +
  • heightmap an (ideally) greyscale image, whose x and y dimensions should + exceed those of the world of which the cell forms part.
    • +
+
(defn tag-property
+  ([world cell property heightmap]
+    (tag-property cell property heightmap))
+  ([cell property heightmap]
+    (merge cell
+           {property
+            (+ (get-int cell property)
+               (- 256
+                  (abs
+                    (mod
+                      (.getRGB heightmap
+                        (get-int cell :x)
+                        (get-int cell :y)) 256))))})))

Set the gradient property of this cell of this world to the difference in + altitude between its highest and lowest neghbours.

+
(defn tag-gradient
+  [world cell]
+  (let [heights (remove nil? (map :altitude (get-neighbours world cell)))
+        highest (cond (empty? heights) 0 ;; shouldn't happen
+                  true (apply max heights))
+        lowest (cond (empty? heights) 0 ;; shouldn't
+                 true (apply min heights))
+        gradient (- highest lowest)]
+    (merge cell {:gradient gradient})))

Set the gradient property of each cell in this world to the difference in + altitude between its highest and lowest neghbours.

+
(defn tag-gradients
+  [world]
+  (map-world world tag-gradient))

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.

+ +
    +
  • world not actually used, but present to enable this function to be + passed as an argument to mw-engine.utils/map-world, q.v.;
    • +
  • cell a cell, as discussed in world.clj, q.v. Alternatively, a map;
    • +
  • heightmap an (ideally) greyscale image, whose x and y dimensions should + exceed those of the world of which the cell forms part.
    • +
+
(defn tag-altitude
+  ([world cell heightmap]
+    (tag-property cell :altitude heightmap))
+  ([cell heightmap]
+    (tag-property cell :altitude heightmap)))

Apply the image file loaded from this path to this world, and return a world whose + altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that + the heightmap is at least as large in x and y dimensions as the world. Note that, in + addition to setting the :altitude of each cell, this function also sets the :gradient.

+ +
    +
  • world a world, as defined in world.clj, q.v.; if world is not supplied, +a world the size of the heightmap will be created;
    • +
  • imagepath a file path or URL which indicates an (ideally greyscale) image file.
    • +
+
(defn apply-heightmap
+  ([world imagepath]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))]
+      (map-world
+        (map-world world tag-altitude (list heightmap))
+        tag-gradient)))
+   ([imagepath]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))
+          world (make-world (.getWidth heightmap) (.getHeight heightmap))]
+      (map-world
+        (map-world world tag-altitude (list heightmap))
+        tag-gradient))))

Generalised from apply-heightmap, set an arbitrary property on each cell + of this world from the values in this (ideally greyscale) heightmap.

+ +
    +
  • world a world, as defined in world.clj, q.v.;
    • +
  • imagepath a file path or URL which indicates an (ideally greyscale) image file;
    • +
  • property the property of each cell whose value should be added to from the + intensity of the corresponding cell of the image.
    • +
+
(defn apply-valuemap
+  [world imagepath property]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))]
+      (map-world world tag-property (list property heightmap))))
 

mw-engine.natural-rules

toc

A set of MicroWorld rules describing a simplified natural ecosystem.

+
(ns ^{:doc 
+       :author "Simon Brooke"}
+  mw-engine.natural-rules
+  (:require [mw-engine.utils :refer :all]
+        [mw-engine.world :refer :all]))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Since the completion of the rule language this is more or less obsolete - +there are still a few things that you can do with rules written in Clojure +that you can't do in the rule language, but not many and I doubt they're +important.

+

treeline at arbitrary altitude.

+
(def treeline 150)

waterline also at arbitrary altitude.

+
(def waterline 10)

and finally snowline is also arbitrary.

+
(def snowline 200)

Rare chance of lightning strikes

+
(def lightning-probability 500)

rules describing vegetation

+
(def vegetation-rules
+  (list
+    ;; Randomly, birds plant tree seeds into grassland.
+    (fn [cell world] (cond (and (= (:state cell) :grassland)(< (rand 10) 1))(merge cell {:state :heath})))
+    ;; heath below the treeline grows gradually into forest, providing browsing pressure is not to high
+    (fn [cell world]
+      (cond (and
+              (= (:state cell) :heath)
+              ;; browsing limit really ought to vary with soil fertility, but...
+              (< (+ (get-int cell :deer)(get-int cell :sheep)) 6)
+              (< (get-int cell :altitude) treeline))
+        (merge cell {:state :scrub})))
+    (fn [cell world] (cond (= (:state cell) :scrub) (merge cell {:state :forest})))
+    ;; Forest on fertile land grows to climax
+    (fn [cell world]
+      (cond
+        (and
+          (= (:state cell) :forest)
+          (> (get-int cell :fertility) 10))
+        (merge cell {:state :climax})))
+    ;; Climax forest occasionally catches fire (e.g. lightning strikes)
+    (fn [cell world] (cond (and (= (:state cell) :climax)(< (rand lightning-probability) 1)) (merge cell {:state :fire})))
+    ;; Climax forest neighbouring fires is likely to catch fire
+    (fn [cell world]
+      (cond
+        (and (= (:state cell) :climax)
+             (< (rand 3) 1)
+             (not (empty? (get-neighbours-with-state world (:x cell) (:y cell) 1 :fire))))
+        (merge cell {:state :fire})))
+    ;; After fire we get waste
+    (fn [cell world] (cond (= (:state cell) :fire) (merge cell {:state :waste})))
+    ;; And after waste we get pioneer species; if there's a woodland seed
+    ;; source, it's going to be heath, otherwise grassland.
+    (fn [cell world]
+      (cond
+        (and (= (:state cell) :waste)
+             (not
+               (empty?
+                 (flatten
+                   (list
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub)
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :forest)
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :climax))))))
+        (merge cell {:state :heath})))
+    (fn [cell world]
+      (cond (= (:state cell) :waste)
+        (merge cell {:state :grassland})))
+    ;; Forest increases soil fertility
+    (fn [cell world]
+      (cond (member? (:state cell) '(:forest :climax))
+        (merge cell {:fertility (+ (get-int cell :fertility) 1)})))))

rules describing herbivore behaviour

+
(def herbivore-rules
+  (list
+    ;; if there are too many deer for the fertility of the area to sustain,
+    ;; some die or move on.
+    (fn [cell world]
+      (cond (> (get-int cell :deer) (get-int cell :fertility))
+        (merge cell {:deer (get-int cell :fertility)})))
+    ;; deer arrive occasionally at the edge of the map.
+    (fn [cell world]
+      (cond (and (< (count (get-neighbours world cell)) 8)
+                 (< (rand 50) 1)
+                 (> (get-int cell :fertility) 0)
+                 (= (get-int cell :deer) 0))
+        (merge cell {:deer 2})))
+    ;; deer gradually spread through the world by breeding or migrating.
+    (fn [cell world]
+      (let [n (apply + (map #(get-int % :deer) (get-neighbours world cell)))]
+        (cond (and
+                (> (get-int cell :fertility) 0)
+                (= (get-int cell :deer) 0)
+                (>= n 2))
+          (merge cell {:deer (int (/ n 2))}))))
+    ;; deer breed.
+    (fn [cell world]
+      (cond
+        (>= (get-int cell :deer) 2)
+        (merge cell {:deer (int (* (:deer cell) 2))})))))

rules describing predator behaviour

+
  (def predator-rules
+    (list
+     ;; wolves eat deer
+     (fn [cell world]
+      (cond
+       (>= (get-int cell :wolves) 1)
+       (merge cell {:deer (max 0 (- (get-int cell :deer) (get-int cell :wolves)))})))
+;;      ;; not more than eight wolves in a pack, for now (hack because wolves are not dying)
+;;      (fn [cell world]
+;;        (cond (> (get-int cell :wolves) 8) (merge cell {:wolves 8})))
+    ;; if there are not enough deer to sustain the get-int of wolves,
+    ;; some wolves die or move on. (doesn't seem to be working?)
+    (fn [cell world]
+       (cond (> (get-int cell :wolves) (get-int cell :deer))
+         (merge cell {:wolves 0})))
+    ;; wolves arrive occasionally at the edge of the map.
+    (fn [cell world]
+      (cond (and (< (count (get-neighbours world cell)) 8)
+                 (< (rand 50) 1)
+                 (not (= (:state cell) :water))
+                 (= (get-int cell :wolves) 0))
+        (merge cell {:wolves 2})))
+    ;; wolves gradually spread through the world by breeding or migrating.
+    (fn [cell world]
+      (let [n (apply + (map #(get-int % :wolves) (get-neighbours world cell)))]
+        (cond (and
+                (not (= (:state cell) :water))
+                (= (get-int cell :wolves) 0)
+                (>= n 2))
+          (merge cell {:wolves 2}))))
+    ;; wolves breed.
+    (fn [cell world]
+      (cond
+        (>= (get-int cell :wolves) 2)
+        (merge cell {:wolves (int (* (:wolves cell) 2))})))))

rules which initialise the world

+
  (def init-rules
+    (list
+     ;; below the waterline, we have water.
+     (fn [cell world]
+       (cond (and (= (:state cell) :new) (< (get-int cell :altitude) waterline)) (merge cell {:state :water})))
+     ;; above the snowline, we have snow.
+     (fn [cell world]
+       (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
+     ;; in between, we have a wasteland.
+     (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland})))))
+
(def natural-rules (flatten
+                    (list
+                     vegetation-rules
+                     herbivore-rules
+                     predator-rules)))
 

mw-engine.utils

toc

Utility functions needed by MicroWorld and, specifically, in the + interpretation of MicroWorld rule.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.utils
+  (:require
+    [clojure.math.combinatorics :as combo]))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+

Surprisingly, Clojure doesn't seem to have an abs function, or else I've + missed it. So here's one of my own. Maps natural numbers onto themselves, + and negative integers onto natural numbers. Also maps negative real numbers + onto positive real numbers.

+ +
    +
  • n a number, on the set of real numbers.
    • +
+
(defn abs
+  [n]
+  (if (neg? n) (- 0 n) n))

True if elt is a member of col.

+
(defn member?
+  [elt col] (some #(= elt %) col))

Return the value of this property from this map if it is a integer; + otherwise return zero.

+
(defn get-int-or-zero
+  [map property]
+  (let [value (map property)]
+    (if (integer? value) value 0)))

Return a cell like this cell, but having a value for :generation, zero if + the cell passed had no integer value for generation, otherwise the value + taken from the cell passed. The world argument is present only for + consistency with the rule engine and is ignored.

+
(defn init-generation
+  [world cell]
+  (merge cell {:generation (get-int-or-zero cell :generation)}))

True if x, y are in bounds for this world (i.e., there is a cell at x, y) + else false.

+ +
    +
  • world a world as defined above;
    • +
  • x a number which may or may not be a valid x coordinate within that world;
    • +
  • y a number which may or may not be a valid y coordinate within that world.
    • +
+
(defn in-bounds
+  [world x y]
+  (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))

Wholly non-parallel map world implementation; see documentation for map-world.

+
(defn map-world-n-n
+  ([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))))

Wholly parallel map-world implementation; see documentation for map-world.

+
(defn map-world-p-p
+  ([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))))

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 + running rows in parallel.

+
(defn map-world
+  ([world function]
+    (map-world world function nil))
+  ([world function additional-args]
+    (into []
+           (pmap (fn [row]
+                    (into [] (map
+                             #(apply function
+                                     (cons world (cons % additional-args)))
+                             row)))
+                  world))))

Return the cell a x, y in this world, if any.

+ +
    +
  • world a world as defined above;
    • +
  • x a number which may or may not be a valid x coordinate within that world;
    • +
  • y a number which may or may not be a valid y coordinate within that world.
    • +
+
(defn get-cell
+  [world x y]
+  (cond (in-bounds world x y)
+    (nth (nth world y) x)))

Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0.

+ +
    +
  • map a map;
    • +
  • key a symbol or keyword, presumed to be a key into the map.
    • +
+
(defn get-int
+  [map key]
+  (cond (map? map)
+    (let [v (map key)]
+      (cond (and v (integer? v)) v
+            true 0))
+        true (throw (Exception. "No map passed?"))))

Return the population of this species in this cell. Currently a synonym for + get-int, but may not always be (depending whether species are later + implemented as actors)

+ +
    +
  • cell a map;
    • +
  • species a keyword representing a species which may populate that cell.
    • +
+
(defn population
+  [cell species]
+  (get-int cell species))

Memoised get neighbours is more efficient when running deeply recursive + algorithms on the same world. But it's less efficient when running the + engine in its normal iterative style, because then we will rarely call + get naighbours on the same cell of the same world twice.

+
(def memo-get-neighbours
+  (memoize
+   (fn [world x y depth]
+     (remove nil?
+             (map #(get-cell world (first %) (first (rest %)))
+                  (remove #(= % (list x y))
+                          (combo/cartesian-product
+                            (range (- x depth) (+ x depth 1))
+                            (range (- y depth) (+ y depth 1)))))))))

Get the neighbours to distance depth of a cell in this world.

+ +
Several overloads:
+* `world` a world, as described in world.clj;
+* `cell` a cell within that world
+Gets immediate neighbours of the specified cell.
+
+* `world` a world, as described in world.clj;
+* `cell` a cell within that world
+* `depth` an integer representing the depth to search from the
+  `cell`
+Gets neighbours within the specified distance of the cell.
+
+* `world` a world, as described in world.clj;
+* `x` an integer representing an x coordinate in that world;
+* `y` an integer representing an y coordinate in that world;
+* `depth` an integer representing the distance from [x,y] that
+  should be searched
+Gets the neighbours within the specified distance of the cell at
+coordinates [x,y] in this world.
+
+
(defn get-neighbours
+    ([world x y depth]
+      (remove nil?
+             (map #(get-cell world (first %) (first (rest %)))
+                  (remove #(= % (list x y))
+                          (combo/cartesian-product
+                            (range (- x depth) (+ x depth 1))
+                            (range (- y depth) (+ y depth 1)))))))
+    ([world cell depth]
+      (memo-get-neighbours world (:x cell) (:y cell) depth))
+    ([world cell]
+      (get-neighbours world cell 1)))

Get the neighbours to distance depth of the cell at x, y in this world which + have this value for this property.

+ +
* `world` a world, as described in `world.clj`;
+* `cell` a cell within that world;
+* `depth` an integer representing the distance from [x,y] that
+  should be searched (optional);
+* `property` a keyword representing a property of the neighbours;
+* `value` a value of that property (or, possibly, the name of another);
+* `op` a comparator function to use in place of `=` (optional).
+
+ +

It gets messy.

+
(defn get-neighbours-with-property-value
+  ([world x y depth property value op]
+    (filter
+      #(eval
+         (list op
+               (or (get % property) (get-int % property))
+               value))
+      (get-neighbours world x y depth)))
+  ([world x y depth property value]
+    (get-neighbours-with-property-value world x y depth property value =))
+  ([world cell depth property value]
+    (get-neighbours-with-property-value world (:x cell) (:y cell) depth
+                                        property value))
+  ([world cell property value]
+    (get-neighbours-with-property-value world cell 1
+                                        property value)))

Get the neighbours to distance depth of the cell at x, y in this world which + have this state.

+ +
* `world` a world, as described in `world.clj`;
+* `cell` a cell within that world;
+* `depth` an integer representing the distance from [x,y] that
+  should be searched;
+* `state` a keyword representing a state in the world.
+
+
(defn get-neighbours-with-state
+  ([world x y depth state]
+    (filter #(= (:state %) state) (get-neighbours world x y depth)))
+  ([world cell depth state]
+    (get-neighbours-with-state world (:x cell) (:y cell) depth state))
+  ([world cell state]
+    (get-neighbours-with-state world cell 1 state)))

Return the cell from among these cells which has the lowest numeric value + for this property; if the property is absent or not a number, use this + default

+
(defn get-least-cell
+  ([cells property default]
+  (cond
+   (empty? cells) nil
+   true (let [downstream (get-least-cell (rest cells) property default)]
+          (cond (<
+                 (or (property (first cells)) default)
+                 (or (property downstream) default)) (first cells)
+                true downstream))))
+  ([cells property]
+   (get-least-cell cells property (Integer/MAX_VALUE))))

If this cells x and y properties are equal to these x and y values, + return a cell like this cell but with the value of this property set to + this value. Otherwise, just return this cell.

+
(defn- set-cell-property
+  [cell x y property value]
+  (cond
+    (and (= x (:x cell)) (= y (:y cell)))
+    (merge cell {property value :rule "Set by user"})
+    true
+    cell))

Return a world like this world but with the value of exactly one property + of one cell changed to this value

+
(defn set-property
+  ([world cell property value]
+    (set-property world (:x cell) (:y cell) property value))
+  ([world x y property value]
+    (apply
+      vector ;; we want a vector of vectors, not a list of lists, for efficiency
+      (map
+        (fn [row]
+          (apply
+            vector
+            (map #(set-cell-property % x y property value)
+                 row)))
+        world))))

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

+
(defn merge-cell
+  [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))
 

mw-engine.world

toc

Functions to create and to print two dimensional cellular automata.

+
(ns ^{:doc 
+       :author "Simon Brooke"}
+  mw-engine.world
+	(:require [clojure.string :as string :only [join]]
+            [mw-engine.utils :refer [population]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version.

+ +

This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details.

+ +

You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +USA.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Functions to create and to print two dimensional cellular automata. +Nothing in this namespace should determine what states are possible within +the automaton, except for the initial state, :new.

+ +

A cell is a map containing at least values for the keys :x, :y, and :state.

+ +

A world is a two dimensional matrix (sequence of sequences) of cells, such +that every cell's :x and :y properties reflect its place in the matrix.

+

Create a minimal default cell at x, y

+ +
    +
  • x the x coordinate at which this cell is created;
    • +
  • y the y coordinate at which this cell is created.
    • +
+
(defn- make-cell
+  [x y]
+  {:x x :y y :state :new})

Make the (remaining) cells in a row at this height in a world of this width.

+ +
    +
  • index x coordinate of the next cell to be created;
    • +
  • width total width of the matrix, in cells;
    • +
  • height y coordinate of the next cell to be created.
    • +
+
(defn- make-world-row
+  [index width height]
+  (cond (= index width) nil
+    true (cons (make-cell index height)
+               (make-world-row (inc index) width height))))

Make the (remaining) rows in a world of this width and height, from this + index.

+ +
    +
  • index y coordinate of the next row to be created;
    • +
  • width total width of the matrix, in cells;
    • +
  • height total height of the matrix, in cells.
    • +
+
(defn- make-world-rows
+  [index width height]
+  (cond (= index height) nil
+    true (cons (apply vector (make-world-row 0 width index))
+               (make-world-rows (inc index) width height))))

Make a world width cells from east to west, and height cells from north to + south.

+ +
    +
  • width a natural number representing the width of the matrix to be created;
    • +
  • height a natural number representing the height of the matrix to be created.
    • +
+
(defn make-world
+  [width height]
+  (apply vector (make-world-rows 0 width height)))

Truncate the print name of the state of this cell to at most limit characters.

+
(defn truncate-state
+  [cell limit]
+  (let [s (:state cell)]
+    (cond (> (count (str s)) limit) (subs s 0 limit)
+      true s)))

Return a formatted string summarising the current state of this cell.

+
(defn format-cell
+  [cell]
+  (format "%10s(%2d/%2d)"
+          (truncate-state cell 10)
+          (population cell :deer)
+          (population cell :wolves)))

Format one row in the state of a world for printing.

+
(defn- format-world-row
+  [row]
+  (string/join (map format-cell row)))

Print the current state of this world, and return nil.

+ +
    +
  • world a world as defined above.
    • +
+
(defn print-world
+  [world]
+  (println)
+  (dorun
+    (map
+      #(println
+         (format-world-row %))
+      world))
+  nil)
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
\ No newline at end of file diff --git a/project.clj b/project.clj index 70cfad8..383341f 100644 --- a/project.clj +++ b/project.clj @@ -12,10 +12,11 @@ :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.6.0"] + :dependencies [[org.clojure/clojure "1.8.0"] [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] [org.clojure/tools.namespace "0.2.4"] + [com.taoensso/timbre "4.10.0"] + [fivetonine/collage "0.2.0"] [hiccup "1.0.5"] - [net.mikera/imagez "0.3.1"] - [fivetonine/collage "0.2.0"]]) + [net.mikera/imagez "0.3.1"]]) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 83c1a2e..8b5062e 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -2,8 +2,11 @@ :author "Simon Brooke"} mw-engine.core (:require [clojure.core.reducers :as r] + [clojure.string :refer [join]] + [clojure.tools.cli :refer [parse-opts]] [mw-engine.world :as world] - [mw-engine.utils :refer [get-int-or-zero map-world]]) + [mw-engine.utils :refer [get-int-or-zero map-world]] + [taoensso.timbre :as l]) (:gen-class)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -123,9 +126,11 @@ Return the final generation of the world." [world init-rules rules generations] - (reduce (fn [world _iteration] + (reduce (fn [world iteration] + (l/info "Running iteration " iteration) (transform-world world rules)) (transform-world world init-rules) (range generations))) + diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj index 7dca8ff..8cddd11 100644 --- a/src/mw_engine/display.clj +++ b/src/mw_engine/display.clj @@ -28,6 +28,10 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ^:dynamic *image-base* + "Base url (i.e., url of directory) from which to load tile images." + "img/tiles") + (defn format-css-class [state] "Format this `state`, assumed to be a keyword indicating a state in the world, into a CSS class" @@ -38,7 +42,7 @@ "Render this `state`, assumed to be a keyword indicating a state in the world, into a path which should recover the corresponding image file." [state] - (format "img/tiles/%s.png" (format-css-class state))) + (format "%s/%s.png" *image-base* (format-css-class state))) (defn format-mouseover [cell] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 87a7207..603bf89 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -38,11 +38,54 @@ ;; forward declaration of flow, to allow for a wee bit of mutual recursion. (declare flow) +(defn rainfall + "Compute rainfall for a cell with this `gradient` west-east, given + `remaining` drops to distribute, and this overall map width." + [gradient remaining map-width] + (cond + ;; if there's no rain left in the cloud, it can't fall; + (zero? remaining) + 0 + (pos? gradient) + ;; rain, on prevailing westerly wind, falls preferentially on rising ground; + (int (rand gradient)) + ;; rain falls randomly across the width of the map... + (zero? (int (rand map-width))) 1 + :else + 0)) + +(defn rain-row + "Return a row like this `row`, across which rainfall has been distributed; + if `rain-probability` is specified, it is the probable rainfall on a cell + with no gradient." + ([row] + (rain-row row 1)) + ([row rain-probability] + (rain-row row (count row) 0 (int (* (count row) rain-probability)))) + ([row map-width previous-altitude drops-in-cloud] + (cond + (empty? row) nil + (pos? drops-in-cloud) + (let [cell (first row) + alt (or (:altitude cell) 0) + rising (- alt previous-altitude) + fall (rainfall rising drops-in-cloud map-width)] + (cons + (assoc cell :rainfall fall) + (rain-row (rest row) map-width alt (- drops-in-cloud fall)))) + :else + (map + #(assoc % :rainfall 0) + row)))) + + (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" [world] - (map-world world (fn [world cell] (merge cell {:rainfall 1})))) + (map + rain-row + world)) (defn flow-contributors @@ -143,6 +186,29 @@ [world] (map-world (rain-world world) flow)) +(defn explore-lake + "Return a sequence of cells starting with this `cell` in this `world` which + form a contiguous lake" + [world cell] + ) + +(defn is-lake? + "If this `cell` in this `world` is not part of a lake, return nil. If it is, + return a cell like this `cell` tagged as part of a lake." + [world cell] + (if + ;; if it's already tagged as a lake, it's a lake + (:lake cell) cell + (let + [outflow (min (map :altitude (get-neighbours world cell)))] + (if-not + (> (:altitude cell) outflow) + (assoc cell :lake true))))) + + +(defn find-lakes + [world] + ) (defn run-drainage [hmap] diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index af4a124..86de92b 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -1,8 +1,8 @@ (ns ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem." :author "Simon Brooke"} mw-engine.natural-rules - (:require mw-engine.utils - mw-engine.world)) + (:require [mw-engine.utils :refer :all] + [mw-engine.world :refer :all])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; From 1cb613e6e66b5af18e1cf03d83ee1db86912f985 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 6 Jun 2020 12:21:54 +0100 Subject: [PATCH 9/9] #2: Minor preparatory changes. --- src/mw_engine/core.clj | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 8b5062e..866087d 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -3,11 +3,9 @@ mw-engine.core (:require [clojure.core.reducers :as r] [clojure.string :refer [join]] - [clojure.tools.cli :refer [parse-opts]] [mw-engine.world :as world] [mw-engine.utils :refer [get-int-or-zero map-world]] - [taoensso.timbre :as l]) - (:gen-class)) + [taoensso.timbre :as l])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;