diff --git a/buildall.sh b/buildall.sh index 0eabd8e..205c897 100755 --- a/buildall.sh +++ b/buildall.sh @@ -72,7 +72,7 @@ if [ $# -lt 1 ] then cat <<-EOF 1>&2 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. -email [ADDRESS] Your email address, to be recorded in the build signature. -fullname [NAME] Your full name, to be recorded in the build signature. @@ -93,6 +93,8 @@ do # 'build' is the expected normal case. trial="FALSE"; ;; + -d|-docker) + docker="TRUE";; -e|-email) shift; email=$1;; @@ -126,7 +128,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 ] @@ -200,12 +202,18 @@ do # probably deploy it to local Tomcat for test if [ "${dir}" = "mw-ui" -a "${webappsdir}" != "" ] then - lein ring uberwar + 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. + if [ "${dir}" = "mw-ui" -a "${docker}" = "TRUE" ] + then + lein docker build + lein docker push + 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 diff --git a/project.clj b/project.clj index a2739ff..fec5988 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.5-SNAPSHOT" +(defproject mw-engine "3.0.0-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { @@ -9,13 +9,14 @@ "Implementation-Version" "unset" } :jvm-opts ["-Xmx4g"] + :source-paths ["src/clj" "src/cljc"] + :resource-paths ["resources"] :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"] + :dependencies [[org.clojure/clojure "1.8.0"] + [org.clojure/math.combinatorics "0.1.3"] [org.clojure/tools.trace "0.7.8"] - [org.clojure/tools.namespace "0.2.4"] + [org.clojure/tools.namespace "0.2.10"] [hiccup "1.0.5"] - [net.mikera/imagez "0.3.1"] - [fivetonine/collage "0.2.0"]]) + [net.mikera/imagez "0.11.0"]]) diff --git a/src/clj/microworld/engine/display.clj b/src/clj/microworld/engine/display.clj new file mode 100644 index 0000000..c17004c --- /dev/null +++ b/src/clj/microworld/engine/display.clj @@ -0,0 +1,68 @@ +(ns ^{:doc "Simple functions to allow a world to be visualised." + :author "Simon Brooke"} + microworld.engine.display + (:require [hiccup.core :refer [html]] + microworld.engine.utils + microworld.engine.world)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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] + (let [state (:state cell)] + [:td {:class (format-css-class state) :title (format-mouseover 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)}]]])) + + +(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] + (apply vector + (cons :table + (map render-world-row world)))) diff --git a/src/cljc/microworld/engine/core.cljc b/src/cljc/microworld/engine/core.cljc new file mode 100644 index 0000000..a15d37b --- /dev/null +++ b/src/cljc/microworld/engine/core.cljc @@ -0,0 +1,134 @@ +(ns ^{:doc "Functions to transform a world and run rules." + :author "Simon Brooke"} + microworld.engine.core + (:require [clojure.core.reducers :as r] + [microworld.engine.world :as world] + [microworld.engine.utils :refer [get-int-or-zero map-world]]) + (:gen-class)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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, + for debugging purposes, to tag a cell with the rule text of the rule which + fired (and especially so when an exception is thrown. So a rule may be either + an ifn, a list (ifn source-text), or a list (ifn {:rule source-text :clojure + generated-function}. + This function deals with despatching on those three possibilities. `world` + is also passed in in order to be able + to access neighbours." + ([world cell rule] + (cond + (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 (map? source)) (merge result source) + (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] + (cond (empty? rules) cell + true (let [result (apply-rule world cell (first rules))] + (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" + [world cell rules] + (try + (merge + (apply-rules world cell rules) + {:generation (+ (get-int-or-zero cell :generation) 1)}) + (catch Exception e + (merge cell {:error + (format "%s at generation %d when in state %s" + (.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 + these `:rules`. As a side effect, print the world." + [state] + (let [world (transform-world (:world state) (:rules state))] + ;;(world/print-world world) + {:world world :rules (:rules state)})) + + +(defn run-world + "Run this world with these rules for this number of generations. + + * `world` a world as discussed above; + * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; + * `rules` a sequence of rules as defined above, to be run iteratively for each generation; + * `generations` an (integer) number of generations. + + Return the final generation of the world." + [world init-rules rules generations] + (reduce (fn [world _iteration] + (transform-world world rules)) + (transform-world world init-rules) + (range generations))) + + diff --git a/src/mw_engine/drainage.clj b/src/cljc/microworld/engine/drainage.cljc similarity index 66% rename from src/mw_engine/drainage.clj rename to src/cljc/microworld/engine/drainage.cljc index 925b1a0..082ebc0 100644 --- a/src/mw_engine/drainage.clj +++ b/src/cljc/microworld/engine/drainage.cljc @@ -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"} + microworld.engine.drainage + (:require [microworld.engine.core :refer [run-world]] + [microworld.engine.heightmap :as heightmap] + [microworld.engine.utils :refer [get-int-or-zero get-least-cell get-neighbours + get-neighbours-with-property-value + map-world]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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/cljc/microworld/engine/heightmap.cljc similarity index 65% rename from src/mw_engine/heightmap.clj rename to src/cljc/microworld/engine/heightmap.cljc index 403cad0..cec789f 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/cljc/microworld/engine/heightmap.cljc @@ -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"} + microworld.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] + [microworld.engine.utils :refer [abs get-int get-neighbours map-world]] + [microworld.engine.world :refer [make-world]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 @@ -17,7 +41,7 @@ If the heightmap you supply is smaller than the world, this will break. * `world` not actually used, but present to enable this function to be - passed as an argument to `mw-engine.utils/map-world`, q.v. + passed as an argument to `microworld.engine.utils/map-world`, q.v. * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; * `property` the property (normally a keyword) whose value will be set on the cell. * `heightmap` an (ideally) greyscale image, whose x and y dimensions should @@ -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,18 +72,20 @@ 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. * `world` not actually used, but present to enable this function to be - passed as an argument to `mw-engine.utils/map-world`, q.v.; + passed as an argument to `microworld.engine.utils/map-world`, q.v.; * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map; * `heightmap` an (ideally) greyscale image, whose x and y dimensions should exceed those of the world of which the `cell` forms part." @@ -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-resource 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-resource 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-resource imagepath) + (filters/grayscale))] (map-world world tag-property (list property heightmap)))) diff --git a/src/mw_engine/natural_rules.clj b/src/cljc/microworld/engine/natural_rules.cljc similarity index 77% rename from src/mw_engine/natural_rules.clj rename to src/cljc/microworld/engine/natural_rules.cljc index 6032ca3..05399b5 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/cljc/microworld/engine/natural_rules.cljc @@ -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 ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem." + :author "Simon Brooke"} + microworld.engine.natural-rules + (:require microworld.engine.utils + microworld.engine.world)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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. +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(ns mw-engine.natural-rules - (:use mw-engine.utils - mw-engine.world)) ;; 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/cljc/microworld/engine/utils.cljc similarity index 87% rename from src/mw_engine/utils.clj rename to src/cljc/microworld/engine/utils.cljc index 279ec18..5f8ef9e 100644 --- a/src/mw_engine/utils.clj +++ b/src/cljc/microworld/engine/utils.cljc @@ -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"} + microworld.engine.utils (:require -;; [clojure.core.reducers :as r] [clojure.math.combinatorics :as combo])) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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/world.clj b/src/cljc/microworld/engine/world.cljc similarity index 54% rename from src/mw_engine/world.clj rename to src/cljc/microworld/engine/world.cljc index 2aa515f..aff77fb 100644 --- a/src/mw_engine/world.clj +++ b/src/cljc/microworld/engine/world.cljc @@ -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"} + microworld.engine.world + (:require [clojure.string :as string :only [join]] + [microworld.engine.utils :refer [population]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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/src/mw_engine/core.clj b/src/mw_engine/core.clj deleted file mode 100644 index 9b95b55..0000000 --- a/src/mw_engine/core.clj +++ /dev/null @@ -1,102 +0,0 @@ -;; Functions to transform a world and run rules. - -(ns mw-engine.core - (:use mw-engine.utils) - (:require [clojure.core.reducers :as r] - [mw-engine.world :as 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. - - -(defn apply-rule - "Apply a single `rule` to a `cell`. What this is about is that I want to be able, - for debugging purposes, to tag a cell with the rule text of the rule which - fired (and especially so when an exception is thrown. So a rule may be either - an ifn, or a list (ifn source-text). This function deals with despatching - on those two possibilities. `world` is also passed in in order to be able - 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] - (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] - (cond (empty? rules) cell - true (let [result (apply-rule world cell (first rules))] - (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" - [world cell rules] - (try - (merge - (apply-rules world cell rules) - {:generation (+ (get-int-or-zero cell :generation) 1)}) - (catch Exception e - (merge cell {:error - (format "%s at generation %d when in state %s" - (.getMessage e) - (:generation cell) - (:state cell)) - :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 - these `:rules`. As a side effect, print the world." - [state] - (let [world (transform-world (:world state) (:rules state))] - ;;(world/print-world world) - {:world world :rules (:rules state)})) - - -(defn run-world - "Run this world with these rules for this number of generations. - - * `world` a world as discussed above; - * `init-rules` a sequence of rules as defined above, to be run once to initialise the world; - * `rules` a sequence of rules as defined above, to be run iteratively for each generation; - * `generations` an (integer) number of generations. - - Return the final generation of the world." - [world init-rules rules generations] - (reduce (fn [world _iteration] - (transform-world world rules)) - (transform-world world init-rules) - (range generations))) - - diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj deleted file mode 100644 index 0ad65e6..0000000 --- a/src/mw_engine/display.clj +++ /dev/null @@ -1,38 +0,0 @@ -(ns mw-engine.display - (:use mw-engine.utils - mw-engine.world) - (:require [hiccup.core :refer [html]])) - -(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] - (let [state (:state cell)] - [:td {:class (format-css-class state) :title (format-mouseover 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)}]]])) - -(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] - (apply vector - (cons :table - (map render-world-row world)))) 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/test/mw_engine/core_test.clj b/test/microworld/engine/core_test.clj similarity index 88% rename from test/mw_engine/core_test.clj rename to test/microworld/engine/core_test.clj index 1491239..1d4e9cd 100644 --- a/test/mw_engine/core_test.clj +++ b/test/microworld/engine/core_test.clj @@ -1,6 +1,6 @@ -(ns mw-engine.core-test +(ns microworld.engine.core-test (:require [clojure.test :refer :all] - [mw-engine.core :refer :all])) + [microworld.engine.core :refer :all])) (deftest apply-rule-test (testing "Application of a single rule" diff --git a/test/mw_engine/drainage_test.clj b/test/microworld/engine/drainage_test.clj similarity index 90% rename from test/mw_engine/drainage_test.clj rename to test/microworld/engine/drainage_test.clj index ba2c95a..545af8c 100644 --- a/test/mw_engine/drainage_test.clj +++ b/test/microworld/engine/drainage_test.clj @@ -1,8 +1,8 @@ -(ns mw-engine.drainage-test +(ns microworld.engine.drainage-test (:require [clojure.test :refer :all] - [mw-engine.world :as world] - [mw-engine.utils :as utils] - [mw-engine.drainage :refer :all])) + [microworld.engine.world :as world] + [microworld.engine.utils :as utils] + [microworld.engine.drainage :refer :all])) (deftest is-hollow-test (testing "detection of hollows" diff --git a/test/mw_engine/heightmap_test.clj b/test/microworld/engine/heightmap_test.clj similarity index 84% rename from test/mw_engine/heightmap_test.clj rename to test/microworld/engine/heightmap_test.clj index 23f63fa..87ea5b8 100644 --- a/test/mw_engine/heightmap_test.clj +++ b/test/microworld/engine/heightmap_test.clj @@ -1,13 +1,13 @@ -(ns mw-engine.heightmap-test +(ns microworld.engine.heightmap-test (:use clojure.java.io) (:require [clojure.test :refer :all] - [mw-engine.heightmap :refer :all] - [mw-engine.world :as world :only [make-world]] + [microworld.engine.heightmap :refer :all] + [microworld.engine.world :as world :only [make-world]] [clojure.math.combinatorics :as combo])) (deftest apply-heightmap-test (testing "Heightmap functionality" - (let [world (apply-heightmap (as-file "resources/heightmaps/test9x9.png")) + (let [world (apply-heightmap "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) "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 "heightmaps/test9x9.png" world (apply-valuemap (apply-heightmap image) image :arbitrary) altitudes (map #(:altitude %) (flatten world)) arbitraries (map #(:arbitrary %) (flatten world))] diff --git a/test/mw_engine/utils_test.clj b/test/microworld/engine/utils_test.clj similarity index 98% rename from test/mw_engine/utils_test.clj rename to test/microworld/engine/utils_test.clj index 0077ceb..1af5b10 100644 --- a/test/mw_engine/utils_test.clj +++ b/test/microworld/engine/utils_test.clj @@ -1,8 +1,8 @@ -(ns mw-engine.utils-test - (:use [mw-engine.world :as world]) +(ns microworld.engine.utils-test + (:use [microworld.engine.world :as world]) (:require [clojure.test :refer :all] [clojure.math.combinatorics :as combo] - [mw-engine.utils :refer :all])) + [microworld.engine.utils :refer :all])) (deftest abs-test (testing "Absolute value function" diff --git a/test/mw_engine/world_test.clj b/test/microworld/engine/world_test.clj similarity index 89% rename from test/mw_engine/world_test.clj rename to test/microworld/engine/world_test.clj index 7d50a3b..e6d011d 100644 --- a/test/mw_engine/world_test.clj +++ b/test/microworld/engine/world_test.clj @@ -1,6 +1,6 @@ -(ns mw-engine.world-test +(ns microworld.engine.world-test (:require [clojure.test :refer :all] - [mw-engine.world :refer :all] + [microworld.engine.world :refer :all] [clojure.math.combinatorics :as combo])) (deftest genesis-test