A great deal of change, mainly tidy-up and documentation, but also

added reading heightmaps.

project.clj

@@ -3,5 +3,8 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :plugins [[lein-marginalia "0.7.1"]]
   :dependencies [[org.clojure/clojure "1.5.1"]
-                 [org.clojure/math.combinatorics "0.0.7"]])
+                 [org.clojure/math.combinatorics "0.0.7"]
+                 [net.mikera/imagez "0.3.1"]
+                 [fivetonine/collage "0.2.0"]])

src/mw_engine/core.clj

@@ -1,23 +1,34 @@
+;; Functions to transform a world and run rules.
+
 (ns mw-engine.core
   (:require [mw-engine.world :as world]
         mw-engine.natural-rules
         mw-engine.utils))
 
-;; every rule is a function of two arguments, a cell and a world. If the rule
+;; 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.
 ;;
+;; 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`.
+;;
 ;; Rules are applied in turn until one matches.
 
-(defn transform-cell 
+(defn- transform-cell
   "Derive a cell from this cell of this world by applying these rules."
   [cell world rules]
   (cond (empty? rules) cell
-    true (let [r (apply (eval (first rules)) (list cell world))]
+    true (let [result (apply (eval (first rules)) (list cell world))]
-           (cond r r
+           (cond result result
              true (transform-cell cell world (rest rules))))))
 
-(defn transform-world-row 
+(defn- transform-world-row
   "Return a row derived from this row of this world by applying these rules to each cell."
   [row world rules]
   (map #(transform-cell % world rules) row))
@@ -29,24 +40,37 @@
     #(transform-world-row % world rules)
     world))
 
-(defn transform-world-state 
+(defn- transform-world-state
-  "Consider this single argument as a list of world and rules; apply the rules
+  "Consider this single argument as a map of `:world` and `:rules`; apply the rules
-   to transform the world, and return a list of the new, transformed world and
+   to transform the world, and return a map of the new, transformed `:world` and
-   these rules. As a side effect, print the world."
+   these `:rules`. As a side effect, print the world."
   [state]
-  (list
+  (let [world (transform-world (:world state) (:rules state))]
-    (world/print-world (transform-world (first state) (first (rest state))))
+    (world/print-world world)
-    (first (rest state))))
+    {:world world :rules (:rules state)}))
+
 
 (defn run-world
-  "Run this world with these rules for this number of generations."
+  "Run this world with these rules for this number of generations.
-  [world rules generations]
+
-  (let [state (list world rules)]
+  * `world` a world as discussed above;
-    (take generations (iterate transform-world-state state))))
+  * `init-rules` a sequence of rules as defined above, to be run once to initialise the world;
+  * `rules` a sequence of rules as definied above, to be run iteratively for each generation;
+  * `generations` an (integer) number of generations."
+  [world init-rules rules generations]
+  (let [state {:world (transform-world world init-rules) :rules rules}]
+    (dorun (take generations (iterate transform-world-state state)))))
 
 (defn animate-world
-  [world rules generations]
+  "Run this world with these rules for this number of generations, and return nil
-  (let [state (list world rules)]
+  to avoid cluttering the screen. Principally for debugging.
+
+  * `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 definied above, to be run iteratively for each generation;
+  * `generations` an (integer) number of generations."
+  [world init-rules rules generations]
+  (let [state (list (transform-world world init-rules) rules)]
     (dorun
       (take generations (iterate transform-world-state state)))
-    nil))
+    world))

src/mw_engine/heightmap.clj

@@ -0,0 +1,46 @@
+;; Functions to apply a heightmap to a world.
+;;
+;; 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
+        ;; interestingly the imagez load-image is failing for me, while the
+        ;; collage version is problem free.
+        [mikera.image.core :only [filter-image get-pixels]]
+        [mikera.image.filters]
+        [fivetonine.collage.util]
+        ))
+
+(defn- abs [int]
+  (cond (< int 0) (- 0 int) true int))
+
+(defn transform-altitude
+  [cell heightmap]
+  (merge cell
+         {:altitude
+          (+ (get-int cell :altitude)
+           (- 256
+              (abs
+               (mod
+                (.getRGB heightmap
+                         (get-int cell :x)
+                         (get-int cell :y)) 256))))}))
+
+(defn- apply-heightmap-row
+  [row heightmap]
+  (apply vector (map #(transform-altitude %1 heightmap) row)))
+
+(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
+  the heightmap is at least as large in x and y dimensions as the world, and actually will
+  work correctly only if they are of the same x and y dimensions.
+
+  * `world` a world, as defined in `world.clj`;
+  * `imagepath` a file path or URL which indicates an image file."
+  [world imagepath]
+  ;; bizarrely, the collage load-util is working for me, but the imagez version isn't.
+  (let [heightmap (filter-image (grayscale)(load-image imagepath))]
+    (apply vector (map #(apply-heightmap-row %1 heightmap) world))))

src/mw_engine/natural_rules.clj

@@ -1,34 +1,43 @@
+;; A set of MicroWorld rules describing a simplified natural ecosystem.
+
 (ns mw-engine.natural-rules
   (:use mw-engine.utils
         mw-engine.world))
 
-;; rules describing the natural ecosystem
+;; treeline at arbitrary altitude.
+(def treeline 100)
 
-(def treeline 10)
+;; waterline also at arbitrary altitude.
+(def waterline 10)
 
-;; one in fifty chance of lightning strike
+;; and finally snowline is also arbitrary.
-(def lightning-probability 50)
+(def snowline 200)
+
+;; Rare chance of lightning strikes
+(def lightning-probability 500)
+
+;; rules which initialise the world
 
 ;; rules describing vegetation
 (def vegetation-rules
   (list
-    ;; Randomly, birds plant tree seeds into pasture.
+    ;; Randomly, birds plant tree seeds into grassland.
-    (fn [cell world] (cond (and (= (:state cell) :pasture)(< (rand 10) 1))(merge cell {:state :scrub})))
+    (fn [cell world] (cond (and (= (:state cell) :grassland)(< (rand 10) 1))(merge cell {:state :heath})))
-    ;; Scrub below the treeline grows gradually into forest, providing browsing pressure is not to high
+    ;; heath below the treeline grows gradually into forest, providing browsing pressure is not to high
     (fn [cell world]
       (cond (and
-              (= (:state cell) :scrub)
+              (= (:state cell) :heath)
               ;; browsing limit really ought to vary with soil fertility, but...
-              (< (+ (population cell :deer)(or (:sheep cell) 0)) 6)
+              (< (+ (population cell :deer)(population cell :sheep)) 6)
-              (< (:altitude cell) treeline))
+              (< (get-int cell :altitude) treeline))
-        (merge cell {:state :scrub2})))
+        (merge cell {:state :scrub})))
-    (fn [cell world] (cond (= (:state cell) :scrub2) (merge cell {:state :forest})))
+    (fn [cell world] (cond (= (:state cell) :scrub) (merge cell {:state :forest})))
-    ;; Forest on fertile land at low altitude grows to climax
+    ;; Forest on fertile land grows to climax
     (fn [cell world]
       (cond
         (and
           (= (:state cell) :forest)
-          (> (:fertility cell) 10))
+          (> (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})))
@@ -42,7 +51,7 @@
     ;; 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 scrub, otherwise grassland.
+    ;; source, it's going to be heath, otherwise grassland.
     (fn [cell world]
       (cond
         (and (= (:state cell) :waste)
@@ -50,17 +59,17 @@
                (empty?
                  (flatten
                    (list
-                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub2)
+                     (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 :scrub})))
+        (merge cell {:state :heath})))
     (fn [cell world]
       (cond (= (:state cell) :waste)
-        (merge cell {:state :pasture})))
+        (merge cell {:state :grassland})))
     ;; Forest increases soil fertility
     (fn [cell world]
       (cond (member? (:state cell) '(:forest :climax))
-        (merge cell {:fertility (+ (:fertility cell) 1)})))
+        (merge cell {:fertility (+ (get-int cell :fertility) 1)})))
   ))
 
 ;; rules describing herbivore behaviour
@@ -75,8 +84,8 @@
     ;; if there are too many deer for the fertility of the area to sustain,
     ;; some die or move on.
     (fn [cell world]
-      (cond (> (* (population cell :deer) 10) (:fertility cell))
+      (cond (> (* (population cell :deer) 10) (get-int cell :fertility))
-        (merge cell {:deer (int (/ (:fertility cell) 10))})))
+        (merge cell {:deer (int (/ (get-int cell :fertility) 10))})))
     ;; deer gradually spread through the world by breeding or migrating.
     (fn [cell world]
       (let [n (apply + (map #(population % :deer) (get-neighbours world cell)))]
@@ -121,4 +130,22 @@
       (merge cell {:deer (- (population cell :deer) (population cell :wolves))}))
     ))
 
-(def natural-rules (flatten (list vegetation-rules herbivore-rules predator-rules)))
+  ;; 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 :waste}))
+     )))
+
+(def natural-rules (flatten
+                    (list
+                     vegetation-rules
+                     herbivore-rules
+                     predator-rules
+                     )))

src/mw_engine/utils.clj

@@ -1,11 +1,65 @@
-(ns mw-engine.utils)
+;; Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule.
+
+(ns mw-engine.utils
+  (:require [clojure.math.combinatorics :as combo]))
 
 (defn member?
   "True if elt is a member of col."
   [elt col] (some #(= elt %) col))
 
-(defn population [cell species]
+(defn in-bounds
+  "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."
+  [world x y]
+  (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
+
+(defn get-cell
+  "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."
+  [world x y]
+  (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."
+  [map key]
+  (let [v (map key)]
+    (cond (integer? v) v
+          true 0)))
+
+(defn population
   "Return the population of this species in this cell.
-   Species is assumed to be a keyword whose value in a cell should be an
+
-   integer."
+  * `cell` a map;
-  (or (get cell species) 0))
+  * `species` a keyword representing a species which may populate that cell."
+  [cell species]
+  (get-int cell species))
+
+
+(defn get-neighbours
+  ([world x y depth]
+    "Get the neighbours to distance depth of the cell at x, y in this world."
+    (map #(get-cell world (first %) (first (rest %)))
+       (remove #(= % (list x y))
+               (combo/cartesian-product
+                 (range (- x depth) (+ x depth))
+                 (range (- y depth) (+ y depth))))))
+  ([world cell depth]
+    "Get the neighbours to distance depth of this cell in this world."
+    (get-neighbours world (:x cell) (:y cell) depth))
+  ([world cell]
+    "Get the immediate neighbours of this cell in this world"
+    (get-neighbours world cell 1)))
+
+(defn get-neighbours-with-state
+  "Get the neighbours to distance depth of the cell at x, y in this world which
+   have this state."
+  [world x y depth state]
+  (filter #(= (:state %) state) (get-neighbours world x y depth)))

src/mw_engine/world.clj

@@ -1,65 +1,54 @@
+;; 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.
+
 (ns mw-engine.world
-  (:use mw-engine.utils)
+  (:use mw-engine.utils))
-  (:require [clojure.math.combinatorics :as combo]))
 
-(defn make-cell 
+(defn- make-cell
-  "Create a default cell at x, y"
+  "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."
   [x y]
-  {:x x :y y :altitude 1 :state :waste :fertility 1})
+  {:x x :y y :state :new})
 
-(defn make-world-row 
+(defn- make-world-row
-  "Make the (remaining) cells in a row at this height in a world of this width."
+  "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."
   [index width height]
   (cond (= index width) nil
     true (cons (make-cell index height)
                (make-world-row (+ index 1) width height))))
 
-(defn make-world-rows [index width height]
+(defn- make-world-rows [index width height]
   "Make the (remaining) rows in a world of this width and height, from this
-   index."
+   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."
   (cond (= index height) nil
     true (cons (make-world-row 0 width index)
                (make-world-rows (+ index 1) width height))))
 
 (defn make-world
   "Make a world width cells from east to west, and height cells from north to
-   south."
+   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."
   [width height]
   (make-world-rows 0 width height))
 
-(defn in-bounds   
-  "True if x, y are in bounds for this world (i.e., there is a cell at x, y)
-   else false."
-  [world x y]
-  (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
-
-(defn get-cell 
-  "Return the cell a x, y in this world, if any."
-  [world x y]
-  (cond (in-bounds world x y)
-    (nth (nth world y) x)))
-
-(defn get-neighbours 
-  ([world x y depth]
-  "Get the neighbours to distance depth of the cell at x, y in this world."
-  (map #(get-cell world (first %) (first (rest %))) 
-       (combo/cartesian-product 
-         (range (- x depth) (+ x depth)) 
-         (range (- y depth) (+ y depth)))))
-  ([world cell depth]
-    "Get the neighbours to distance depth of this cell in this world."
-    (get-neighbours world (:x cell) (:y cell) depth))
-  ([world cell]
-    "Get the immediate neighbours of this cell in this world"
-    (get-neighbours world cell 1)))
-  
-
-(defn get-neighbours-with-state 
-  "Get the neighbours to distance depth of the cell at x, y in this world which
-   have this state."
-  [world x y depth state]
-  (filter #(= (:state %) state) (get-neighbours world x y depth)))
-
 (defn truncate-state
   "Truncate the print name of the state of this cell to at most limit characters."
   [cell limit]
@@ -75,14 +64,16 @@
           (population cell :deer)
           (population cell :wolves)))
 
-(defn format-world-row
+(defn- format-world-row
-  "Format one row in the state of a world for printing"
+  "Format one row in the state of a world for printing."
   [row]
   (apply str
          (map format-cell row)))
 
 (defn print-world
-  "Print the current state of this world, and return nil"
+  "Print the current state of this world, and return nil.
+
+  * `world` a world as defined above."
   [world]
   (println)
   (dorun
@@ -90,4 +81,4 @@
       #(println
          (format-world-row %))
       world))
-  world)
+  nil)