mw-engine0.1.0-SNAPSHOTCellular automaton world builder. +dependencies
| (this space intentionally left almost blank) | ||||||||||||
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 +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 Rules are applied in turn until one matches. + | |||||||||||||
Derive a cell from this cell of this world by applying these rules. + | (defn- transform-cell + [cell world rules] + (cond (empty? rules) cell + true (let [result (apply (eval (first rules)) (list cell world))] + (cond result result + true (transform-cell cell world (rest rules)))))) | ||||||||||||
Return a row derived from this row of this world by applying these rules to each cell. + | (defn- transform-world-row + [row world rules] + (map #(transform-cell % world rules) row)) | ||||||||||||
Return a world derived from this world by applying these rules to each cell. + | (defn transform-world + [world rules] + (map + #(transform-world-row % world rules) + world)) | ||||||||||||
Consider this single argument as a map of | (defn- transform-world-state
+ [state]
+ (let [world (transform-world (:world state) (:rules state))]
+ (world/print-world world)
+ {:world world :rules (:rules state)})) | ||||||||||||
Run this world with these rules for this number of generations. + +
| (defn run-world
+ [world init-rules rules generations]
+ (let [state {:world (transform-world world init-rules) :rules rules}]
+ (take generations (iterate transform-world-state state)))) | ||||||||||||
(defn animate-world + "Run this world with these rules for this number of generations, and return nil + to avoid cluttering the screen. Principally for debugging. + | |||||||||||||
| |||||||||||||
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])) | ||||||||||||
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, but I don't care so much about them. + +
| (defn- abs + [n] + (cond (< n 0) (- 0 n) true n)) | ||||||||||||
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 and + it's ALL YOUR FAULT. + +
| (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))))})) | ||||||||||||
Set the altitude of each cell in this sequence from the corresponding pixel + of this heightmap. + If the heightmap you supply is smaller than the world, this will break and + it's ALL YOUR FAULT. + +
| (defn- apply-heightmap-row + [row heightmap] + (apply vector (map #(transform-altitude %1 heightmap) row))) | ||||||||||||
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. + +
| (defn apply-heightmap + [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)))) | ||||||||||||
A set of MicroWorld rules describing a simplified natural ecosystem. + | |||||||||||||
| + | (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
+ ;; 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) :heath)
+ ;; browsing limit really ought to vary with soil fertility, but...
+ (< (+ (get-int cell :deer)(get-int 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)
+ (> (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})))
+ ;; 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 heath, otherwise grassland.
+ (fn [cell world]
+ (cond
+ (and (= (:state cell) :waste)
+ (not
+ (empty?
+ (flatten
+ (list
+ (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 :heath})))
+ (fn [cell world]
+ (cond (= (:state cell) :waste)
+ (merge cell {:state :grassland})))
+ ;; Forest increases soil fertility
+ (fn [cell world]
+ (cond (member? (:state cell) '(:forest :climax))
+ (merge cell {:fertility (+ (get-int cell :fertility) 1)}))))) | ||||||||||||
rules describing herbivore behaviour + | (def herbivore-rules
+ (list
+ ;; if there are too many deer for the fertility of the area to sustain,
+ ;; some die or move on.
+ (fn [cell world]
+ (cond (> (get-int cell :deer) (get-int cell :fertility))
+ (merge cell {:deer (get-int cell :fertility)})))
+ ;; deer arrive occasionally at the edge of the map.
+ (fn [cell world]
+ (cond (and (< (count (get-neighbours world cell)) 8)
+ (< (rand 50) 1)
+ (> (get-int cell :fertility) 0)
+ (= (get-int cell :deer) 0))
+ (merge cell {:deer 2})))
+ ;; deer gradually spread through the world by breeding or migrating.
+ (fn [cell world]
+ (let [n (apply + (map #(get-int % :deer) (get-neighbours world cell)))]
+ (cond (and
+ (> (get-int cell :fertility) 0)
+ (= (get-int cell :deer) 0)
+ (>= n 2))
+ (merge cell {:deer (int (/ n 2))}))))
+ ;; deer breed.
+ (fn [cell world]
+ (cond
+ (>= (get-int cell :deer) 2)
+ (merge cell {:deer (int (* (:deer cell) 2))}))))) | ||||||||||||
rules describing predator behaviour + | (def predator-rules
+ (list
+ ;; wolves eat deer
+ (fn [cell world]
+ (cond
+ (>= (get-int cell :wolves) 1)
+ (merge cell {:deer (max 0 (- (get-int cell :deer) (get-int cell :wolves)))})))
+;; ;; not more than eight wolves in a pack, for now (hack because wolves are not dying)
+;; (fn [cell world]
+;; (cond (> (get-int cell :wolves) 8) (merge cell {:wolves 8})))
+ ;; if there are not enough deer to sustain the get-int of wolves,
+ ;; some wolves die or move on. (doesn't seem to be working?)
+ (fn [cell world]
+ (cond (> (get-int cell :wolves) (get-int cell :deer))
+ (merge cell {:wolves 0})))
+ ;; wolves arrive occasionally at the edge of the map.
+ (fn [cell world]
+ (cond (and (< (count (get-neighbours world cell)) 8)
+ (< (rand 50) 1)
+ (not (= (:state cell) :water))
+ (= (get-int cell :wolves) 0))
+ (merge cell {:wolves 2})))
+ ;; wolves gradually spread through the world by breeding or migrating.
+ (fn [cell world]
+ (let [n (apply + (map #(get-int % :wolves) (get-neighbours world cell)))]
+ (cond (and
+ (not (= (:state cell) :water))
+ (= (get-int cell :wolves) 0)
+ (>= n 2))
+ (merge cell {:wolves 2}))))
+ ;; wolves breed.
+ (fn [cell world]
+ (cond
+ (>= (get-int cell :wolves) 2)
+ (merge cell {:wolves (int (* (:wolves cell) 2))}))))) | ||||||||||||
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))) | ||||||||||||
Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule. + | |||||||||||||
| + | (ns mw-engine.utils + (:require [clojure.math.combinatorics :as combo])) | ||||||||||||
True if elt is a member of col. + | (defn member? + [elt col] (some #(= elt %) col)) | ||||||||||||
True if x, y are in bounds for this world (i.e., there is a cell at x, y) + else false. + +
| (defn in-bounds + [world x y] + (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) | ||||||||||||
Return the cell a x, y in this world, if any. + +
| (defn get-cell + [world x y] + (cond (in-bounds world x y) + (nth (nth world y) x))) | ||||||||||||
Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0. + +
| (defn get-int + [map key] + (cond map + (let [v (map key)] + (cond (and v (integer? v)) v + true 0)) + true (throw (Exception. "No map passed?")))) | ||||||||||||
Return the population of this species in this cell. Currently a synonym for
+
| (defn population + [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. + * `world` a world, as described in world.clj; + * `x` an integer representing an x coordinate in that world; + * `y` an integer representing an y coordinate in that world; + * `depth` an integer representing the distance from [x,y] that + should be searched." + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (combo/cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))) + ([world cell depth] + "Get the neighbours to distance depth of this cell in this world. + * `world` a world, as described in world.clj; + * `cell` a cell within that world; + * `depth` an integer representing the distance from [x,y] that + should be searched." + (get-neighbours world (:x cell) (:y cell) depth)) + ([world cell] + "Get the immediate neighbours of this cell in this world + * `world` a world, as described in world.clj; + * `cell` a cell within that world." + (get-neighbours world cell 1))) | ||||||||||||
Get the neighbours to distance depth of the cell at x, y in this world which + have this state. + + | (defn get-neighbours-with-state + [world x y depth state] + (filter #(= (:state %) state) (get-neighbours world x y depth))) | ||||||||||||
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)) | ||||||||||||
Create a minimal default cell at x, y + +
| (defn- make-cell
+ [x y]
+ {:x x :y y :state :new}) | ||||||||||||
Make the (remaining) cells in a row at this height in a world of this width. + +
| (defn- make-world-row + [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] + "Make the (remaining) rows in a world of this width and height, from this + 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)))) | ||||||||||||
Make a world width cells from east to west, and height cells from north to + south. + +
| (defn make-world + [width height] + (make-world-rows 0 width height)) | ||||||||||||
Truncate the print name of the state of this cell to at most limit characters. + | (defn truncate-state + [cell limit] + (let [s (:state cell)] + (cond (> (count (.toString s)) 10) (subs s 0 10) + true s))) | ||||||||||||
Return a formatted string summarising the current state of this cell. + | (defn format-cell + [cell] + (format "%10s(%2d/%2d)" + (truncate-state cell 10) + (population cell :deer) + (population cell :wolves))) | ||||||||||||
Format one row in the state of a world for printing. + | (defn- format-world-row + [row] + (apply str + (map format-cell row))) | ||||||||||||
Print the current state of this world, and return nil. + +
| (defn print-world + [world] + (println) + (dorun + (map + #(println + (format-world-row %)) + world)) + nil) | ||||||||||||
mw-parser0.1.0-SNAPSHOTParser for production rules for MicroWorld engine +dependencies
| (this space intentionally left almost blank) | ||||||
A very simple parser which parses production rules of the following forms: + +
It should also but does not yet parse rules of the form: + | |||||||
it generates rules in the form expected by mw-engine.core + | |||||||
| + | (ns mw-parser.core + (:use mw-engine.utils + [clojure.string :only [split triml]])) | ||||||
| + | (declare parse-conditions) +(declare parse-not-condition) +(declare parse-simple-condition) | ||||||
a regular expression which matches string representation of numbers + | (def re-number #"^[0-9.]*$") | ||||||
Parse '[property] is less than [value]'. + | (defn parse-less-condition
+ [[property is less than value & rest]]
+ (cond (and (member? is '("is" "are")) (= less "less") (= than "than"))
+ [(list '< (list 'get-int 'cell (keyword property)) (read-string value)) rest])) | ||||||
Parse '[property] is more than [value]'. + | (defn parse-more-condition
+ [[property is more than value & rest]]
+ (cond (and (member? is '("is" "are")) (= more "more") (= than "than"))
+ [(list '> (list 'get-int 'cell (keyword property)) (read-string value)) rest])) | ||||||
Parse clauses of the form 'x is y', but not 'x is more than y' or 'x is less than y'. + It is necessary to disambiguate whether value is a numeric or keyword. + | (defn parse-is-condition
+ [[property is value & rest]]
+ (cond (and (member? is '("is" "are"))
+ (not (member? value '("more" "less" "exactly" "not"))))
+ [(cond
+ (re-matches re-number value)(list '= (list 'get-int 'cell (keyword property)) (read-string value))
+ true (list '= (list (keyword property) 'cell) (keyword value)))
+ rest])) | ||||||
Parse the negation of a simple condition. + | (defn parse-not-condition
+ [[property is not & rest]]
+ (cond (and (member? is '("is" "are")) (= not "not"))
+ (let [partial (parse-simple-condition (cons property (cons is rest)))]
+ (cond partial
+ (let [[condition remainder] partial]
+ [(list 'not condition) remainder]))))) | ||||||
Parse conditions of the form '[property] [comparison] [value]'. + | (defn parse-simple-condition + [tokens] + (or (parse-is-condition tokens) + (parse-not-condition tokens) + (parse-less-condition tokens) + (parse-more-condition tokens))) | ||||||
Parse '... or [condition]' from | (defn parse-disjunction-condition + [left tokens] + (let [partial (parse-conditions tokens)] + (if + partial + (let [[right remainder] partial] + [(list 'or left right) remainder])))) | ||||||
Parse '... and [condition]' from | (defn parse-conjunction-condition + [left tokens] + (let [partial (parse-conditions tokens)] + (if partial + (let [[right remainder] partial] + [(list 'and left right) remainder])))) | ||||||
Parse conditions from | (defn parse-conditions + [tokens] + (let [partial (parse-simple-condition tokens)] + (if partial + (let [[left [next & remainder]] partial] + (cond + (= next "and") (parse-conjunction-condition left remainder) + (= next "or") (parse-disjunction-condition left remainder) + true partial))))) | ||||||
Parse the left hand side ('if...') of a production rule. + | (defn parse-left-hand-side + [tokens] + (if + (= (first tokens) "if") + (parse-conditions (rest tokens)))) | ||||||
Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', + e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'. + | (defn parse-arithmetic-action
+ [previous [prop1 should be prop2 operator value & rest]]
+ (if (and (= should "should")
+ (= be "be")
+ (member? operator '("+" "-" "*" "/")))
+ [(list 'merge (or previous 'cell)
+ {(keyword prop1) (list (symbol operator) (list 'get-int 'cell (keyword prop2))
+ (cond
+ (re-matches re-number value) (read-string value)
+ true (list 'get-int 'cell (keyword value))))}) rest])) | ||||||
Parse actions of the form '[property] should be [value].' + | (defn parse-set-action
+ [previous [property should be value & rest]]
+ (if (and (= should "should") (= be "be"))
+ [(list 'merge (or previous 'cell)
+ {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest])) | ||||||
| + | (defn parse-simple-action [previous tokens] + (or (parse-arithmetic-action previous tokens) + (parse-set-action previous tokens))) | ||||||
Parse actions from tokens. + | (defn parse-actions + [previous tokens] + (let [[left remainder] (parse-simple-action previous tokens)] + (cond left + (cond (= (first remainder) "and") + (parse-actions left (rest remainder)) + true (list left))))) | ||||||
Parse the right hand side ('then...') of a production rule. + | (defn parse-right-hand-side + [tokens] + (if (= (first tokens) "then") + (parse-actions nil (rest tokens)))) | ||||||
Parse a complete rule from this string or sequence of string tokens. + | (defn parse-rule + [line] + (cond + (string? line) (parse-rule (split (triml line) #"\s+")) + true (let [[left remainder] (parse-left-hand-side line) + [right junk] (parse-right-hand-side remainder)] + ;; there shouldn't be any junk (should be null) + (list 'fn ['cell 'world] (list 'if left right))))) | ||||||
mw-ui0.1.0-SNAPSHOTWeb-based user interface for MicroWorld +dependencies
| (this space intentionally left almost blank) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.handler + (:require [compojure.core :refer [defroutes]] + [mw-ui.routes.home :refer [home-routes]] + [mw-ui.middleware :refer [load-middleware]] + [noir.response :refer [redirect]] + [noir.util.middleware :refer [app-handler]] + [compojure.route :as route] + [taoensso.timbre :as timbre] + [taoensso.timbre.appenders.rotor :as rotor] + [selmer.parser :as parser] + [environ.core :refer [env]])) | |||||||||||||||||||||||||||||||||
| + | (defroutes app-routes + (route/resources "/") + (route/not-found "Not Found")) | |||||||||||||||||||||||||||||||||
init will be called once when + app is deployed as a servlet on + an app server such as Tomcat + put any initialization code here + | (defn init
+ []
+ (timbre/set-config!
+ [:appenders :rotor]
+ {:min-level :info
+ :enabled? true
+ :async? false ; should be always false for rotor
+ :max-message-per-msecs nil
+ :fn rotor/appender-fn})
+ (timbre/set-config!
+ [:shared-appender-config :rotor]
+ {:path "mw_ui.log" :max-size (* 512 1024) :backlog 10})
+ (if (env :dev) (parser/cache-off!))
+ (timbre/info "mw-ui started successfully")) | |||||||||||||||||||||||||||||||||
destroy will be called when your application + shuts down, put any clean up code here + | (defn destroy + [] + (timbre/info "mw-ui is shutting down...")) | |||||||||||||||||||||||||||||||||
| + | (def app (app-handler
+ ;; add your application routes here
+ [home-routes app-routes]
+ ;; add custom middleware here
+ :middleware (load-middleware)
+ ;; timeout sessions after 30 minutes
+ :session-options {:timeout (* 60 30)
+ :timeout-response (redirect "/")}
+ ;; add access rules here
+ :access-rules []
+ ;; serialize/deserialize the following data formats
+ ;; available formats:
+ ;; :json :json-kw :yaml :yaml-kw :edn :yaml-in-html
+ :formats [:json-kw :edn])) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.layout + (:require [selmer.parser :as parser] + [clojure.string :as s] + [ring.util.response :refer [content-type response]] + [compojure.response :refer [Renderable]])) | |||||||||||||||||||||||||||||||||
| + | (def template-path "templates/") | |||||||||||||||||||||||||||||||||
| + | (deftype RenderableTemplate [template params] + Renderable + (render [this request] + (content-type + (->> (assoc params + (keyword (s/replace template #".html" "-selected")) "active" + :servlet-context + (if-let [context (:servlet-context request)] + (.getContextPath context))) + (parser/render-file (str template-path template)) + response) + "text/html; charset=utf-8"))) | |||||||||||||||||||||||||||||||||
| + | (defn render [template & [params]] + (RenderableTemplate. template params)) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.middleware + (:require [taoensso.timbre :as timbre] + [selmer.parser :as parser] + [environ.core :refer [env]] + [selmer.middleware :refer [wrap-error-page]] + [noir-exception.core + :refer [wrap-internal-error wrap-exceptions]])) | |||||||||||||||||||||||||||||||||
| + | (defn log-request [handler] + (fn [req] + (timbre/debug req) + (handler req))) | |||||||||||||||||||||||||||||||||
| + | (def development-middleware + [log-request + wrap-error-page + wrap-exceptions]) | |||||||||||||||||||||||||||||||||
| + | (def production-middleware + [#(wrap-internal-error % :log (fn [e] (timbre/error e)))]) | |||||||||||||||||||||||||||||||||
| + | (defn load-middleware [] + (concat (when (env :dev) development-middleware) + production-middleware)) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.render-world + (:require [mw-engine.core :as engine] + [mw-engine.world :as world] + [mw-engine.heightmap :as heightmap] + [mw-engine.natural-rules :as rules] + [hiccup.core :refer [html]] + [noir.session :as session])) | |||||||||||||||||||||||||||||||||
| + | (defn format-css-class [statekey] + "Format this statekey, assumed to be a keyword indicating a state in the + world, into a CSS class" + (subs (str statekey) 1)) | |||||||||||||||||||||||||||||||||
Render this statekey, assumed to be a keyword indicating a state in the + world, into a path which should recover the corresponding image file. + | (defn format-image-path + [statekey] + (format "img/tiles/%s.png" (format-css-class statekey))) | |||||||||||||||||||||||||||||||||
Render this world cell as a Hiccup table cell. + | (defn render-cell
+ [cell]
+ (let [state (:state cell)]
+ [:td {:class (format-css-class state)}
+ [:img {:alt (world/format-cell cell) :img (format-image-path state)}]])) | |||||||||||||||||||||||||||||||||
Render this world row as a Hiccup table row. + | (defn render-world-row + [row] + (apply vector (cons :tr (map render-cell row)))) | |||||||||||||||||||||||||||||||||
Render the world implied by the session as a complete HTML page. + | (defn render-world-table
+ []
+ (let [world (or (session/get :world)
+ (engine/transform-world
+ (heightmap/apply-heightmap
+ (world/make-world 20 20)
+ "resources/public/img/20x20/hill.png")
+ rules/init-rules))
+ rules (or (session/get :rules) rules/natural-rules)
+ generation (+ (or (session/get :generation) 0) 1)
+ w2 (engine/transform-world world rules)]
+ (session/put! :world w2)
+ (session/put! :generation generation)
+ [:div {:class "world"}
+ [:p (str "Generation " generation)]
+ (apply vector
+ (cons :table
+ (map render-world-row w2)))])) | |||||||||||||||||||||||||||||||||
Render the world implied by the session as a complete HTML page. + | (defn render-world
+ []
+ (html
+ [:html
+ [:head
+ [:title "MicroWorld demo"]
+ [:link {:media "only screen and (max-device-width: 480px)" :href "css/phone.css" :type "text/css" :rel "stylesheet"}]
+ [:link {:media "only screen and (min-device-width: 481px) and (max-device-width: 1024px)" :href "css/tablet.css" :type "text/css" :rel "stylesheet"}]
+ [:link {:media "screen and (min-device-width: 1025px)" :href "css/standard.css" :type "text/css" :rel "stylesheet"}]
+ [:link {:media "print" :href "css/print.css" :type "text/css" :rel "stylesheet"}]
+ [:link {:href "css/states.css" :type "text/css" :rel "stylesheet"}]
+ [:meta {:http-equiv "refresh" :content "5"}]]
+ [:body
+ [:h1 "MicroWorld"]
+ (render-world-table)
+ ]])) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.repl + (:use mw-ui.handler + ring.server.standalone + [ring.middleware file-info file])) | |||||||||||||||||||||||||||||||||
| + | (defonce server (atom nil)) | |||||||||||||||||||||||||||||||||
| + | (defn get-handler [] + ;; #'app expands to (var app) so that when we reload our code, + ;; the server is forced to re-resolve the symbol in the var + ;; rather than having its own copy. When the root binding + ;; changes, the server picks it up without having to restart. + (-> #'app + ; Makes static assets in $PROJECT_DIR/resources/public/ available. + (wrap-file "resources") + ; Content-Type, Content-Length, and Last Modified headers for files in body + (wrap-file-info))) | |||||||||||||||||||||||||||||||||
used for starting the server in development mode from REPL + | (defn start-server
+ [& [port]]
+ (let [port (if port (Integer/parseInt port) 3000)]
+ (reset! server
+ (serve (get-handler)
+ {:port port
+ :init init
+ :auto-reload? true
+ :destroy destroy
+ :join? false}))
+ (println (str "You can view the site at http://localhost:" port)))) | |||||||||||||||||||||||||||||||||
| + | (defn stop-server [] + (.stop @server) + (reset! server nil)) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.routes.home + (:use compojure.core) + (:require [hiccup.core :refer [html]] + [mw-ui.layout :as layout] + [mw-ui.util :as util] + [mw-ui.render-world :as world] + [noir.session :as session])) | |||||||||||||||||||||||||||||||||
| + | (defn home-page []
+ (layout/render
+ "home.html" {:title "Welcome to MicroWorld" :content (util/md->html "/md/docs.md")})) | |||||||||||||||||||||||||||||||||
| + | (defn about-page []
+ (layout/render "about.html" {:title "About MicroWorld" :content (util/md->html "/md/about.md")})) | |||||||||||||||||||||||||||||||||
| + | (defn world-page []
+ (layout/render "world.html" {:title "Watch your world grow" :content (html (world/render-world-table)) :seconds (or (session/get :seconds) 5) :maybe-refresh "refresh"})) | |||||||||||||||||||||||||||||||||
| + | (defroutes home-routes + (GET "/" [] (home-page)) + (GET "/about" [] (about-page)) + (GET "/world" [] (world-page))) | |||||||||||||||||||||||||||||||||
| + | (ns mw-ui.util + (:require [noir.io :as io] + [markdown.core :as md])) | |||||||||||||||||||||||||||||||||
reads a markdown file from public/md and returns an HTML string + | (defn md->html + [filename] + (->> + (io/slurp-resource filename) + (md/md-to-html-string))) | |||||||||||||||||||||||||||||||||