From 1300e8d103a51f78c7c67456673baaa84e3199db Mon Sep 17 00:00:00 2001 From: simon Date: Thu, 31 Jul 2014 23:43:02 +0100 Subject: [PATCH] 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 | 69 ++++++++++++++++++++++++++----------- src/mw_engine/drainage.clj | 42 ++++++++++++++++++++++ src/mw_engine/heightmap.clj | 23 ++++--------- src/mw_engine/utils.clj | 58 ++++++++++++++++++++++--------- 4 files changed, 140 insertions(+), 52 deletions(-) create mode 100644 src/mw_engine/drainage.clj diff --git a/buildall.sh b/buildall.sh index a68de45..09cbba8 100755 --- a/buildall.sh +++ b/buildall.sh @@ -8,15 +8,18 @@ # Simon Broooke +# 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 + + diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj new file mode 100644 index 0000000..c9d5874 --- /dev/null +++ b/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)) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index da13bd4..be99c2e 100644 --- a/src/mw_engine/heightmap.clj +++ b/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 world tag-altitude (list heightmap)) + (map-world + (map-world world tag-altitude (list heightmap)) tag-gradient)))) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index a63422d..94ef499 100644 --- a/src/mw_engine/utils.clj +++ b/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 - (map #(apply function (cons world (cons % additional-args))) + (apply vector + (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 - #(eval - (list op - (or (get % property) (get-int % property)) - value)) + (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 + (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]