Now runs rather nicely, although output could be tidied up a bit!
This commit is contained in:
parent
7bfefe95ab
commit
977947d4b0
|
@ -1,6 +1,98 @@
|
|||
(ns mw-engine.core)
|
||||
(ns mw-engine.core
|
||||
(:use mw-engine.world
|
||||
mw-engine.utils))
|
||||
|
||||
(defn foo
|
||||
"I don't do a whole lot."
|
||||
[x]
|
||||
(println x "Hello, World!"))
|
||||
;; 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.
|
||||
;;
|
||||
;; Rules are applied in turn until one matches.
|
||||
|
||||
|
||||
(def treeline 10)
|
||||
|
||||
(def natural-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
|
||||
(fn [cell world]
|
||||
(cond (and
|
||||
(= (:state cell) :scrub)
|
||||
(< (: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
|
||||
(fn [cell world]
|
||||
(cond
|
||||
(and
|
||||
(= (:state cell) :forest)
|
||||
(> (:fertility cell) 10))
|
||||
(merge cell {:state :climax})))
|
||||
;; Climax forest occasionally catches fire (e.g. lightning strikes)
|
||||
(fn [cell world] (cond (and (= (:state cell) :climax)(< (rand 10) 1)) (merge cell {:state :fire})))
|
||||
;; Climax forest neighbouring fires is likely to catch fire
|
||||
(fn [cell world]
|
||||
(cond
|
||||
(and (= (:state cell) :climax)
|
||||
(< (rand 3) 1)
|
||||
(not (empty? (get-neighbours-with-state world (:x cell) (:y cell) 1 :fire))))
|
||||
(merge cell {:state :fire})))
|
||||
;; 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.
|
||||
(fn [cell world]
|
||||
(cond
|
||||
(and (= (:state cell) :waste)
|
||||
(not
|
||||
(empty?
|
||||
(flatten
|
||||
(list
|
||||
(get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub2)
|
||||
(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})))
|
||||
(fn [cell world]
|
||||
(cond (= (:state cell) :waste)
|
||||
(merge cell {:state :pasture})))
|
||||
;; Forest increases soil fertility
|
||||
(fn [cell world]
|
||||
(cond (member? (:state cell) '(:forest :climax))
|
||||
(merge cell {:fertility (+ (:fertility cell) 1)})))
|
||||
))
|
||||
|
||||
(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 (transform-cell cell world (rest rules))))))
|
||||
|
||||
(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
|
||||
"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."
|
||||
[state]
|
||||
(list
|
||||
(print-world (transform-world (first state) (first (rest state))))
|
||||
(first (rest 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))))
|
||||
|
|
5
src/mw_engine/utils.clj
Normal file
5
src/mw_engine/utils.clj
Normal file
|
@ -0,0 +1,5 @@
|
|||
(ns mw-engine.utils)
|
||||
|
||||
(defn member?
|
||||
"True if elt is a member of col."
|
||||
[elt col] (some #(= elt %) col))
|
|
@ -4,7 +4,7 @@
|
|||
(defn make-cell
|
||||
"Create a default cell at x, y"
|
||||
[x y]
|
||||
{:x x :y y :altitude 1 :state :pasture})
|
||||
{:x x :y y :altitude 1 :state :waste :fertility 1})
|
||||
|
||||
(defn make-world-row
|
||||
"Make the (remaining) cells in a row at this height in a world of this width."
|
||||
|
@ -17,14 +17,14 @@
|
|||
"Make the (remaining) rows in a world of this width and height, from this
|
||||
index."
|
||||
(cond (= index height) nil
|
||||
true (cons (apply vector (make-world-row 0 width index))
|
||||
true (cons (make-world-row 0 width index)
|
||||
(make-world-rows (+ index 1) width height))))
|
||||
|
||||
(defn make-world
|
||||
"Make a world width cells from east to west, and height cells from north to
|
||||
south."
|
||||
[width height]
|
||||
(apply vector (make-world-rows 0 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)
|
||||
|
@ -46,6 +46,12 @@
|
|||
(range (- x depth) (+ x depth))
|
||||
(range (- y depth) (+ y depth)))))
|
||||
|
||||
(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]
|
||||
|
@ -60,6 +66,12 @@
|
|||
(map #(format "%10s" (truncate-state % 10)) row)))
|
||||
|
||||
(defn print-world
|
||||
"Print the current state of this world."
|
||||
"Print the current state of this world, and return nil"
|
||||
[world]
|
||||
(dorun (map #(println (format-world-row %)) world)) nil)
|
||||
(println)
|
||||
(dorun
|
||||
(map
|
||||
#(println
|
||||
(format-world-row %))
|
||||
world))
|
||||
world)
|
||||
|
|
Loading…
Reference in a new issue