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

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

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

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

@ -0,0 +1,42 @@
;; Experimental, probably of no interest to anyone else; attempt to compute drainage on a world,
;; assumed to have altitudes already set from a heighmap.
(ns mw-engine.drainage
(:use mw-engine.utils
mw-engine.world))
(defn rain-world
"Simulate rainfall on this `world`. TODO: Doesn't really work just now - should
rain more on west-facing slopes, and less to the east of high ground"
[world]
(map-world world (fn [world cell] (merge cell {:rainfall 1}))))
(defn flow-contributors
"Return a list of the cells in this `world` which are higher than this
`cell` and for which this cell is the lowest neighbour"
[world cell]
(remove nil?
(map
(fn [n]
(cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n))
(get-neighbours-with-property-value world (:x cell) (:y cell) 1
:altitude
(or (:altitude cell) 0) >))))
(defn flow
"Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
to this one but having a value of its flow property set from that computation.
Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
[world cell]
(merge cell
{:flow (+ (:rainfall cell)
(apply +
(map (fn [neighbour] (:flow (flow world neighbour)))
(flow-contributors world cell))))}))
(defn flow-world
"Return a world like this `world`, but with cells tagged with the amount of
water flowing through them."
[world]
(map-world (rain-world world) flow))

23
src/mw_engine/heightmap.clj
View file

@ -6,21 +6,12 @@
(ns mw-engine.heightmap
(:import [java.awt.image BufferedImage])
(:use mw-engine.utils
mw-engine.world)
mw-engine.world
mw-engine.drainage)
(:require [fivetonine.collage.util :as collage :only [load-image]]
[mikera.image.core :as imagez :only [filter-image get-pixels]]
[mikera.image.filters :as filters]))
(defn- abs
"Surprisingly, Clojure doesn't seem to have an abs function, or else I've
missed it. So here's one of my own. Maps natural numbers onto themselves,
and negative integers onto natural numbers. Also maps negative real numbers
onto positive real numbers.
* `n` a number, on the set of real numbers."
[n]
(cond (< n 0) (- 0 n) true n))
(defn tag-gradient
"Set the `gradient` property of this `cell` of this `world` to the difference in
altitude between its highest and lowest neghbours."
@ -33,7 +24,7 @@
gradient (- highest lowest)]
(merge cell {:gradient gradient})))
(defn tag-gradients
(defn tag-gradients
"Set the `gradient` property of each cell in this `world` to the difference in
altitude between its highest and lowest neghbours."
[world]
@ -70,17 +61,17 @@
a world the size of the heightmap will be created.
* `imagepath` a file path or URL which indicates an image file."
([world imagepath]
(let [heightmap (imagez/filter-image
(let [heightmap (imagez/filter-image
(filters/grayscale)
(collage/load-image imagepath))]
(map-world
(map-world world tag-altitude (list heightmap))
tag-gradient)))
([imagepath]
(let [heightmap (imagez/filter-image
(let [heightmap (imagez/filter-image
(filters/grayscale)
(collage/load-image imagepath))
world (make-world (.getWidth heightmap) (.getHeight heightmap))]
(map-world
(map-world world tag-altitude (list heightmap))
(map-world
(map-world world tag-altitude (list heightmap))
tag-gradient))))

58
src/mw_engine/utils.clj
View file

@ -3,6 +3,16 @@
(ns mw-engine.utils
(:require [clojure.math.combinatorics :as combo]))
(defn abs
"Surprisingly, Clojure doesn't seem to have an abs function, or else I've
missed it. So here's one of my own. Maps natural numbers onto themselves,
and negative integers onto natural numbers. Also maps negative real numbers
onto positive real numbers.
* `n` a number, on the set of real numbers."
[n]
(cond (< n 0) (- 0 n) true n))
(defn member?
"True if elt is a member of col."
[elt col] (some #(= elt %) col))
@ -17,17 +27,17 @@
[world x y]
(and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
(defn map-world
(defn map-world
"Apply this `function` to each cell in this `world` to produce a new world.
the arguments to the function will be the world, the cell, and any
the arguments to the function will be the world, the cell, and any
`additional-args` supplied"
([world function]
(map-world world function nil))
([world function additional-args]
(apply vector ;; vectors are more efficient for scanning, which we do a lot.
(for [row world]
(apply vector
(map #(apply function (cons world (cons % additional-args)))
(apply vector
(map #(apply function (cons world (cons % additional-args)))
row))))))
(defn get-cell
@ -42,7 +52,7 @@
(defn get-int
"Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0.
* `map` a map;
* `key` a symbol or keyword, presumed to be a key into the `map`."
[map key]
@ -54,7 +64,7 @@
(defn population
"Return the population of this species in this cell. Currently a synonym for
`get-int`, but may not always be (depending whether species are later
`get-int`, but may not always be (depending whether species are later
implemented as actors)
* `cell` a map;
@ -78,7 +88,7 @@
(combo/cartesian-product
(range (- x depth) (+ x depth 1))
(range (- y depth) (+ y depth 1)))))))
([world cell depth]
([world cell depth]
"Get the neighbours to distance depth of this cell in this world.
* `world` a world, as described in world.clj;
@ -107,19 +117,19 @@
It gets messy."
([world x y depth property value op]
(filter
#(eval
(list op
(or (get % property) (get-int % property))
value))
(filter
#(eval
(list op
(or (get % property) (get-int % property))
value))
(get-neighbours world x y depth)))
([world x y depth property value]
(get-neighbours-with-property-value world x y depth property value =))
([world cell depth property value]
(get-neighbours-with-property-value world (:x cell) (:y cell) depth
(get-neighbours-with-property-value world (:x cell) (:y cell) depth
property value))
([world cell property value]
(get-neighbours-with-property-value world cell 1
(get-neighbours-with-property-value world cell 1
property value)))
(defn get-neighbours-with-state
@ -138,12 +148,28 @@
([world cell state]
(get-neighbours-with-state world cell 1 state)))
(defn get-least-cell
"Return the cell from among these `cells` which has the lowest numeric value
for this `property`; if the property is absent or not a number, use this
`default`"
([cells property default]
(cond
(empty? cells) nil
true (let [downstream (get-least-cell (rest cells) property default)]
(cond (<
(or (property (first cells)) default)
(or (property downstream) default)) (first cells)
true downstream))))
([cells property]
(get-least-cell cells property (. Integer MAX_VALUE))))
(defn- set-cell-property
"If this `cell`s x and y properties are equal to these `x` and `y` values,
return a cell like this cell but with the value of this `property` set to
this `value`. Otherwise, just return this `cell`."
[cell x y property value]
(cond
(cond
(and (= x (:x cell)) (= y (:y cell)))
(merge cell {property value :rule "Set by user"})
true
@ -155,7 +181,7 @@
([world cell property value]
(set-property world (:x cell) (:y cell) property value))
([world x y property value]
(apply
(apply
vector ;; we want a vector of vectors, not a list of lists, for efficiency
(map
(fn [row]