simon/mw-engine
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

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

Browse source 
some functions from heightmap into utils; added a -archive option to
buildall as first step towards auto-building a Debian package for
Raspberry Pi.
This commit is contained in:
simon 2014-07-31 23:43:02 +01:00
parent b3b7f8a475
commit 1300e8d103
4 changed files with 140 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
buildall.sh
View file

@ -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

42
src/mw_engine/drainage.clj Normal file
View file

@ -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))

23
src/mw_engine/heightmap.clj
View file

@ -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))))

58
src/mw_engine/utils.clj
View file

@ -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]