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

Compare commits

merge into: simon:master
Branches Tags
simon:master
simon:develop
simon:feature/2
simon:0.1.6_MAINTENANCE
simon:0.1.5_MAINTENANCE
simon:feature/1
simon:0.1.3_MAINTENANCE
...
pull from: simon:0.1.6_MAINTENANCE
Branches Tags
simon:develop
simon:feature/2
simon:0.1.6_MAINTENANCE
simon:0.1.5_MAINTENANCE
simon:feature/1
simon:master
simon:0.1.3_MAINTENANCE

10 commits
master ... 0.1.6_MAIN

Author SHA1 Message Date
Simon Brooke 0ad32c66ef Preparing 0.1.6 for release 2017-12-04 18:05:23 +00:00
Simon Brooke 4a0c10fb7a small fixes arising out of lein ancient changes 2017-12-04 17:09:41 +00:00
Simon Brooke 581a9d97cd Ran lein ancient and upversioned all dependencies; fixed failing tests. 2017-12-04 13:45:55 +00:00
simon 519ca4e3bd Upversioned from 0.1.5 to 0.1.6-SNAPSHOT 2016-12-27 16:18:38 +00:00
simon 3ca247e471 Upversioned from 0.1.5-SNAPSHOT to 0.1.5 for release 2016-12-27 16:18:10 +00:00
simon 47caea3eb8 Don't do anything with mw-explore during buildall - it contains unreliable junk. 2016-12-27 15:44:57 +00:00
simon 39b7cd608c Added Docker stuff; corrected usage message. 2016-12-27 15:22:41 +00:00
simon f1b35dc948 Standardised header documentation in line with current best practice. 2016-08-21 14:17:30 +01:00
simon 944b54fc89 Deleted version.clj, which did not work anyway. 2016-08-13 17:41:53 +01:00
simon 21cdff764f 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.
 2016-08-13 17:39:07 +01:00
11 changed files with 471 additions and 250 deletions
Show stats Expand all files Collapse all files

251
buildall.sh
View file

@ -16,7 +16,8 @@ old="unset"
release="" release=""
tmp=buildall.tmp.$$ tmp=buildall.tmp.$$
trial="FALSE" trial="FALSE"
webappsdir="/var/lib/tomcat7/webapps" webappsdir="/var/lib/tomcat8/webapps"
gitremote="origin"
# Builds the build signature properties in the manifest map file # 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,
@ -72,11 +73,13 @@ if [ $# -lt 1 ]
then then
cat <<-EOF 1>&2 cat <<-EOF 1>&2
Usage: Usage:
-archive Create a tar archive of the current state of the source. -archive Create a tar archive of the current state of the source.
-build Build all components and commit to master. -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. -email [ADDRESS] Your email address, to be recorded in the build signature.
-fullname [NAME] Your full name, 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 -git-remote [NAME] Use the specified git remote
-pull Pull from remote git repository
-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. upversion to new LABEL and commit to master.
-trial Trial build only, do not commit. -trial Trial build only, do not commit.
@ -87,21 +90,26 @@ fi
while (( "$#" )) while (( "$#" ))
do do
case $1 in case $1 in
-a|-archive) -a|-archive)
archive="TRUE";; archive="TRUE";;
-b|-build) -b|-build)
# 'build' is the expected normal case. # 'build' is the expected normal case.
trial="FALSE"; trial="FALSE";
;; ;;
-d|-docker)
docker="TRUE";;
-e|-email) -e|-email)
shift; shift;
email=$1;; email=$1;;
-f|-fullname) -f|-fullname)
shift; shift;
fullname=$1;; fullname=$1;;
-p|-pull) -p|-pull)
# pull from remote Git origin # pull from remote Git origin
git pull origin master;; git pull ${gitremote} master;;
-g|-git-remote)
shift;
gitremote=$1;;
-r|-release) -r|-release)
# release is branch a release and upversion to new label # release is branch a release and upversion to new label
shift; shift;
@ -126,7 +134,7 @@ do
shift shift
done 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 ls mw-* > /dev/null 2>&1
if [ $? -ne 0 ] if [ $? -ne 0 ]
@ -137,132 +145,141 @@ fi
for dir in mw-* for dir in mw-*
do do
pushd ${dir} if [ "${dir}" != "mw-explore" ]
then
pushd ${dir}
# Make a temporary directory to keep the work-in-progress files. # Make a temporary directory to keep the work-in-progress files.
if [ ! -d "${tmp}" ] if [ ! -d "${tmp}" ]
then then
rm -f "${tmp}" rm -f "${tmp}"
mkdir "${tmp}" mkdir "${tmp}"
fi fi
cat project.clj > ${tmp}/project.bak.1 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/'` old=`cat project.clj | grep 'defproject mw' | sed 's/.*defproject mw-[a-z]* "\([A-Za-z0-9_.-]*\)".*/\1/'`
if [ "${release}" != "" ] if [ "${release}" != "" ]
then then
message="Preparing ${old} for release" message="Preparing ${old} for release"
# Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does! # Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does!
echo "${old}" | grep 'SNAPSHOT' echo "${old}" | grep 'SNAPSHOT'
if [ $? -eq 0 ] if [ $? -eq 0 ]
then then
# It does... # It does...
interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'` interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'`
if [ "${interim}" = "" ] if [ "${interim}" = "" ]
then then
echo "Failed to compute interim version tag from '${old}'" 1>&2 echo "Failed to compute interim version tag from '${old}'" 1>&2
exit 1; exit 1;
fi fi
setup-build-sig "${old}" "${interim}" "${fullname}" "${email}" setup-build-sig "${old}" "${interim}" "${fullname}" "${email}"
message="Upversioned from ${old} to ${interim} for release" message="Upversioned from ${old} to ${interim} for release"
old=${interim} old=${interim}
else else
setup-build-sig "unset" "${old}" "${fullname}" "${email}" setup-build-sig "unset" "${old}" "${fullname}" "${email}"
fi fi
else else
setup-build-sig "unset" "${old}" "${fullname}" "${email}" setup-build-sig "unset" "${old}" "${fullname}" "${email}"
fi fi
sed -f ${tmp}/manifest.sed ${tmp}/project.bak.1 > project.clj sed -f ${tmp}/manifest.sed ${tmp}/project.bak.1 > project.clj
echo $message echo $message
lein clean lein clean
lein compile lein compile
if [ $? -ne 0 ] if [ $? -ne 0 ]
then then
echo "Sub-project ${dir} failed in compile" 1>&2 echo "Sub-project ${dir} failed in compile" 1>&2
exit 1 exit 1
fi fi
lein test lein test
if [ $? -ne 0 ] if [ $? -ne 0 ]
then then
echo "Sub-project ${dir} failed in test" 1>&2 echo "Sub-project ${dir} failed in test" 1>&2
exit 1 exit 1
fi fi
lein marg lein marg
lein install 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 # probably deploy it to local Tomcat for test
if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ] if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ]
then then
lein ring uberwar lein ring uberwar
sudo cp target/microworld.war "${webappsdir}" sudo cp target/microworld.war "${webappsdir}"
echo "Deployed new WAR file to local Tomcat at ${webappsdir}" echo "Deployed new WAR file to local Tomcat at ${webappsdir}"
fi fi
# Then unset manifest properties prior to committing. if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ]
cat project.clj > ${tmp}/project.bak.2 then
setup-build-sig lein docker build
sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj lein docker push
fi
if [ "${trial}" = "FALSE" ] # Then unset manifest properties prior to committing.
then cat project.clj > ${tmp}/project.bak.2
if [ "${message}" = "" ] setup-build-sig
then sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj
git commit -a
else
git commit -a -m "$message"
fi
git push origin master
fi
if [ "${release}" != "" ] if [ "${trial}" = "FALSE" ]
then then
branch="${old}_MAINTENANCE" if [ "${message}" = "" ]
if [ "${trial}" = "FALSE" ] then
then git commit -a
git branch "${branch}" else
git push origin "${branch}" git commit -a -m "$message"
fi fi
git push ${gitremote} master
fi
cat project.clj > ${tmp}/project.bak.3 if [ "${release}" != "" ]
setup-build-sig "${old}" "${release}-SNAPSHOT" "${fullname}" "${email}" then
sed -f ${tmp}/manifest.sed ${tmp}/project.bak.3 > project.clj branch="${old}_MAINTENANCE"
message="Upversioned from ${interim} to ${release}-SNAPSHOT" if [ "${trial}" = "FALSE" ]
then
git branch "${branch}"
git push ${gitremote} "${branch}"
fi
echo $message 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"
lein clean echo $message
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. lein clean
cat project.clj > ${tmp}/project.bak.4 lein compile
setup-build-sig if [ $? -ne 0 ]
sed -f ${tmp}/manifest.sed ${tmp}/project.bak.4 > project.clj then
echo "Sub-project ${dir} failed in compile after branch to ${release}!" 1>&2
exit 1
fi
lein marg
lein install
if [ "${trial}" = "FALSE" ] # Then unset manifest properties prior to committing.
then cat project.clj > ${tmp}/project.bak.4
git commit -a -m "${message}" setup-build-sig
echo ${message} sed -f ${tmp}/manifest.sed ${tmp}/project.bak.4 > project.clj
git push origin master
fi
fi
# if nothing broke so far, clean up... if [ "${trial}" = "FALSE" ]
rm -rf "${tmp}" then
popd git commit -a -m "${message}"
echo ${message}
git push ${gitremote} master
fi
fi
# if nothing broke so far, clean up...
rm -rf "${tmp}"
popd
fi
done done

13
project.clj
View file

@ -1,4 +1,4 @@
(defproject mw-engine "0.1.5-SNAPSHOT" (defproject mw-engine "0.1.6"
:description "Cellular automaton world builder." :description "Cellular automaton world builder."
:url "http://www.journeyman.cc/microworld/" :url "http://www.journeyman.cc/microworld/"
:manifest { :manifest {
@ -12,10 +12,9 @@
:license {:name "GNU General Public License v2" :license {:name "GNU General Public License v2"
:url "http://www.gnu.org/licenses/gpl-2.0.html"} :url "http://www.gnu.org/licenses/gpl-2.0.html"}
:plugins [[lein-marginalia "0.7.1"]] :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/math.combinatorics "0.1.4"]
[org.clojure/tools.trace "0.7.8"] [org.clojure/tools.trace "0.7.9"]
[org.clojure/tools.namespace "0.2.4"] [org.clojure/tools.namespace "0.2.11"]
[hiccup "1.0.5"] [hiccup "1.0.5"]
[net.mikera/imagez "0.3.1"] [net.mikera/imagez "0.12.0"]])
[fivetonine/collage "0.2.0"]])

87
src/mw_engine/core.clj
View file

@ -1,32 +1,56 @@
;; Functions to transform a world and run rules. (ns ^{:doc "Functions to transform a world and run rules."
:author "Simon Brooke"}
(ns mw-engine.core mw-engine.core
(:use mw-engine.utils)
(:require [clojure.core.reducers :as r] (: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)) (:gen-class))
;; 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. ;;;; mw-engine: the state/transition engine of MicroWorld.
;; ;;;;
;; While any function of two arguments can be used as a rule, a special high ;;;; This program is free software; you can redistribute it and/or
;; level rule language is provided by the `mw-parser` package, which compiles ;;;; modify it under the terms of the GNU General Public License
;; rules expressed in a subset of English rules into suitable functions. ;;;; as published by the Free Software Foundation; either version 2
;; ;;;; of the License, or (at your option) any later version.
;; 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 ;;;; This program is distributed in the hope that it will be useful,
;; return a cell without a keyword as the value of :state. Anything else is ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; legal. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; ;;;; GNU General Public License for more details.
;; 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. ;;;; You should have received a copy of the GNU General Public License
;; See `world.clj`. ;;;; along with this program; if not, write to the Free Software
;; ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; Each time the world is transformed (see `transform-world`, for each cell, ;;;; USA.
;; rules are applied in turn until one matches. Once one rule has matched no ;;;;
;; further rules can be applied. ;;;; 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.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn apply-rule (defn apply-rule
"Apply a single `rule` to a `cell`. What this is about is that I want to be able, "Apply a single `rule` to a `cell`. What this is about is that I want to be able,
@ -37,14 +61,15 @@
to access neighbours." to access neighbours."
([world cell rule] ([world cell rule]
(cond (cond
(ifn? rule) (apply-rule cell world rule nil) (ifn? rule) (apply-rule world cell rule nil)
(seq? rule) (let [[afn src] rule] (apply-rule cell world afn src)))) (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
([cell world rule source] ([world cell rule source]
(let [result (apply rule (list cell world))] (let [result (apply rule (list cell world))]
(cond (cond
(and result source) (merge result {:rule source}) (and result source) (merge result {:rule source})
true result)))) true result))))
(defn- apply-rules (defn- apply-rules
"Derive a cell from this `cell` of this `world` by applying these `rules`." "Derive a cell from this `cell` of this `world` by applying these `rules`."
[world cell rules] [world cell rules]
@ -53,6 +78,7 @@
(cond result result (cond result result
true (apply-rules world cell (rest rules)))))) true (apply-rules world cell (rest rules))))))
(defn- transform-cell (defn- transform-cell
"Derive a cell from this `cell` of this `world` by applying these `rules`. If an "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" exception is thrown, cache its message on the cell and set it's state to error"
@ -67,13 +93,16 @@
(.getMessage e) (.getMessage e)
(:generation cell) (:generation cell)
(:state cell)) (:state cell))
:stacktrace (map #(.toString %) (.getStackTrace e))
:state :error})))) :state :error}))))
(defn transform-world (defn transform-world
"Return a world derived from this `world` by applying these `rules` to each cell." "Return a world derived from this `world` by applying these `rules` to each cell."
[world rules] [world rules]
(map-world world transform-cell (list rules))) (map-world world transform-cell (list rules)))
(defn- transform-world-state (defn- transform-world-state
"Consider this single argument as a map 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 map of the new, transformed `:world` and to transform the world, and return a map of the new, transformed `:world` and

38
src/mw_engine/display.clj
View file

@ -1,22 +1,50 @@
(ns mw-engine.display (ns ^{:doc "Simple functions to allow a world to be visualised."
(:use mw-engine.utils :author "Simon Brooke"}
mw-engine.world) mw-engine.display
(:require [hiccup.core :refer [html]])) (: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] (defn format-css-class [state]
"Format this `state`, assumed to be a keyword indicating a state in the "Format this `state`, assumed to be a keyword indicating a state in the
world, into a CSS class" world, into a CSS class"
(subs (str state) 1)) (subs (str state) 1))
(defn format-image-path (defn format-image-path
"Render this `state`, assumed to be a keyword indicating a state in the "Render this `state`, assumed to be a keyword indicating a state in the
world, into a path which should recover the corresponding image file." world, into a path which should recover the corresponding image file."
[state] [state]
(format "img/tiles/%s.png" (format-css-class state))) (format "img/tiles/%s.png" (format-css-class state)))
(defn format-mouseover [cell] (defn format-mouseover [cell]
(str cell)) (str cell))
(defn render-cell (defn render-cell
"Render this world cell as a Hiccup table cell." "Render this world cell as a Hiccup table cell."
[cell] [cell]
@ -25,11 +53,13 @@
[:a {:href (format "inspect?x=%d&y=%d" (:x cell) (:y 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)}]]])) [:img {:alt (:state cell) :width 32 :height 32 :src (format-image-path state)}]]]))
(defn render-world-row (defn render-world-row
"Render this world `row` as a Hiccup table row." "Render this world `row` as a Hiccup table row."
[row] [row]
(apply vector (cons :tr (map render-cell row)))) (apply vector (cons :tr (map render-cell row))))
(defn render-world-table (defn render-world-table
"Render this `world` as a Hiccup table." "Render this `world` as a Hiccup table."
[world] [world]

78
src/mw_engine/drainage.clj
View file

@ -1,11 +1,37 @@
;; Experimental, probably of no interest to anyone else; attempt to compute drainage on a world, (ns ^{:doc "Experimental, probably of no interest to anyone else; attempt to
;; assumed to have altitudes already set from a heighmap. 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]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ns mw-engine.drainage
(:use mw-engine.utils
mw-engine.world
mw-engine.core)
(:require [mw-engine.heightmap :as heightmap]))
(def ^:dynamic *sealevel* 10) (def ^:dynamic *sealevel* 10)
@ -18,37 +44,40 @@
[world] [world]
(map-world world (fn [world cell] (merge cell {:rainfall 1})))) (map-world world (fn [world cell] (merge cell {:rainfall 1}))))
(defn flow-contributors (defn flow-contributors
"Return a list of the cells in this `world` which are higher than this "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" same altitude and have greater flow"
[cell world] [cell world]
(filter #(map? %) (filter #(map? %)
(map (map
(fn [n] (fn [n]
(cond (cond
(= cell (get-least-cell (get-neighbours world n) :altitude)) n (= cell (get-least-cell (get-neighbours world n) :altitude)) n
(and (= (:altitude cell) (:altitude n)) (and (= (:altitude cell) (:altitude n))
(> (or (:flow n) 0) (or (:flow cell) 0))) 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 world (:x cell) (:y cell) 1 :altitude
(or (:altitude cell) 0) >=)))) (or (:altitude cell) 0) >=))))
(defn is-hollow (defn is-hollow
"Detects point hollows - that is, individual cells all of whose neighbours "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 are higher. Return true if this `cell` has an altitude lower than any of
its neighbours in this `world`" its neighbours in this `world`"
[world cell] [world cell]
;; quicker to count the elements of the list and compare equality of numbers ;; quicker to count the elements of the list and compare equality of numbers
;; than recursive equality check on members, I think. But worth benchmarking. ;; than recursive equality check on members, I think. But worth benchmarking.
(let [neighbours (get-neighbours world cell) (let [neighbours (get-neighbours world cell)
altitude (get-int-or-zero cell :altitude)] altitude (get-int-or-zero cell :altitude)]
(= (count neighbours) (= (count neighbours)
(count (get-neighbours-with-property-value (count (get-neighbours-with-property-value
world (:x cell) (:y cell) 1 :altitude altitude >))))) world (:x cell) (:y cell) 1 :altitude altitude >)))))
(defn flood-hollow (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`." of the lowest of its `neighbours`."
([world cell neighbours] ([world cell neighbours]
(let [lowest (get-least-cell neighbours :altitude)] (let [lowest (get-least-cell neighbours :altitude)]
@ -56,30 +85,33 @@
([world cell] ([world cell]
(flood-hollow world cell (get-neighbours 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 "Flood all local hollows in this `world`. At this stage only floods single
cell hollows." cell hollows."
[world] [world]
(map-world world (map-world world
#(if (is-hollow %1 %2) (flood-hollow %1 %2) %2))) #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
(def max-altitude 255) (def max-altitude 255)
(defn flow-nr (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 many times as there are distinct altitude values. This algorithm works only
if applied sequentially from the highest altitude to the lowest, see if applied sequentially from the highest altitude to the lowest, see
`flow-world-nr`." `flow-world-nr`."
[cell world] [cell world]
(if (= (- max-altitude (get-int-or-zero cell :generation)) (if (= (- max-altitude (get-int-or-zero cell :generation))
(get-int-or-zero cell :altitude)) (get-int-or-zero cell :altitude))
(merge cell (merge cell
{:flow (reduce + {:flow (reduce +
(map (map
#(+ (get-int-or-zero % :rainfall) #(+ (get-int-or-zero % :rainfall)
(get-int-or-zero % :flow)) (get-int-or-zero % :flow))
(flow-contributors cell world)))}))) (flow-contributors cell world)))})))
(def flow (def flow
"Compute the total flow upstream of this `cell` in this `world`, and return a cell identical "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 to this one but having a value of its flow property set from that computation. The function is
@ -99,6 +131,7 @@
(map (fn [neighbour] (:flow (flow neighbour world))) (map (fn [neighbour] (:flow (flow neighbour world)))
(flow-contributors cell world))))}))))) (flow-contributors cell world))))})))))
(defn flow-world-nr (defn flow-world-nr
"Experimental non-recursive flow-world algorithm" "Experimental non-recursive flow-world algorithm"
[world] [world]
@ -110,8 +143,9 @@
[world] [world]
(map-world (rain-world world) flow)) (map-world (rain-world world) flow))
(defn run-drainage (defn run-drainage
[hmap] [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." flows."
(flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap))))) (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))

63
src/mw_engine/heightmap.clj
View file

@ -1,15 +1,39 @@
;; Functions to apply a heightmap to a world. (ns ^{:doc "Functions to apply a heightmap to a world."
;; :author "Simon Brooke"}
;; Heightmaps are considered only as greyscale images, so colour is redundent (will be mw-engine.heightmap
;; ignored). Darker shades are higher.
(ns mw-engine.heightmap
(:import [java.awt.image BufferedImage]) (:import [java.awt.image BufferedImage])
(:use mw-engine.utils (:require [mikera.image.core :as imagez :only [filter-image get-pixels]]
mw-engine.world) [mikera.image.filters :as filters]
(:require [fivetonine.collage.util :as collage :only [load-image]] [mw-engine.utils :refer [abs get-int get-neighbours map-world]]
[mikera.image.core :as imagez :only [filter-image get-pixels]] [mw-engine.world :refer [make-world]]))
[mikera.image.filters :as filters]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; 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.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn tag-property (defn tag-property
@ -35,6 +59,7 @@
(get-int cell :x) (get-int cell :x)
(get-int cell :y)) 256))))}))) (get-int cell :y)) 256))))})))
(defn tag-gradient (defn tag-gradient
"Set the `gradient` property of this `cell` of this `world` to the difference in "Set the `gradient` property of this `cell` of this `world` to the difference in
altitude between its highest and lowest neghbours." altitude between its highest and lowest neghbours."
@ -47,12 +72,14 @@
gradient (- highest lowest)] gradient (- highest lowest)]
(merge cell {:gradient gradient}))) (merge cell {:gradient gradient})))
(defn tag-gradients (defn tag-gradients
"Set the `gradient` property of each cell in this `world` to the difference in "Set the `gradient` property of each cell in this `world` to the difference in
altitude between its highest and lowest neghbours." altitude between its highest and lowest neghbours."
[world] [world]
(map-world world tag-gradient)) (map-world world tag-gradient))
(defn tag-altitude (defn tag-altitude
"Set the altitude of this cell from the corresponding pixel of this heightmap. "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. If the heightmap you supply is smaller than the world, this will break.
@ -67,6 +94,7 @@
([cell heightmap] ([cell heightmap]
(tag-property cell :altitude heightmap))) (tag-property cell :altitude heightmap)))
(defn apply-heightmap (defn apply-heightmap
"Apply the image file loaded from this path to this world, and return a world whose "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 altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that
@ -78,20 +106,21 @@
* `imagepath` a file path or URL which indicates an (ideally greyscale) image file." * `imagepath` a file path or URL which indicates an (ideally greyscale) image file."
([world imagepath] ([world imagepath]
(let [heightmap (imagez/filter-image (let [heightmap (imagez/filter-image
(filters/grayscale) (imagez/load-image imagepath)
(collage/load-image imagepath))] (filters/grayscale))]
(map-world (map-world
(map-world world tag-altitude (list heightmap)) (map-world world tag-altitude (list heightmap))
tag-gradient))) tag-gradient)))
([imagepath] ([imagepath]
(let [heightmap (imagez/filter-image (let [heightmap (imagez/filter-image
(filters/grayscale) (imagez/load-image imagepath)
(collage/load-image imagepath)) (filters/grayscale))
world (make-world (.getWidth heightmap) (.getHeight heightmap))] 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)))) tag-gradient))))
(defn apply-valuemap (defn apply-valuemap
"Generalised from apply-heightmap, set an arbitrary property on each cell "Generalised from apply-heightmap, set an arbitrary property on each cell
of this `world` from the values in this (ideally greyscale) heightmap. of this `world` from the values in this (ideally greyscale) heightmap.
@ -102,6 +131,6 @@
intensity of the corresponding cell of the image." intensity of the corresponding cell of the image."
[world imagepath property] [world imagepath property]
(let [heightmap (imagez/filter-image (let [heightmap (imagez/filter-image
(filters/grayscale) (imagez/load-image imagepath)
(collage/load-image imagepath))] (filters/grayscale))]
(map-world world tag-property (list property heightmap)))) (map-world world tag-property (list property heightmap))))

63
src/mw_engine/natural_rules.clj
View file

@ -1,26 +1,56 @@
;; 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"}
;; Since the completion of the rule language this is more or less obsolete - mw-engine.natural-rules
;; there are still a few things that you can do with rules written in Clojure (:require mw-engine.utils
;; 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)) 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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; 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. ;; treeline at arbitrary altitude.
(def treeline 150) (def treeline 150)
;; waterline also at arbitrary altitude. ;; waterline also at arbitrary altitude.
(def waterline 10) (def waterline 10)
;; and finally snowline is also arbitrary. ;; and finally snowline is also arbitrary.
(def snowline 200) (def snowline 200)
;; Rare chance of lightning strikes ;; Rare chance of lightning strikes
(def lightning-probability 500) (def lightning-probability 500)
;; rules describing vegetation ;; rules describing vegetation
(def vegetation-rules (def vegetation-rules
(list (list
@ -72,8 +102,8 @@
;; Forest increases soil fertility ;; Forest increases soil fertility
(fn [cell world] (fn [cell world]
(cond (member? (:state cell) '(:forest :climax)) (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 ;; rules describing herbivore behaviour
(def herbivore-rules (def herbivore-rules
@ -139,8 +169,8 @@
(fn [cell world] (fn [cell world]
(cond (cond
(>= (get-int cell :wolves) 2) (>= (get-int cell :wolves) 2)
(merge cell {:wolves (int (* (:wolves cell) 2))}))) (merge cell {:wolves (int (* (:wolves cell) 2))})))))
))
;; rules which initialise the world ;; rules which initialise the world
(def init-rules (def init-rules
@ -152,12 +182,11 @@
(fn [cell world] (fn [cell world]
(cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow}))) (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
;; in between, we have a wasteland. ;; 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 (def natural-rules (flatten
(list (list
vegetation-rules vegetation-rules
herbivore-rules herbivore-rules
;; predator-rules predator-rules)))
)))

50
src/mw_engine/utils.clj
View file

@ -1,11 +1,33 @@
;; Utility functions needed by MicroWorld and, specifically, in the (ns ^{:doc " Utility functions needed by MicroWorld and, specifically, in the
;; interpretation of MicroWorld rule. interpretation of MicroWorld rule."
:author "Simon Brooke"}
(ns mw-engine.utils mw-engine.utils
(:require (:require
;; [clojure.core.reducers :as r]
[clojure.math.combinatorics :as combo])) [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
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn abs (defn abs
"Surprisingly, Clojure doesn't seem to have an abs function, or else I've "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, missed it. So here's one of my own. Maps natural numbers onto themselves,
@ -16,10 +38,12 @@
[n] [n]
(if (neg? n) (- 0 n) n)) (if (neg? n) (- 0 n) n))
(defn member? (defn member?
"True if elt is a member of col." "True if elt is a member of col."
[elt col] (some #(= elt %) col)) [elt col] (some #(= elt %) col))
(defn get-int-or-zero (defn get-int-or-zero
"Return the value of this `property` from this `map` if it is a integer; "Return the value of this `property` from this `map` if it is a integer;
otherwise return zero." otherwise return zero."
@ -27,6 +51,7 @@
(let [value (map property)] (let [value (map property)]
(if (integer? value) value 0))) (if (integer? value) value 0)))
(defn init-generation (defn init-generation
"Return a cell like this `cell`, but having a value for :generation, zero if "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 the cell passed had no integer value for generation, otherwise the value
@ -46,8 +71,9 @@
[world x y] [world x y]
(and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
(defn map-world-n-n (defn map-world-n-n
"Wholly non-parallel map world implementation" "Wholly non-parallel map world implementation; see documentation for `map-world`."
([world function] ([world function]
(map-world-n-n world function nil)) (map-world-n-n world function nil))
([world function additional-args] ([world function additional-args]
@ -59,8 +85,9 @@
row))) row)))
world)))) world))))
(defn map-world-p-p (defn map-world-p-p
"Wholly parallel map world implementation" "Wholly parallel map-world implementation; see documentation for `map-world`."
([world function] ([world function]
(map-world-p-p world function nil)) (map-world-p-p world function nil))
([world function additional-args] ([world function additional-args]
@ -91,6 +118,7 @@
row))) row)))
world)))) world))))
(defn get-cell (defn get-cell
"Return the cell a x, y in this world, if any. "Return the cell a x, y in this world, if any.
@ -101,6 +129,7 @@
(cond (in-bounds world x y) (cond (in-bounds world x y)
(nth (nth world y) x))) (nth (nth world y) x)))
(defn get-int (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. "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 +142,7 @@
true 0)) true 0))
true (throw (Exception. "No map passed?")))) true (throw (Exception. "No map passed?"))))
(defn population (defn population
"Return the population of this species in this cell. Currently a synonym for "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
@ -123,6 +153,7 @@
[cell species] [cell species]
(get-int cell species)) (get-int cell species))
(def memo-get-neighbours (def memo-get-neighbours
"Memoised get neighbours is more efficient when running deeply recursive "Memoised get neighbours is more efficient when running deeply recursive
algorithms on the same world. But it's less efficient when running the algorithms on the same world. But it's less efficient when running the
@ -137,6 +168,7 @@
(range (- x depth) (+ x depth 1)) (range (- x depth) (+ x depth 1))
(range (- y depth) (+ y depth 1))))))))) (range (- y depth) (+ y depth 1)))))))))
(defn get-neighbours (defn get-neighbours
"Get the neighbours to distance depth of a cell in this world. "Get the neighbours to distance depth of a cell in this world.
@ -170,6 +202,7 @@
([world cell] ([world cell]
(get-neighbours world cell 1))) (get-neighbours world cell 1)))
(defn get-neighbours-with-property-value (defn get-neighbours-with-property-value
"Get the neighbours to distance depth of the cell at x, y in this world which "Get the neighbours to distance depth of the cell at x, y in this world which
have this value for this property. have this value for this property.
@ -215,6 +248,7 @@
([world cell state] ([world cell state]
(get-neighbours-with-state world cell 1 state))) (get-neighbours-with-state world cell 1 state)))
(defn get-least-cell (defn get-least-cell
"Return the cell from among these `cells` which has the lowest numeric value "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 for this `property`; if the property is absent or not a number, use this
@ -242,6 +276,7 @@
true true
cell)) cell))
(defn set-property (defn set-property
"Return a world like this `world` but with the value of exactly one `property` "Return a world like this `world` but with the value of exactly one `property`
of one `cell` changed to this `value`" of one `cell` changed to this `value`"
@ -258,6 +293,7 @@
row))) row)))
world)))) world))))
(defn merge-cell (defn merge-cell
"Return a world like this `world`, but merge the values from this `cell` with "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" those from the cell in the world with the same co-ordinates"

16
src/mw_engine/version.clj
View file

@ -1,16 +0,0 @@
(ns 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 ))

56
src/mw_engine/world.clj
View file

@ -1,15 +1,43 @@
;; Functions to create and to print two dimensional cellular automata. Nothing in this (ns ^{:doc "Functions to create and to print two dimensional cellular automata."
;; file should determine what states are possible within the automaton, except for the :author "Simon Brooke"}
;; initial state, :new. mw-engine.world
;; (:require [clojure.string :as string :only [join]]
;; A cell is a map containing at least values for the keys :x, :y, and :state. [mw-engine.utils :refer [population]]))
;;
;; 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. ;;;;
;;;; 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.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(ns mw-engine.world
(:use mw-engine.utils)
(:require [clojure.string :as string :only [join]]))
(defn- make-cell (defn- make-cell
"Create a minimal default cell at x, y "Create a minimal default cell at x, y
@ -19,6 +47,7 @@
[x y] [x y]
{:x x :y y :state :new}) {: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.
@ -30,6 +59,7 @@
true (cons (make-cell index height) true (cons (make-cell index height)
(make-world-row (inc index) width height)))) (make-world-row (inc index) width height))))
(defn- make-world-rows (defn- make-world-rows
"Make the (remaining) rows in a world of this width and height, from this "Make the (remaining) rows in a world of this width and height, from this
index. index.
@ -51,6 +81,7 @@
[width height] [width height]
(apply vector (make-world-rows 0 width height))) (apply vector (make-world-rows 0 width height)))
(defn truncate-state (defn truncate-state
"Truncate the print name of the state of this cell to at most limit characters." "Truncate the print name of the state of this cell to at most limit characters."
[cell limit] [cell limit]
@ -58,6 +89,7 @@
(cond (> (count (str s)) limit) (subs s 0 limit) (cond (> (count (str s)) limit) (subs s 0 limit)
true s))) true s)))
(defn format-cell (defn format-cell
"Return a formatted string summarising the current state of this cell." "Return a formatted string summarising the current state of this cell."
[cell] [cell]
@ -66,11 +98,13 @@
(population cell :deer) (population cell :deer)
(population cell :wolves))) (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] [row]
(string/join (map format-cell row))) (string/join (map format-cell row)))
(defn print-world (defn print-world
"Print the current state of this world, and return nil. "Print the current state of this world, and return nil.

6
test/mw_engine/heightmap_test.clj
View file

@ -7,7 +7,7 @@
(deftest apply-heightmap-test (deftest apply-heightmap-test
(testing "Heightmap functionality" (testing "Heightmap functionality"
(let [world (apply-heightmap (as-file "resources/heightmaps/test9x9.png")) (let [world (apply-heightmap "resources/heightmaps/test9x9.png")
altitudes (map #(:altitude %) (flatten world)) altitudes (map #(:altitude %) (flatten world))
gradients (map #(:gradient %) (flatten world))] gradients (map #(:gradient %) (flatten world))]
(is (= (count world) 9) "World should be 9x9") (is (= (count world) 9) "World should be 9x9")
@ -22,7 +22,7 @@
(is (> (apply + gradients) 0) (is (> (apply + gradients) 0)
"At least some gradients must be positive, none should be negative")) "At least some gradients must be positive, none should be negative"))
;; alternate means of making the world, same tests. ;; alternate means of making the world, same tests.
(let [world (apply-heightmap (world/make-world 9 9) (as-file "resources/heightmaps/test9x9.png")) (let [world (apply-heightmap (world/make-world 9 9) "resources/heightmaps/test9x9.png")
altitudes (map #(:altitude %) (flatten world)) altitudes (map #(:altitude %) (flatten world))
gradients (map #(:gradient %) (flatten world))] gradients (map #(:gradient %) (flatten world))]
(is (= (count world) 9) "World should be 9x9") (is (= (count world) 9) "World should be 9x9")
@ -42,7 +42,7 @@
(deftest apply-valuemap-test (deftest apply-valuemap-test
(testing "Valuemap functionality" (testing "Valuemap functionality"
(let [image (as-file "resources/heightmaps/test9x9.png") (let [image "resources/heightmaps/test9x9.png"
world (apply-valuemap (apply-heightmap image) image :arbitrary) world (apply-valuemap (apply-heightmap image) image :arbitrary)
altitudes (map #(:altitude %) (flatten world)) altitudes (map #(:altitude %) (flatten world))
arbitraries (map #(:arbitrary %) (flatten world))] arbitraries (map #(:arbitrary %) (flatten world))]