diff --git a/buildall.sh b/buildall.sh index 0eabd8e..32b2463 100755 --- a/buildall.sh +++ b/buildall.sh @@ -16,7 +16,8 @@ old="unset" release="" tmp=buildall.tmp.$$ trial="FALSE" -webappsdir="/var/lib/tomcat7/webapps" +webappsdir="/var/lib/tomcat8/webapps" +gitremote="origin" # Builds the build signature properties in the manifest map file # expected arguments: old version tag, version tag, full name of user, @@ -72,11 +73,13 @@ 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. + -archive Create a tar archive of the current state of the source. + -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. -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 upversion to new LABEL and commit to master. -trial Trial build only, do not commit. @@ -87,21 +90,26 @@ fi while (( "$#" )) do case $1 in - -a|-archive) - archive="TRUE";; + -a|-archive) + archive="TRUE";; -b|-build) # 'build' is the expected normal case. trial="FALSE"; ;; + -d|-docker) + docker="TRUE";; -e|-email) shift; email=$1;; -f|-fullname) shift; fullname=$1;; - -p|-pull) - # pull from remote Git origin - git pull origin master;; + -p|-pull) + # pull from remote Git origin + git pull ${gitremote} master;; + -g|-git-remote) + shift; + gitremote=$1;; -r|-release) # release is branch a release and upversion to new label shift; @@ -126,7 +134,7 @@ do shift 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 if [ $? -ne 0 ] @@ -137,132 +145,141 @@ fi for dir in mw-* do - pushd ${dir} + if [ "${dir}" != "mw-explore" ] + then + pushd ${dir} - # Make a temporary directory to keep the work-in-progress files. - if [ ! -d "${tmp}" ] - then - rm -f "${tmp}" - mkdir "${tmp}" - fi + # Make a temporary directory to keep the work-in-progress files. + if [ ! -d "${tmp}" ] + then + rm -f "${tmp}" + mkdir "${tmp}" + fi - 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/'` + 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/'` - if [ "${release}" != "" ] - then - message="Preparing ${old} for release" + if [ "${release}" != "" ] + then + message="Preparing ${old} for release" - # Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does! - echo "${old}" | grep 'SNAPSHOT' - if [ $? -eq 0 ] - then - # It does... - interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'` - if [ "${interim}" = "" ] - then - echo "Failed to compute interim version tag from '${old}'" 1>&2 - exit 1; - fi - setup-build-sig "${old}" "${interim}" "${fullname}" "${email}" - message="Upversioned from ${old} to ${interim} for release" - old=${interim} - else - setup-build-sig "unset" "${old}" "${fullname}" "${email}" - fi - else - setup-build-sig "unset" "${old}" "${fullname}" "${email}" - fi + # Does the 'old' version tag end with the token "-SNAPSHOT"? it probably does! + echo "${old}" | grep 'SNAPSHOT' + if [ $? -eq 0 ] + then + # It does... + interim=`echo ${old} | sed 's/\([A-Za-z0-9_.-]*\)-SNAPSHOT.*/\1/'` + if [ "${interim}" = "" ] + then + echo "Failed to compute interim version tag from '${old}'" 1>&2 + exit 1; + fi + setup-build-sig "${old}" "${interim}" "${fullname}" "${email}" + message="Upversioned from ${old} to ${interim} for release" + old=${interim} + else + setup-build-sig "unset" "${old}" "${fullname}" "${email}" + fi + else + setup-build-sig "unset" "${old}" "${fullname}" "${email}" + 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 compile - if [ $? -ne 0 ] - then - echo "Sub-project ${dir} failed in compile" 1>&2 - exit 1 - fi + lein clean + lein compile + if [ $? -ne 0 ] + then + echo "Sub-project ${dir} failed in compile" 1>&2 + exit 1 + fi - lein test - if [ $? -ne 0 ] - then - echo "Sub-project ${dir} failed in test" 1>&2 - exit 1 - fi + lein test + if [ $? -ne 0 ] + then + echo "Sub-project ${dir} failed in test" 1>&2 + exit 1 + fi - lein marg - lein install + lein marg + lein install - # 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 - lein ring uberwar - sudo cp target/microworld.war "${webappsdir}" - echo "Deployed new WAR file to local Tomcat at ${webappsdir}" - fi + # 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 + lein ring uberwar + sudo cp target/microworld.war "${webappsdir}" + echo "Deployed new WAR file to local Tomcat at ${webappsdir}" + fi - # Then unset manifest properties prior to committing. - cat project.clj > ${tmp}/project.bak.2 - setup-build-sig - sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj + if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ] + then + lein docker build + lein docker push + fi - if [ "${trial}" = "FALSE" ] - then - if [ "${message}" = "" ] - then - git commit -a - else - git commit -a -m "$message" - fi - git push origin master - fi + # Then unset manifest properties prior to committing. + cat project.clj > ${tmp}/project.bak.2 + setup-build-sig + sed -f ${tmp}/manifest.sed ${tmp}/project.bak.2 > project.clj - if [ "${release}" != "" ] - then - branch="${old}_MAINTENANCE" - if [ "${trial}" = "FALSE" ] - then - git branch "${branch}" - git push origin "${branch}" - fi + if [ "${trial}" = "FALSE" ] + then + if [ "${message}" = "" ] + then + git commit -a + else + git commit -a -m "$message" + fi + git push ${gitremote} master + 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 - message="Upversioned from ${interim} to ${release}-SNAPSHOT" + if [ "${release}" != "" ] + then + branch="${old}_MAINTENANCE" + 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 - 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 + echo $message - # 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 + lein clean + 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 - if [ "${trial}" = "FALSE" ] - then - git commit -a -m "${message}" - echo ${message} - git push origin master - fi - fi + # 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 nothing broke so far, clean up... - rm -rf "${tmp}" - popd + if [ "${trial}" = "FALSE" ] + then + 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 diff --git a/project.clj b/project.clj index a2739ff..7bdb48c 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.5-SNAPSHOT" +(defproject mw-engine "0.1.6" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { @@ -12,10 +12,9 @@ :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.6.0"] - [org.clojure/math.combinatorics "0.0.7"] - [org.clojure/tools.trace "0.7.8"] - [org.clojure/tools.namespace "0.2.4"] + :dependencies [[org.clojure/clojure "1.8.0"] + [org.clojure/math.combinatorics "0.1.4"] + [org.clojure/tools.trace "0.7.9"] + [org.clojure/tools.namespace "0.2.11"] [hiccup "1.0.5"] - [net.mikera/imagez "0.3.1"] - [fivetonine/collage "0.2.0"]]) + [net.mikera/imagez "0.12.0"]]) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 9b95b55..83c1a2e 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -1,32 +1,56 @@ -;; Functions to transform a world and run rules. - -(ns mw-engine.core - (:use mw-engine.utils) +(ns ^{:doc "Functions to transform a world and run rules." + :author "Simon Brooke"} + mw-engine.core (: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)) -;; 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. - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; 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 +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; 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 "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." ([world cell rule] (cond - (ifn? rule) (apply-rule cell world rule nil) - (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src)))) - ([cell world rule source] + (ifn? rule) (apply-rule world cell rule nil) + (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src)))) + ([world cell rule source] (let [result (apply rule (list cell world))] (cond (and result source) (merge result {:rule source}) true result)))) + (defn- apply-rules "Derive a cell from this `cell` of this `world` by applying these `rules`." [world cell rules] @@ -53,6 +78,7 @@ (cond result result true (apply-rules world cell (rest rules)))))) + (defn- transform-cell "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" @@ -67,13 +93,16 @@ (.getMessage e) (:generation cell) (:state cell)) + :stacktrace (map #(.toString %) (.getStackTrace e)) :state :error})))) + (defn transform-world "Return a world derived from this `world` by applying these `rules` to each cell." [world rules] (map-world world transform-cell (list rules))) + (defn- transform-world-state "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 diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj index 0ad65e6..7dca8ff 100644 --- a/src/mw_engine/display.clj +++ b/src/mw_engine/display.clj @@ -1,22 +1,50 @@ -(ns mw-engine.display - (:use mw-engine.utils - mw-engine.world) - (:require [hiccup.core :refer [html]])) +(ns ^{:doc "Simple functions to allow a world to be visualised." + :author "Simon Brooke"} + mw-engine.display + (: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] "Format this `state`, assumed to be a keyword indicating a state in the world, into a CSS class" (subs (str state) 1)) + (defn format-image-path "Render this `state`, assumed to be a keyword indicating a state in the world, into a path which should recover the corresponding image file." [state] (format "img/tiles/%s.png" (format-css-class state))) + (defn format-mouseover [cell] (str cell)) + (defn render-cell "Render this world cell as a Hiccup table cell." [cell] @@ -25,11 +53,13 @@ [: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)}]]])) + (defn render-world-row "Render this world `row` as a Hiccup table row." [row] (apply vector (cons :tr (map render-cell row)))) + (defn render-world-table "Render this `world` as a Hiccup table." [world] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 925b1a0..87a7207 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -1,11 +1,37 @@ -;; 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 ^{:doc "Experimental, probably of no interest to anyone else; attempt to + 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) @@ -18,37 +44,40 @@ [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, 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" [cell world] (filter #(map? %) (map (fn [n] - (cond + (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n (and (= (:altitude cell) (:altitude 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 (or (:altitude cell) 0) >=)))) + (defn is-hollow - "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 - its neighbours in this `world`" + "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 + its neighbours in this `world`" [world cell] ;; quicker to count the elements of the list and compare equality of numbers ;; than recursive equality check on members, I think. But worth benchmarking. (let [neighbours (get-neighbours world cell) altitude (get-int-or-zero cell :altitude)] (= (count neighbours) - (count (get-neighbours-with-property-value + (count (get-neighbours-with-property-value world (:x cell) (:y cell) 1 :altitude altitude >))))) + (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`." ([world cell neighbours] (let [lowest (get-least-cell neighbours :altitude)] @@ -56,30 +85,33 @@ ([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 cell hollows." [world] - (map-world world + (map-world world #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2))) + (def max-altitude 255) (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 if applied sequentially from the highest altitude to the lowest, see `flow-world-nr`." [cell world] (if (= (- max-altitude (get-int-or-zero cell :generation)) (get-int-or-zero cell :altitude)) - (merge cell - {:flow (reduce + - (map + (merge cell + {:flow (reduce + + (map #(+ (get-int-or-zero % :rainfall) (get-int-or-zero % :flow)) (flow-contributors cell world)))}))) + (def 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. The function is @@ -99,6 +131,7 @@ (map (fn [neighbour] (:flow (flow neighbour world))) (flow-contributors cell world))))}))))) + (defn flow-world-nr "Experimental non-recursive flow-world algorithm" [world] @@ -110,8 +143,9 @@ [world] (map-world (rain-world world) flow)) + (defn run-drainage [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." (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap))))) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index 403cad0..3ef8e3c 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/mw_engine/heightmap.clj @@ -1,15 +1,39 @@ -;; 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 +(ns ^{:doc "Functions to apply a heightmap to a world." + :author "Simon Brooke"} + mw-engine.heightmap (:import [java.awt.image BufferedImage]) - (:use mw-engine.utils - mw-engine.world) - (:require [fivetonine.collage.util :as collage :only [load-image]] - [mikera.image.core :as imagez :only [filter-image get-pixels]] - [mikera.image.filters :as filters])) + (:require [mikera.image.core :as imagez :only [filter-image get-pixels]] + [mikera.image.filters :as filters] + [mw-engine.utils :refer [abs get-int get-neighbours map-world]] + [mw-engine.world :refer [make-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 +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; Heightmaps are considered only as greyscale images, so colour is redundent +;;;; (will be ignored). Darker shades are higher. +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn tag-property @@ -35,6 +59,7 @@ (get-int cell :x) (get-int cell :y)) 256))))}))) + (defn tag-gradient "Set the `gradient` property of this `cell` of this `world` to the difference in altitude between its highest and lowest neghbours." @@ -47,12 +72,14 @@ gradient (- highest lowest)] (merge cell {:gradient gradient}))) + (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] (map-world world tag-gradient)) + (defn tag-altitude "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. @@ -67,6 +94,7 @@ ([cell heightmap] (tag-property cell :altitude heightmap))) + (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 @@ -78,20 +106,21 @@ * `imagepath` a file path or URL which indicates an (ideally greyscale) image file." ([world imagepath] (let [heightmap (imagez/filter-image - (filters/grayscale) - (collage/load-image imagepath))] + (imagez/load-image imagepath) + (filters/grayscale))] (map-world (map-world world tag-altitude (list heightmap)) tag-gradient))) ([imagepath] (let [heightmap (imagez/filter-image - (filters/grayscale) - (collage/load-image imagepath)) + (imagez/load-image imagepath) + (filters/grayscale)) world (make-world (.getWidth heightmap) (.getHeight heightmap))] (map-world (map-world world tag-altitude (list heightmap)) tag-gradient)))) + (defn apply-valuemap "Generalised from apply-heightmap, set an arbitrary property on each cell of this `world` from the values in this (ideally greyscale) heightmap. @@ -102,6 +131,6 @@ intensity of the corresponding cell of the image." [world imagepath property] (let [heightmap (imagez/filter-image - (filters/grayscale) - (collage/load-image imagepath))] + (imagez/load-image imagepath) + (filters/grayscale))] (map-world world tag-property (list property heightmap)))) diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index 6032ca3..af4a124 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -1,26 +1,56 @@ -;; A set of MicroWorld rules describing a simplified natural ecosystem. -;; -;; 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. - -(ns mw-engine.natural-rules - (:use mw-engine.utils +(ns ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem." + :author "Simon Brooke"} + mw-engine.natural-rules + (:require 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 +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; 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. (def treeline 150) + ;; waterline also at arbitrary altitude. (def waterline 10) + ;; and finally snowline is also arbitrary. (def snowline 200) + ;; Rare chance of lightning strikes (def lightning-probability 500) + ;; rules describing vegetation (def vegetation-rules (list @@ -72,8 +102,8 @@ ;; Forest increases soil fertility (fn [cell world] (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 (def herbivore-rules @@ -139,8 +169,8 @@ (fn [cell world] (cond (>= (get-int cell :wolves) 2) - (merge cell {:wolves (int (* (:wolves cell) 2))}))) - )) + (merge cell {:wolves (int (* (:wolves cell) 2))}))))) + ;; rules which initialise the world (def init-rules @@ -152,12 +182,11 @@ (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 :grassland})) - ))) + (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland}))))) + (def natural-rules (flatten (list vegetation-rules herbivore-rules - ;; predator-rules - ))) + predator-rules))) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 279ec18..53c359f 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,11 +1,33 @@ -;; Utility functions needed by MicroWorld and, specifically, in the -;; interpretation of MicroWorld rule. - -(ns mw-engine.utils +(ns ^{:doc " Utility functions needed by MicroWorld and, specifically, in the + interpretation of MicroWorld rule." + :author "Simon Brooke"} + mw-engine.utils (:require -;; [clojure.core.reducers :as r] [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 "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, @@ -16,10 +38,12 @@ [n] (if (neg? n) (- 0 n) n)) + (defn member? "True if elt is a member of col." [elt col] (some #(= elt %) col)) + (defn get-int-or-zero "Return the value of this `property` from this `map` if it is a integer; otherwise return zero." @@ -27,6 +51,7 @@ (let [value (map property)] (if (integer? value) value 0))) + (defn init-generation "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 @@ -46,8 +71,9 @@ [world x y] (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) + (defn map-world-n-n - "Wholly non-parallel map world implementation" + "Wholly non-parallel map world implementation; see documentation for `map-world`." ([world function] (map-world-n-n world function nil)) ([world function additional-args] @@ -59,8 +85,9 @@ row))) world)))) + (defn map-world-p-p - "Wholly parallel map world implementation" + "Wholly parallel map-world implementation; see documentation for `map-world`." ([world function] (map-world-p-p world function nil)) ([world function additional-args] @@ -91,6 +118,7 @@ row))) world)))) + (defn get-cell "Return the cell a x, y in this world, if any. @@ -101,6 +129,7 @@ (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. @@ -113,6 +142,7 @@ true 0)) true (throw (Exception. "No map passed?")))) + (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 @@ -123,6 +153,7 @@ [cell species] (get-int cell species)) + (def memo-get-neighbours "Memoised get neighbours is more efficient when running deeply recursive algorithms on the same world. But it's less efficient when running the @@ -137,6 +168,7 @@ (range (- x depth) (+ x depth 1)) (range (- y depth) (+ y depth 1))))))))) + (defn get-neighbours "Get the neighbours to distance depth of a cell in this world. @@ -170,6 +202,7 @@ ([world cell] (get-neighbours world cell 1))) + (defn get-neighbours-with-property-value "Get the neighbours to distance depth of the cell at x, y in this world which have this value for this property. @@ -215,6 +248,7 @@ ([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 @@ -242,6 +276,7 @@ true cell)) + (defn set-property "Return a world like this `world` but with the value of exactly one `property` of one `cell` changed to this `value`" @@ -258,6 +293,7 @@ row))) world)))) + (defn merge-cell "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" diff --git a/src/mw_engine/version.clj b/src/mw_engine/version.clj deleted file mode 100644 index d3fa41d..0000000 --- a/src/mw_engine/version.clj +++ /dev/null @@ -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 )) diff --git a/src/mw_engine/world.clj b/src/mw_engine/world.clj index 2aa515f..9001ed6 100644 --- a/src/mw_engine/world.clj +++ b/src/mw_engine/world.clj @@ -1,15 +1,43 @@ -;; 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 ^{:doc "Functions to create and to print two dimensional cellular automata." + :author "Simon Brooke"} + mw-engine.world + (:require [clojure.string :as string :only [join]] + [mw-engine.utils :refer [population]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; 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 "Create a minimal default cell at x, y @@ -19,6 +47,7 @@ [x y] {:x x :y y :state :new}) + (defn- make-world-row "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) (make-world-row (inc index) width height)))) + (defn- make-world-rows "Make the (remaining) rows in a world of this width and height, from this index. @@ -51,6 +81,7 @@ [width height] (apply vector (make-world-rows 0 width height))) + (defn truncate-state "Truncate the print name of the state of this cell to at most limit characters." [cell limit] @@ -58,6 +89,7 @@ (cond (> (count (str s)) limit) (subs s 0 limit) true s))) + (defn format-cell "Return a formatted string summarising the current state of this cell." [cell] @@ -66,11 +98,13 @@ (population cell :deer) (population cell :wolves))) + (defn- format-world-row "Format one row in the state of a world for printing." [row] (string/join (map format-cell row))) + (defn print-world "Print the current state of this world, and return nil. diff --git a/test/mw_engine/heightmap_test.clj b/test/mw_engine/heightmap_test.clj index 23f63fa..66207a4 100644 --- a/test/mw_engine/heightmap_test.clj +++ b/test/mw_engine/heightmap_test.clj @@ -7,7 +7,7 @@ (deftest apply-heightmap-test (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)) gradients (map #(:gradient %) (flatten world))] (is (= (count world) 9) "World should be 9x9") @@ -22,7 +22,7 @@ (is (> (apply + gradients) 0) "At least some gradients must be positive, none should be negative")) ;; 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)) gradients (map #(:gradient %) (flatten world))] (is (= (count world) 9) "World should be 9x9") @@ -42,7 +42,7 @@ (deftest apply-valuemap-test (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) altitudes (map #(:altitude %) (flatten world)) arbitraries (map #(:arbitrary %) (flatten world))]