diff --git a/project.clj b/project.clj index e318ccf..0d7d588 100644 --- a/project.clj +++ b/project.clj @@ -3,5 +3,8 @@ :url "http://example.com/FIXME" :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} + :plugins [[lein-marginalia "0.7.1"]] :dependencies [[org.clojure/clojure "1.5.1"] - [org.clojure/math.combinatorics "0.0.7"]]) + [org.clojure/math.combinatorics "0.0.7"] + [net.mikera/imagez "0.3.1"] + [fivetonine/collage "0.2.0"]]) diff --git a/resources/heightmaps/20x20/hill.png b/resources/heightmaps/20x20/hill.png new file mode 100644 index 0000000..8be86e4 Binary files /dev/null and b/resources/heightmaps/20x20/hill.png differ diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 6b6b22b..d64a3fc 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -1,52 +1,76 @@ +;; Functions to transform a world and run rules. + (ns mw-engine.core (:require [mw-engine.world :as world] mw-engine.natural-rules mw-engine.utils)) -;; every rule is a function of two arguments, a cell and a world. If the rule +;; 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. ;; +;; 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`. +;; ;; Rules are applied in turn until one matches. -(defn transform-cell +(defn- transform-cell "Derive a cell from this cell of this world by applying these rules." [cell world rules] (cond (empty? rules) cell - true (let [r (apply (eval (first rules)) (list cell world))] - (cond r r + true (let [result (apply (eval (first rules)) (list cell world))] + (cond result result true (transform-cell cell world (rest rules)))))) -(defn transform-world-row +(defn- transform-world-row "Return a row derived from this row of this world by applying these rules to each cell." [row world rules] (map #(transform-cell % world rules) row)) -(defn transform-world +(defn transform-world "Return a world derived from this world by applying these rules to each cell." [world rules] (map #(transform-world-row % world rules) world)) -(defn transform-world-state - "Consider this single argument as a list of world and rules; apply the rules - to transform the world, and return a list of the new, transformed world and - these rules. As a side effect, print the world." +(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] - (list - (world/print-world (transform-world (first state) (first (rest state)))) - (first (rest 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 rules generations] - (let [state (list world rules)] - (take generations (iterate transform-world-state 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 definied above, to be run iteratively for each generation; + * `generations` an (integer) number of generations." + [world init-rules rules generations] + (let [state {:world (transform-world world init-rules) :rules rules}] + (dorun (take generations (iterate transform-world-state state))))) (defn animate-world - [world rules generations] - (let [state (list world rules)] - (dorun + "Run this world with these rules for this number of generations, and return nil + to avoid cluttering the screen. Principally for debugging. + + * `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 definied above, to be run iteratively for each generation; + * `generations` an (integer) number of generations." + [world init-rules rules generations] + (let [state (list (transform-world world init-rules) rules)] + (dorun (take generations (iterate transform-world-state state))) - nil)) \ No newline at end of file + world)) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj new file mode 100644 index 0000000..75ec1ee --- /dev/null +++ b/src/mw_engine/heightmap.clj @@ -0,0 +1,46 @@ +;; 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 + (:import [java.awt.image BufferedImage]) + (:use mw-engine.utils + ;; interestingly the imagez load-image is failing for me, while the + ;; collage version is problem free. + [mikera.image.core :only [filter-image get-pixels]] + [mikera.image.filters] + [fivetonine.collage.util] + )) + +(defn- abs [int] + (cond (< int 0) (- 0 int) true int)) + +(defn transform-altitude + [cell heightmap] + (merge cell + {:altitude + (+ (get-int cell :altitude) + (- 256 + (abs + (mod + (.getRGB heightmap + (get-int cell :x) + (get-int cell :y)) 256))))})) + +(defn- apply-heightmap-row + [row heightmap] + (apply vector (map #(transform-altitude %1 heightmap) row))) + +(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 + the heightmap is at least as large in x and y dimensions as the world, and actually will + work correctly only if they are of the same x and y dimensions. + + * `world` a world, as defined in `world.clj`; + * `imagepath` a file path or URL which indicates an image file." + [world imagepath] + ;; bizarrely, the collage load-util is working for me, but the imagez version isn't. + (let [heightmap (filter-image (grayscale)(load-image imagepath))] + (apply vector (map #(apply-heightmap-row %1 heightmap) world)))) diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index 23a4242..f63fc73 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -1,34 +1,43 @@ +;; A set of MicroWorld rules describing a simplified natural ecosystem. + (ns mw-engine.natural-rules (:use mw-engine.utils mw-engine.world)) -;; rules describing the natural ecosystem +;; treeline at arbitrary altitude. +(def treeline 100) -(def treeline 10) +;; waterline also at arbitrary altitude. +(def waterline 10) -;; one in fifty chance of lightning strike -(def lightning-probability 50) +;; and finally snowline is also arbitrary. +(def snowline 200) + +;; Rare chance of lightning strikes +(def lightning-probability 500) + +;; rules which initialise the world ;; rules describing vegetation (def vegetation-rules (list - ;; Randomly, birds plant tree seeds into pasture. - (fn [cell world] (cond (and (= (:state cell) :pasture)(< (rand 10) 1))(merge cell {:state :scrub}))) - ;; Scrub below the treeline grows gradually into forest, providing browsing pressure is not to high + ;; Randomly, birds plant tree seeds into grassland. + (fn [cell world] (cond (and (= (:state cell) :grassland)(< (rand 10) 1))(merge cell {:state :heath}))) + ;; heath below the treeline grows gradually into forest, providing browsing pressure is not to high (fn [cell world] (cond (and - (= (:state cell) :scrub) + (= (:state cell) :heath) ;; browsing limit really ought to vary with soil fertility, but... - (< (+ (population cell :deer)(or (:sheep cell) 0)) 6) - (< (:altitude cell) treeline)) - (merge cell {:state :scrub2}))) - (fn [cell world] (cond (= (:state cell) :scrub2) (merge cell {:state :forest}))) - ;; Forest on fertile land at low altitude grows to climax + (< (+ (population cell :deer)(population cell :sheep)) 6) + (< (get-int cell :altitude) treeline)) + (merge cell {:state :scrub}))) + (fn [cell world] (cond (= (:state cell) :scrub) (merge cell {:state :forest}))) + ;; Forest on fertile land grows to climax (fn [cell world] (cond (and (= (:state cell) :forest) - (> (:fertility cell) 10)) + (> (get-int cell :fertility) 10)) (merge cell {:state :climax}))) ;; Climax forest occasionally catches fire (e.g. lightning strikes) (fn [cell world] (cond (and (= (:state cell) :climax)(< (rand lightning-probability) 1)) (merge cell {:state :fire}))) @@ -42,7 +51,7 @@ ;; After fire we get waste (fn [cell world] (cond (= (:state cell) :fire) (merge cell {:state :waste}))) ;; And after waste we get pioneer species; if there's a woodland seed - ;; source, it's going to be scrub, otherwise grassland. + ;; source, it's going to be heath, otherwise grassland. (fn [cell world] (cond (and (= (:state cell) :waste) @@ -50,17 +59,17 @@ (empty? (flatten (list - (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub2) + (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub) (get-neighbours-with-state world (:x cell) (:y cell) 1 :forest) (get-neighbours-with-state world (:x cell) (:y cell) 1 :climax)))))) - (merge cell {:state :scrub}))) + (merge cell {:state :heath}))) (fn [cell world] (cond (= (:state cell) :waste) - (merge cell {:state :pasture}))) + (merge cell {:state :grassland}))) ;; Forest increases soil fertility (fn [cell world] (cond (member? (:state cell) '(:forest :climax)) - (merge cell {:fertility (+ (:fertility cell) 1)}))) + (merge cell {:fertility (+ (get-int cell :fertility) 1)}))) )) ;; rules describing herbivore behaviour @@ -75,8 +84,8 @@ ;; if there are too many deer for the fertility of the area to sustain, ;; some die or move on. (fn [cell world] - (cond (> (* (population cell :deer) 10) (:fertility cell)) - (merge cell {:deer (int (/ (:fertility cell) 10))}))) + (cond (> (* (population cell :deer) 10) (get-int cell :fertility)) + (merge cell {:deer (int (/ (get-int cell :fertility) 10))}))) ;; deer gradually spread through the world by breeding or migrating. (fn [cell world] (let [n (apply + (map #(population % :deer) (get-neighbours world cell)))] @@ -121,4 +130,22 @@ (merge cell {:deer (- (population cell :deer) (population cell :wolves))})) )) -(def natural-rules (flatten (list vegetation-rules herbivore-rules predator-rules))) + ;; rules which initialise the world + (def init-rules + (list + ;; below the waterline, we have water. + (fn [cell world] + (cond (and (= (:state cell) :new) (< (get-int cell :altitude) waterline)) (merge cell {:state :water}))) + ;; above the snowline, we have snow. + (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 :waste})) + ))) + +(def natural-rules (flatten + (list + vegetation-rules + herbivore-rules + predator-rules + ))) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 4616050..01a2357 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,11 +1,65 @@ -(ns mw-engine.utils) +;; Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule. -(defn member? +(ns mw-engine.utils + (:require [clojure.math.combinatorics :as combo])) + +(defn member? "True if elt is a member of col." - [elt col] (some #(= elt %) col)) + [elt col] (some #(= elt %) col)) -(defn population [cell species] +(defn in-bounds + "True if x, y are in bounds for this world (i.e., there is a cell at x, y) + else false. + + * `world` a world as defined above; + * `x` a number which may or may not be a valid x coordinate within that world; + * `y` a number which may or may not be a valid y coordinate within that world." + [world x y] + (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) + +(defn get-cell + "Return the cell a x, y in this world, if any. + + * `world` a world as defined above; + * `x` a number which may or may not be a valid x coordinate within that world; + * `y` a number which may or may not be a valid y coordinate within that world." + [world x y] + (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." + [map key] + (let [v (map key)] + (cond (integer? v) v + true 0))) + +(defn population "Return the population of this species in this cell. - Species is assumed to be a keyword whose value in a cell should be an - integer." - (or (get cell species) 0)) \ No newline at end of file + + * `cell` a map; + * `species` a keyword representing a species which may populate that cell." + [cell species] + (get-int cell species)) + + +(defn get-neighbours + ([world x y depth] + "Get the neighbours to distance depth of the cell at x, y in this world." + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (combo/cartesian-product + (range (- x depth) (+ x depth)) + (range (- y depth) (+ y depth)))))) + ([world cell depth] + "Get the neighbours to distance depth of this cell in this world." + (get-neighbours world (:x cell) (:y cell) depth)) + ([world cell] + "Get the immediate neighbours of this cell in this world" + (get-neighbours world cell 1))) + +(defn get-neighbours-with-state + "Get the neighbours to distance depth of the cell at x, y in this world which + have this state." + [world x y depth state] + (filter #(= (:state %) state) (get-neighbours world x y depth))) diff --git a/src/mw_engine/world.clj b/src/mw_engine/world.clj index eb52491..5594a74 100644 --- a/src/mw_engine/world.clj +++ b/src/mw_engine/world.clj @@ -1,65 +1,54 @@ +;; 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 mw-engine.world - (:use mw-engine.utils) - (:require [clojure.math.combinatorics :as combo])) + (:use mw-engine.utils)) -(defn make-cell - "Create a default cell at x, y" +(defn- make-cell + "Create a minimal default cell at x, y + + * `x` the x coordinate at which this cell is created; + * `y` the y coordinate at which this cell is created." [x y] - {:x x :y y :altitude 1 :state :waste :fertility 1}) + {: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." +(defn- make-world-row + "Make the (remaining) cells in a row at this height in a world of this width. + + * `index` x coordinate of the next cell to be created; + * `width` total width of the matrix, in cells; + * `height` y coordinate of the next cell to be created." [index width height] (cond (= index width) nil true (cons (make-cell index height) (make-world-row (+ index 1) width height)))) -(defn make-world-rows [index width height] +(defn- make-world-rows [index width height] "Make the (remaining) rows in a world of this width and height, from this - index." + index. + + * `index` y coordinate of the next row to be created; + * `width` total width of the matrix, in cells; + * `height` total height of the matrix, in cells." (cond (= index height) nil true (cons (make-world-row 0 width index) (make-world-rows (+ index 1) width height)))) -(defn make-world +(defn make-world "Make a world width cells from east to west, and height cells from north to - south." + south. + + * `width` a natural number representing the width of the matrix to be created; + * `height` a natural number representing the height of the matrix to be created." [width height] (make-world-rows 0 width height)) -(defn in-bounds - "True if x, y are in bounds for this world (i.e., there is a cell at x, y) - else false." - [world x y] - (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) - -(defn get-cell - "Return the cell a x, y in this world, if any." - [world x y] - (cond (in-bounds world x y) - (nth (nth world y) x))) - -(defn get-neighbours - ([world x y depth] - "Get the neighbours to distance depth of the cell at x, y in this world." - (map #(get-cell world (first %) (first (rest %))) - (combo/cartesian-product - (range (- x depth) (+ x depth)) - (range (- y depth) (+ y depth))))) - ([world cell depth] - "Get the neighbours to distance depth of this cell in this world." - (get-neighbours world (:x cell) (:y cell) depth)) - ([world cell] - "Get the immediate neighbours of this cell in this world" - (get-neighbours world cell 1))) - - -(defn get-neighbours-with-state - "Get the neighbours to distance depth of the cell at x, y in this world which - have this state." - [world x y depth state] - (filter #(= (:state %) state) (get-neighbours world x y depth))) - (defn truncate-state "Truncate the print name of the state of this cell to at most limit characters." [cell limit] @@ -67,27 +56,29 @@ (cond (> (count (.toString s)) 10) (subs s 0 10) true s))) -(defn format-cell +(defn format-cell "Return a formatted string summarising the current state of this cell." [cell] - (format "%10s(%2d/%2d)" + (format "%10s(%2d/%2d)" (truncate-state cell 10) (population cell :deer) (population cell :wolves))) -(defn format-world-row - "Format one row in the state of a world for printing" +(defn- format-world-row + "Format one row in the state of a world for printing." [row] - (apply str + (apply str (map format-cell row))) (defn print-world - "Print the current state of this world, and return nil" + "Print the current state of this world, and return nil. + + * `world` a world as defined above." [world] (println) - (dorun - (map - #(println - (format-world-row %)) - world)) - world) + (dorun + (map + #(println + (format-world-row %)) + world)) + nil)