mw-engine0.1.2-SNAPSHOTCellular automaton world builder. -dependencies
| (this space intentionally left almost blank) | ||||||||||||
mw-parser0.1.3-SNAPSHOTParser for production rules for MicroWorld engine -dependencies
| (this space intentionally left almost blank) | |||||||||
parse multiple rules from a stream, possibly a file - although the real -objective is to parse rules out of a block of text from a textarea - | ||||||||||
| - | (ns mw-parser.bulk - (:use mw-parser.core - mw-engine.utils - clojure.java.io - [clojure.string :only [split trim]]) - (:import (java.io BufferedReader StringReader))) | |||||||||
Is this | (defn comment? - [line] - (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) | |||||||||
Parse rules from successive lines in this | (defn parse-string - [string] - ;; TODO: tried to do this using with-open, but couldn't make it work. - (map parse-rule (remove comment? (split string #"\n")))) | |||||||||
Parse rules from successive lines in the file loaded from this | (defn parse-file - [filename] - (parse-string (slurp filename))) | |||||||||
Compile each non-comment line of this | (defn compile-string - [string] - (map #(compile-rule % true) (remove comment? (split string #"\n")))) | |||||||||
Compile each non-comment line of the file indicated by this | (defn compile-file - [filename] - (compile-string (slurp filename))) | |||||||||
A very simple parser which parses production rules of the following forms: - -
it generates rules in the form expected by It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil. -Very occasionally it generates a wrong rule - one which is not a correct translation of the rule -semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a -design fault. - -More significantly it does not generate useful error messages on failure. This is, I think, a much -more complex issue which I don't yet know how to address. - | ||||||||||
| - | (ns mw-parser.core - (:use mw-engine.utils - [clojure.string :only [split trim triml]]) - (:gen-class)) | |||||||||
| - | (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.]*$") | |||||||||
error thrown when an attempt is made to set a reserved property - | (def reserved-properties-error - "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") | |||||||||
error thrown when a rule cannot be parsed - | (def bad-parse-error "I did not understand '%s'") | |||||||||
If this token appears to represent an explicit number, return that number; - otherwise, make a keyword of it and return that. - | (defn- keyword-or-numeric - [token] - (cond - (re-matches re-number token) (read-string token) - (keyword? token) token - true (keyword token))) | |||||||||
Generally all functions in this file with names beginning 'parse-' take a -sequence of tokens (and in some cases other optional arguments) and return a -vector comprising - -
In every case if the function cannot parse the desired construct from the -front of the sequence of tokens it returns nil. - | ||||||||||
Parse a number. - | (defn parse-numeric-value - [[value & remainder]] - (if (re-matches re-number value) [(read-string value) remainder])) | |||||||||
Parse a token assumed to be the name of a property of the current cell, - whose value is assumed to be an integer. - | (defn parse-property-int - [[value & remainder]] - (if value [(list 'get-int 'cell (keyword value)) remainder])) | |||||||||
Parse a token assumed to be the name of a property of the current cell. - | (defn parse-property-value - [[value & remainder]] - (if value [(list (keyword value) 'cell) remainder])) | |||||||||
Parse a token assumed to be a simple token value. - | (defn parse-token-value - [[value & remainder]] - (if value [(keyword value) remainder])) | |||||||||
Parse a value from the first of these | (defn parse-simple-value - ([tokens expect-int] - (or - (parse-numeric-value tokens) - (cond expect-int - (parse-property-int tokens) - true (parse-token-value tokens)))) - ([tokens] - (parse-simple-value tokens false))) | |||||||||
Parse a single value from this single token and return just the generated - code, not a pair. - | (defn gen-token-value - [token expect-int] - (first (parse-simple-value (list token) expect-int))) | |||||||||
Parse a list of values from among these | (defn parse-disjunct-value
- [[OR token & tokens] expect-int]
- (cond (member? OR '("or" "in"))
- (let [value (first (parse-simple-value (list token) expect-int))
- seek-others (= (first tokens) "or")]
- (cond seek-others
- (let [[others remainder] (parse-disjunct-value tokens expect-int)]
- [(cons value others) remainder])
- true
- [(list value) tokens])))) | |||||||||
Parse a value from among these | (defn parse-value - ([tokens expect-int] - (or - (parse-disjunct-value tokens expect-int) - (parse-simple-value tokens expect-int))) - ([tokens] - (parse-value tokens false))) | |||||||||
Parses a condition of the form '[property] in [value] or [value]...' - | (defn parse-member-condition
- [[property IS IN & rest]]
- (if (and (member? IS '("is" "are")) (= IN "in"))
- (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
- [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder]))) | |||||||||
Parse '[property] less than [value]'. - | (defn- parse-less-condition
- [[property IS LESS THAN & rest]]
- (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
- (let [[value remainder] (parse-value rest true)]
- [(list '< (list 'get-int 'cell (keyword property)) value) remainder]))) | |||||||||
Parse '[property] more than [value]'. - | (defn- parse-more-condition
- [[property IS MORE THAN & rest]]
- (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
- (let [[value remainder] (parse-value rest true)]
- [(list '> (list 'get-int 'cell (keyword property)) value) remainder]))) | |||||||||
| - | (defn- parse-between-condition
- [[p IS BETWEEN v1 AND v2 & rest]]
- (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
- (let [property (first (parse-simple-value (list p) true))
- value1 (first (parse-simple-value (list v1) true))
- value2 (first (parse-simple-value (list v2) true))]
- [(list 'or
- (list '< value1 property value2)
- (list '> value1 property value2)) rest]))) | |||||||||
Parse clauses of the form 'x is y', 'x is in y or z...', - 'x is between y and z', '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
- (member? IS '("is" "are"))
- (let [tokens (cons property (cons value rest))]
- (cond
- (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
- value [(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]))))) | |||||||||
| - | (defn- gen-neighbours-condition - ([comp1 quantity property value remainder comp2 distance] - [(list comp1 - (list 'count - (list 'get-neighbours-with-property-value 'world - '(cell :x) '(cell :y) distance - (keyword property) (keyword-or-numeric value) comp2)) - quantity) - remainder]) - ([comp1 quantity property value remainder comp2] - (gen-neighbours-condition comp1 quantity property value remainder comp2 1))) | |||||||||
Parse conditions of the form '...more than 6 neighbours are [condition]' - | (defn parse-comparator-neighbours-condition
- [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
- (let [quantity (first (parse-numeric-value (list n)))
- comparator (cond (= MORE "more") '>
- (member? MORE '("fewer" "less")) '<)]
- (cond
- (not (= WITHIN "within"))
- (parse-comparator-neighbours-condition
- (flatten
- ;; two tokens were mis-parsed as 'within distance' that weren't
- ;; actually 'within' and a distance. Splice in 'within 1' and try
- ;; again.
- (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
- (and quantity
- comparator
- (= THAN "than")
- (= NEIGHBOURS "neighbours"))
- (cond
- (= have-or-are "are")
- (let [[value & remainder] rest
- dist (gen-token-value distance true)]
- (gen-neighbours-condition comparator quantity :state value remainder = dist))
- (= have-or-are "have")
- (let [[property comp1 comp2 value & remainder] rest
- dist (gen-token-value distance true)]
- (cond (and (= comp1 "equal") (= comp2 "to"))
- (gen-neighbours-condition comparator quantity property
- value remainder = dist)
- (and (= comp1 "more") (= comp2 "than"))
- (gen-neighbours-condition comparator quantity property
- value remainder > dist)
- (and (= comp1 "less") (= comp2 "than"))
- (gen-neighbours-condition comparator quantity property
- value remainder < dist))))))) | |||||||||
| - | (defn parse-some-neighbours-condition
- [[SOME NEIGHBOURS & rest]]
- (cond
- (and (= SOME "some") (= NEIGHBOURS "neighbours"))
- (parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest)))) | |||||||||
Parse conditions of the form '...6 neighbours are [condition]' - | (defn parse-simple-neighbours-condition - [[n NEIGHBOURS WITHIN distance have-or-are & rest]] - (let [quantity (first (parse-numeric-value (list n)))] - (cond - (and quantity (= NEIGHBOURS "neighbours")) - (cond - (not (= WITHIN "within")) - (parse-simple-neighbours-condition - (flatten - ;; two tokens were mis-parsed as 'within distance' that weren't - ;; actually 'within' and a distance. Splice in 'within 1' and try - ;; again. - (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (= have-or-are "are") - (let [[value & remainder] rest - dist (gen-token-value distance true)] - (gen-neighbours-condition '= quantity :state value remainder = dist)) - (= have-or-are "have") - (let [[property comp1 comp2 value & remainder] rest - dist (gen-token-value distance true)] - (cond (and (= comp1 "equal") (= comp2 "to")) - (gen-neighbours-condition '= quantity property value remainder = - dist) - (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder > - dist) - (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder < - dist))))))) | |||||||||
Parse conditions referring to neighbours - | (defn parse-neighbours-condition - [tokens] - (or - (parse-simple-neighbours-condition tokens) - (parse-comparator-neighbours-condition tokens) - (parse-some-neighbours-condition tokens))) | |||||||||
Parse conditions of the form '[property] [comparison] [value]'. - | (defn parse-simple-condition - [tokens] - (or - (parse-neighbours-condition tokens) - (parse-member-condition tokens) - (parse-not-condition tokens) - (parse-less-condition tokens) - (parse-more-condition tokens) - (parse-between-condition tokens) - (parse-is-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 - [[IF & tokens]] - (if - (= IF "if") - (parse-conditions 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]]
- (cond
- (member? prop2 '("x" "y"))
- (throw
- (Exception. reserved-properties-error))
- (and (= SHOULD "should")
- (= BE "be")
- (member? operator '("+" "-" "*" "/")))
- [(list 'merge (or previous 'cell)
- {(keyword prop1) (list 'int
- (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]]
- (cond
- (member? property '("x" "y"))
- (throw
- (Exception. reserved-properties-error))
- (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 a probability of an action from this collection of tokens - | (defn- parse-probability - [previous [n CHANCE IN m & tokens]] - (cond - (and (= CHANCE "chance")(= IN "in")) - (let [[action remainder] (parse-actions previous tokens)] - (cond action - [(list 'cond - (list '< - (list 'rand - (first (parse-simple-value (list m) true))) - (first (parse-simple-value (list n) true))) - action) remainder])))) | |||||||||
Parse the right hand side ('then...') of a production rule. - | (defn- parse-right-hand-side - [[THEN & tokens]] - (if (= THEN "then") - (or - (parse-probability nil tokens) - (parse-actions nil tokens)))) | |||||||||
Parse a complete rule from this Throws an exception if parsing fails. - | (defn parse-rule - [line] - (cond - (string? line) - (let [rule (parse-rule (split (triml line) #"\s+"))] - (cond rule rule - true (throw (Exception. (format bad-parse-error line))))) - true - (let [[left remainder] (parse-left-hand-side line) - [right junk] (parse-right-hand-side remainder)] - (cond - ;; there should be a valide left hand side and a valid right hand side - ;; there shouldn't be anything left over (junk should be empty) - (and left right (empty? junk)) - (list 'fn ['cell 'world] (list 'if left right)))))) | |||||||||
Parse this Throws an exception if parsing fails. - | (defn compile-rule - ([rule-text return-tuple?] - (do - (use 'mw-engine.utils) - (let [afn (eval (parse-rule rule-text))] - (cond - (and afn return-tuple?)(list afn (trim rule-text)) - true afn)))) - ([rule-text] - (compile-rule rule-text false))) | |||||||||
mw-ui0.1.3-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 [clojure.java.io :as jio] - [mw-engine.core :as engine] - [mw-engine.world :as world] - [mw-engine.heightmap :as heightmap] - [mw-parser.bulk :as compiler] - [hiccup.core :refer [html]] - [noir.io :as io] - [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))) | |||||||||||||||||||||||||||||||||
| - | (defn format-mouseover [cell] - (str cell)) | |||||||||||||||||||||||||||||||||
Render this world cell as a Hiccup table cell. - | (defn render-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) :src (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 current session as a complete HTML table in a DIV. - | (defn render-world-table
- []
- (let [world (or (session/get :world)
- (heightmap/apply-heightmap
- (io/get-resource "/img/heightmaps/small_hill.png")))
- rules (or (session/get :rules)
- (do (session/put! :rules
- (compiler/compile-file
- (io/get-resource "/rulesets/basic.txt")))
- (session/get :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"}
- (apply vector
- (cons :table
- (map render-world-row w2)))
- [:p
- (str "Generation " generation)]])) | |||||||||||||||||||||||||||||||||
| - | (defn render-inspector
- [cell table]
- [:table {:class "music-ruled"}
- [:tr
- [:td {:colspan 2 :style "text-align: center;"}
- [:img {:src (str "img/tiles/" (name (:state cell)) ".png")
- :width 64
- :height 64}]]]
- [:tr [:th "Key"][:th "Value"]]
- (map #(vector :tr (vector :th %)(vector :td (cell %))) (keys cell))]) | |||||||||||||||||||||||||||||||||
| - | (ns mw-ui.repl - (:use mw-ui.handler - ring.server.standalone - [ring.middleware file-info file]) - (:gen-class)) | |||||||||||||||||||||||||||||||||
| - | (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)) | |||||||||||||||||||||||||||||||||
| - | (defn -main [] - (start-server)) | |||||||||||||||||||||||||||||||||
| - | (ns mw-ui.routes.home - (:use clojure.walk - compojure.core - [mw-engine.utils :as engine-utils] - [mw-ui.routes.rules :as rules] - [mw-ui.routes.params :as params]) - (: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] - [ring.util.response :as response])) | |||||||||||||||||||||||||||||||||
| - | (defn home-page []
- (layout/render "trusted-content.html" {:title "Welcome to MicroWorld"
- :content (util/md->html "/md/mw-ui.md")})) | |||||||||||||||||||||||||||||||||
| - | (defn inspect-page [request]
- (let [params (keywordize-keys (:params request))
- xs (:x params)
- ys (:y params)
- x (if (not (empty? xs)) (read-string xs) 0)
- y (if (not (empty? ys)) (read-string ys) 0)
- world (session/get :world)
- cell (engine-utils/get-cell world x y)
- state (:state params)]
- (cond state
- (do
- (session/put! :world (engine-utils/set-property world cell :state (keyword state)))
- (response/redirect "world"))
- true
- (layout/render "inspector.html"
- {:title (format "Inspect cell at %d, %d" x y)
- :content (html (world/render-inspector cell world))
- :cell cell
- :x (:x cell)
- :y (:y cell)
- :states (util/list-resources
- "/img/tiles" #"([0-9a-z-_]+).png")})))) | |||||||||||||||||||||||||||||||||
| - | (defn world-page []
- (layout/render "trusted-content.html"
- {:title "Watch your world grow"
- :world-selected "active"
- :content (html (world/render-world-table))
- :pause (or (session/get :pause) 5)
- :maybe-refresh "refresh"})) | |||||||||||||||||||||||||||||||||
| - | (defn about-page []
- (layout/render "trusted-content.html"
- {:title "About MicroWorld"
- :about-selected "active"
- :content (util/md->html "/md/about.md")})) | |||||||||||||||||||||||||||||||||
| - | (defn md-page [request]
- (let [params (keywordize-keys (:params request))
- content (or (:content params) "missing.md")]
- (layout/render "trusted-content.html"
- {:title "Welcome to MicroWorld"
- :content (util/md->html (str "/md/" content))}))) | |||||||||||||||||||||||||||||||||
| - | (defn list-states [] - (sort - (filter #(not (nil? %)) - (map #(first (rest (re-matches #"([0-9a-z-]+).png" (.getName %)))) - (file-seq (clojure.java.io/file "resources/public/img/tiles")))))) | |||||||||||||||||||||||||||||||||
| - | (defn docs-page []
- (layout/render "docs.html" {:title "Documentation"
- :parser (util/md->html "/md/mw-parser.md" )
- :states (util/list-resources "/img/tiles" #"([0-9a-z-_]+).png")
- :lessons (util/list-resources "/md/lesson-plans" #"([0-9a-z-_]+).md")
- :components ["mw-engine" "mw-parser" "mw-ui"]})) | |||||||||||||||||||||||||||||||||
| - | (defroutes home-routes - (GET "/" [] (home-page)) - (GET "/about" [] (about-page)) - (GET "/docs" [] (docs-page)) - (GET "/world" [] (world-page)) - (GET "/params" [] (params/params-page)) - (GET "/md" request (md-page request)) - (POST "/params" request (params/params-page request)) - (GET "/rules" request (rules/rules-page request)) - (POST "/rules" request (rules/rules-page request)) - (GET "/inspect" request (inspect-page request)) - (POST "/inspect" request (inspect-page request))) | |||||||||||||||||||||||||||||||||
| - | (ns mw-ui.routes.params - (:use clojure.walk - clojure.java.io - compojure.core) - (:require [hiccup.core :refer [html]] - [mw-engine.heightmap :as heightmap] - [mw-parser.bulk :as compiler] - [mw-ui.layout :as layout] - [mw-ui.util :as util] - [mw-ui.render-world :as world] - [noir.io :as io] - [noir.session :as session])) | |||||||||||||||||||||||||||||||||
| - | (defn- send-params []
- {:title "Choose your world"
- :heightmaps (util/list-resources "/img/heightmaps" #"([0-9a-z-_]+).png")
- :pause (or (session/get :pause) 5)
- :rulesets (util/list-resources "/rulesets" #"([0-9a-z-_]+).txt")
- }) | |||||||||||||||||||||||||||||||||
Handler for params request. If no | (defn params-page
- ([]
- (layout/render "params.html" (send-params)))
- ([request]
- (try
- (let [params (keywordize-keys (:form-params request))
- map (:heightmap params)
- pause (:pause params)
- rulefile (:ruleset params)
- rulepath (str "/rulesets/" rulefile ".txt")]
- (if (not (= map ""))
- (session/put! :world
- (heightmap/apply-heightmap
- (io/get-resource (str "/img/heightmaps/" map ".png")))))
- (if (not (= rulefile ""))
- (do
- (session/put! :rule-text (io/slurp-resource rulepath))
- (session/put! :rules (compiler/compile-file (io/get-resource rulepath)))))
- (if (not (= pause ""))
- (session/put! :pause pause))
- (layout/render "params.html"
- (merge (send-params)
- {:r rulefile
- :h map
- :message "Your parameters are saved, now look at your world"})))
- (catch Exception e
- (let [params (keywordize-keys (:form-params request))]
- (layout/render "params.html"
- (merge (send-params)
- {:title "Choose your world"
- :r (:ruleset params)
- :h (:heightmap params)
- :message "Your paramters are not saved"
- :error (str (.getName (.getClass e)) ": " (.getMessage e) "; " params)}))))))) | |||||||||||||||||||||||||||||||||
| - | (ns mw-ui.routes.rules - (:use clojure.walk - compojure.core) - (:require [hiccup.core :refer [html]] - [mw-parser.bulk :as compiler] - [mw-ui.layout :as layout] - [mw-ui.util :as util] - [mw-ui.render-world :as world] - [noir.io :as io] - [noir.session :as session] - [ring.util.response :as response])) | |||||||||||||||||||||||||||||||||
| - | (defn process-rules-request
- [request]
- (let [src (:src (keywordize-keys (:form-params request)))]
- (try
- (cond src
- (let [rules (compiler/compile-string src)]
- {:rule-text src
- :rules rules
- :message (str "Successfully compiled "
- (count rules)
- " rules") })
- true {:rule-text (or
- (session/get :rule-text)
- (io/slurp-resource "/rulesets/basic.txt"))
- :message "No rules found in request; loading defaults"})
- (catch Exception e
- {:rule-text src
- :message "An error occurred during compilation"
- :error (str (.getName (.getClass e)) ": " (.getMessage e))})))) | |||||||||||||||||||||||||||||||||
Request handler for the If | (defn rules-page
- ([request]
- (let [processed (process-rules-request request)]
- (if (:rules processed)
- (session/put! :rules (:rules processed)))
- (if (:rule-text processed)
- (session/put! :rule-text (:rule-text processed)))
- (layout/render "rules.html"
- (merge {:title "Edit Rules"} processed))))
- ([]
- (rules-page nil))) | |||||||||||||||||||||||||||||||||
| - | (ns mw-ui.util - (:require [noir.io :as io] - [noir.session :as session] - [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))) | |||||||||||||||||||||||||||||||||
| - | (defn list-resources [directory pattern] - "List resource files matching `pattern` in `directory`." - (let - [path (str (io/resource-path) directory)] - (session/put! :list-resources-path path) - (sort - (filter #(not (nil? %)) - (map #(first (rest (re-matches pattern (.getName %)))) - (file-seq (clojure.java.io/file path))))))) | |||||||||||||||||||||||||||||||||