Added a new file drainage.clj which attempts to model rivers; moved

some functions from heightmap into utils; added a -archive option to
buildall as first step towards auto-building a Debian package for
Raspberry Pi.

buildall.sh

@@ -8,15 +8,18 @@
 
 # Simon Broooke <simon@jasmine.org.uk>
 
+# Variable and glag initialisation
+archive=FALSE
 email=`grep ${USER} /etc/passwd | awk -F\: '{print $5}' | awk -F\, '{print $4}'`
 fullname=`grep ${USER} /etc/passwd | awk -F\: '{print $5}' | awk -F\, '{print $1}'`
-webappsdir="/var/lib/tomcat7/webapps"
+old="unset"
 release=""
-trial="FALSE"
 tmp=buildall.tmp.$$
+trial="FALSE"
+webappsdir="/var/lib/tomcat7/webapps"
 
 # Builds the build signature properties in the manifest map file
-# expected arguments: old version tag, version tag, full name of user, 
+# expected arguments: old version tag, version tag, full name of user,
 # email of user; if not passed, all these will be set to "unset".
 # The objective I'm trying to achieve is that when committed to version
 # control, these are all always unset; but they're all valid in a build.
@@ -25,25 +28,25 @@ function setup-build-sig {
 	then
 		o="unset"
 	else
-		o="${1}" 
+		o="${1}"
 	fi
 	if [ "${2}" = "" ]
 	then
 		v="unset"
 	else
-		v="${2}" 
+		v="${2}"
 	fi
 	if [ "${3}" = "" ]
 	then
 		u="unset"
 	else
-		u="${3}" 
+		u="${3}"
 	fi
 	if [ "${4}" = "" ]
 	then
 		e="unset"
 	else
-		e="${4}" 
+		e="${4}"
 	fi
 
 	if [ "${2}${3}${4}" = "" ]
@@ -69,10 +72,11 @@ 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.
 	  -email [ADDRESS]   Your email address, to be recorded in the build signature.
 	  -fullname [NAME]   Your full name, to be recorded in the build signature.
-	  -release [LABEL]   Build all components, branch for release on old label, then 
+	  -release [LABEL]   Build all components, branch for release on old label, then
 	                     upversion to new LABEL and commit to master.
 	  -trial             Trial build only, do not commit.
 	  -webapps [PATH]    Set the path to the local tomcat webapps directory
@@ -82,17 +86,19 @@ fi
 while (( "$#" ))
 do
 	case $1 in
-		-b|-build) 
+    -a|-archive)
+      archive="TRUE";;
+		-b|-build)
 			# 'build' is the expected normal case.
 			trial="FALSE";
-			;; 
+			;;
 		-e|-email)
 			shift;
 			email=$1;;
 		-f|-fullname)
 			shift;
 			fullname=$1;;
-		-r|-release) 
+		-r|-release)
 			# release is branch a release and upversion to new label
 			shift;
 			release=$1;
@@ -144,10 +150,10 @@ do
 		message="Preparing ${old} for release"
 
 		# Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does!
-		echo "${old}" | grep 'SNAPSHOT' 
+		echo "${old}" | grep 'SNAPSHOT'
 		if [ $? -eq 0 ]
 		then
-			# It does... 
+			# It does...
 			interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'`
 			if [ "${interim}" = "" ]
 			then
@@ -161,9 +167,9 @@ do
 			setup-build-sig "unset" "${old}" "${fullname}" "${email}"
 		fi
 	else
-		setup-build-sig "unset" "${old}" "${fullname}" "${email}"	
+		setup-build-sig "unset" "${old}" "${fullname}" "${email}"
 	fi
-			
+
 	sed -f ${tmp}/manifest.sed ${tmp}/project.bak.1 > project.clj
 
 	echo $message
@@ -185,8 +191,8 @@ do
 
 	lein marg
 	lein install
-	
+
-	# If we're in the UI project, build the uberwar - and should 
+	# 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
@@ -219,7 +225,7 @@ do
 			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
@@ -236,12 +242,12 @@ do
 		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}"
@@ -256,3 +262,26 @@ do
 done
 
 
+if [ "${archive}" ]
+then
+  for dir in mw-*
+  do
+    pushd ${dir}
+    version=`cat project.clj | grep 'defproject mw' | sed 's/.*defproject mw-[a-z]* "\([A-Za-z0-9_.-]*\)".*/\1/'`
+    lein clean
+    popd
+  done
+
+  tmp=microworld-${version}
+  mkdir ${tmp}
+  pushd ${tmp}
+  for dir in ../mw-*
+  do
+    cp -r $dir .
+  done
+  popd
+  tar czvf ${tmp}.orig.tar.gz ${tmp}
+  rm -rf ${tmp}
+fi
+
+

src/mw_engine/drainage.clj

@@ -0,0 +1,42 @@
+;; 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 mw-engine.drainage
+  (:use mw-engine.utils
+        mw-engine.world))
+
+(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}))))
+
+(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"
+  [world cell]
+  (remove nil?
+          (map
+           (fn [n]
+             (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n))
+           (get-neighbours-with-property-value world (:x cell) (:y cell) 1
+                                                                  :altitude
+                                                                  (or (:altitude cell) 0) >))))
+
+(defn 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.
+
+   Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
+   [world cell]
+      (merge cell
+           {:flow (+ (:rainfall cell)
+               (apply +
+                 (map (fn [neighbour] (:flow (flow world neighbour)))
+                      (flow-contributors world cell))))}))
+
+(defn flow-world
+  "Return a world like this `world`, but with cells tagged with the amount of
+   water flowing through them."
+  [world]
+  (map-world (rain-world world) flow))

src/mw_engine/heightmap.clj

@@ -6,21 +6,12 @@
 (ns mw-engine.heightmap
   (:import [java.awt.image BufferedImage])
   (:use mw-engine.utils
-        mw-engine.world)
+        mw-engine.world
+        mw-engine.drainage)
   (: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- 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,
-   and negative integers onto natural numbers. Also maps negative real numbers
-   onto positive real numbers.
-
-   * `n` a number, on the set of real numbers."
-  [n]
-  (cond (< n 0) (- 0 n) true n))
-
 (defn tag-gradient
   "Set the `gradient` property of this `cell` of this `world` to the difference in
    altitude between its highest and lowest neghbours."
@@ -33,7 +24,7 @@
         gradient (- highest lowest)]
     (merge cell {:gradient gradient})))
 
-(defn tag-gradients 
+(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]
@@ -70,17 +61,17 @@
     a world the size of the heightmap will be created.
   * `imagepath` a file path or URL which indicates an image file."
   ([world imagepath]
-    (let [heightmap (imagez/filter-image 
+    (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 
+    (let [heightmap (imagez/filter-image
                       (filters/grayscale)
                       (collage/load-image imagepath))
           world (make-world (.getWidth heightmap) (.getHeight heightmap))]
-      (map-world 
+      (map-world
-        (map-world world tag-altitude (list heightmap)) 
+        (map-world world tag-altitude (list heightmap))
         tag-gradient))))

src/mw_engine/utils.clj

@@ -3,6 +3,16 @@
 (ns mw-engine.utils
   (:require [clojure.math.combinatorics :as combo]))
 
+(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,
+   and negative integers onto natural numbers. Also maps negative real numbers
+   onto positive real numbers.
+
+   * `n` a number, on the set of real numbers."
+  [n]
+  (cond (< n 0) (- 0 n) true n))
+
 (defn member?
   "True if elt is a member of col."
   [elt col] (some #(= elt %) col))
@@ -17,17 +27,17 @@
   [world x y]
   (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
 
-(defn map-world 
+(defn map-world
   "Apply this `function` to each cell in this `world` to produce a new world.
-   the arguments to the function will be the world, the cell, and any 
+   the arguments to the function will be the world, the cell, and any
    `additional-args` supplied"
   ([world function]
     (map-world world function nil))
   ([world function additional-args]
     (apply vector ;; vectors are more efficient for scanning, which we do a lot.
          (for [row world]
-           (apply vector 
+           (apply vector
-                  (map #(apply function (cons world (cons % additional-args))) 
+                  (map #(apply function (cons world (cons % additional-args)))
                        row))))))
 
 (defn get-cell
@@ -42,7 +52,7 @@
 
 (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` a map;
    * `key` a symbol or keyword, presumed to be a key into the `map`."
   [map key]
@@ -54,7 +64,7 @@
 
 (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 
+   `get-int`, but may not always be (depending whether species are later
    implemented as actors)
 
   * `cell` a map;
@@ -78,7 +88,7 @@
                            (combo/cartesian-product
                              (range (- x depth) (+ x depth 1))
                              (range (- y depth) (+ y depth 1)))))))
-    ([world cell depth] 
+    ([world cell depth]
       "Get the neighbours to distance depth of this cell in this world.
 
       * `world` a world, as described in world.clj;
@@ -107,19 +117,19 @@
 
    It gets messy."
   ([world x y depth property value op]
-    (filter 
+    (filter
-      #(eval 
+      #(eval
-         (list op 
+         (list op
-               (or (get % property) (get-int % property)) 
+               (or (get % property) (get-int % property))
-               value)) 
+               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 
+    (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 
+    (get-neighbours-with-property-value world cell 1
                                         property value)))
 
 (defn get-neighbours-with-state
@@ -138,12 +148,28 @@
   ([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
+  `default`"
+  ([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))))
+
+
 (defn- set-cell-property
   "If this `cell`s 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`."
   [cell x y property value]
-  (cond 
+  (cond
     (and (= x (:x cell)) (= y (:y cell)))
     (merge cell {property value :rule "Set by user"})
     true
@@ -155,7 +181,7 @@
   ([world cell property value]
     (set-property world (:x cell) (:y cell) property value))
   ([world x y property value]
-    (apply 
+    (apply
       vector ;; we want a vector of vectors, not a list of lists, for efficiency
       (map
         (fn [row]