diff --git a/resources/public/docs/mw-engine/uberdoc.html b/resources/public/docs/mw-engine/uberdoc.html index 8f84d66..fb03a49 100644 --- a/resources/public/docs/mw-engine/uberdoc.html +++ b/resources/public/docs/mw-engine/uberdoc.html @@ -3038,6 +3038,10 @@ net.brehaut.ClojureTools = (function (SH) { 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.

+

While any function of two arguments can be used as a rule, a special high +level rule language is provided by the mw-parser package, which compiles +rules expressed in a subset of English rules into suitable functions.

+

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 @@ -3047,7 +3051,9 @@ legal.

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.

+

Each time the world is transformed (see transform-world, for each cell, +rules are applied in turn until one matches. Once one rule has matched no +further rules can be applied.

Derive a cell from this cell of this world by applying these rules.

(defn- transform-cell
   [cell world rules]
@@ -3080,21 +3086,7 @@ See world.clj.

 
(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.

-
- 
mw-engine.heightmap
toc
Functions to apply a heightmap to a world.

+    (take generations (iterate transform-world-state state))))
 

mw-engine.heightmap

toc

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.

@@ -3109,7 +3101,7 @@ ignored). Darker shades are higher.

[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.

+ onto positive real numbers.

-

It should also but does not yet parse rules of the form:

- +

it generates rules in the form expected by mw-engine.core, q.v.

-

it generates rules in the form expected by mw-engine.core

+

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
@@ -3054,62 +3062,198 @@ net.brehaut.ClojureTools = (function (SH) {
 
(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]'.

+
(def re-number #"^[0-9.]*$")
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

+
+
A code fragment parsed from the front of the sequence of tokens, and

+
+
the remaining tokens which were not consumed in constructing that sequence.

+
+
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 value from the first of these tokens. If expect-int is true, return
+   an integer or something which will evaluate to an integer.

+
(defn parse-simple-value
+  ([tokens expect-int]
+    (or
+        (parse-numeric-value tokens)
+        (cond expect-int
+          (parse-property-int tokens)
+          true (parse-property-value tokens))))
+  ([tokens]
+    (parse-simple-value tokens false)))
Parse a list of values from among these tokens. If expect-int is true, return
+   an integer or something which will evaluate to an integer.

+
(defn parse-disjunct-value
+  [[OR token & tokens] expect-int]
+  (cond (member? OR '("or" "in"))
+    (let [[others remainder] (parse-disjunct-value tokens expect-int)]
+      [(cons 
+         (cond 
+           expect-int (first (parse-simple-value (list token) true))
+           true (keyword token)) 
+         others) 
+       remainder])
+    true [nil (cons OR (cons token tokens))]))
Parse a value from among these tokens. If expect-int is true, return
+   an integer or something which will evaluate to an integer.

+
(defn parse-value 
+  ([tokens expect-int]
+    (or 
+      (parse-disjunct-value tokens expect-int)
+      (parse-simple-value tokens)))
+  ([tokens]
+    (parse-value tokens false)))

+
(defn parse-member-condition
+  [[property IN & rest]]
+  (if (= IN "in")
+    (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
+      [(list 'member? (keyword property) l) remainder])))
Parse '[property] 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]'.

+  [[property LESS THAN value & rest]]
+  (cond (and (= LESS "less") (= THAN "than"))
+        [(list '< (list 'get-int 'cell (keyword property)) (read-string value)) rest]))

Parse '[property] 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'. + [[property MORE THAN value & rest]] + (cond (and (= MORE "more") (= THAN "than")) + [(list '> (list 'get-int 'cell (keyword property)) (read-string value)) rest])) +

(defn parse-between-condition
+  [[p BETWEEN v1 AND v2 & rest]]
+  (cond (and (= 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 (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.

+ [[property IS value & rest]] + (cond + (member? IS '("is" "are")) + (let [tokens (cons property (cons value rest))] + (cond + (= value "in") (parse-member-condition tokens) + (= value "between") (parse-between-condition tokens) + (= value "more") (parse-more-condition tokens) + (= value "less") (parse-less-condition tokens) + (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])))))

Parse conditions of the form '[property] [comparison] [value]'.

+ [[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
+  [comparator quantity property value remainder] 
+  [(list comparator  
+         (list 'count
+               (list 'get-neighbours-with-property-value 'world 'cell 
+                     (keyword property) (keyword-or-numeric value)))
+         quantity)
+           remainder])

Parse conditions of the form '...more than 6 neighbours are [condition]'

+
(defn parse-comparator-neighbours-condition
+  [[MORE THAN n NEIGHBOURS have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))
+        comparator (cond (= MORE "more") '>
+                     (member? MORE '("fewer" "less")) '<)]       
+    (cond
+      (and quantity 
+           comparator
+           (= THAN "than")
+           (= NEIGHBOURS "neighbours"))
+      (cond
+        (= have-or-are "are") 
+        (let [[value & remainder] rest]
+          (gen-neighbours-condition comparator quantity :state value remainder))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition comparator quantity property value remainder)
+;;            (and (= comp1 "more") (= comp2 "than"))
+;;            (gen-neighbours-condition '> quantity property value remainder)
+;;            (and (= comp1 "less") (= comp2 "than"))
+;;            (gen-neighbours-condition '< quantity property value remainder)))))))
+
(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 have-or-are & rest]]
+  (let [quantity (first (parse-numeric-value (list n)))]       
+    (cond
+      (and quantity (= NEIGHBOURS "neighbours"))
+      (cond
+        (= have-or-are "are") 
+        (let [[value & remainder] rest]
+          (gen-neighbours-condition '= quantity :state value remainder))
+        (= have-or-are "have")
+        (let [[property comp1 comp2 value & remainder] rest]
+          (cond (and (= comp1 "equal") (= comp2 "to"))
+            (gen-neighbours-condition '= quantity property value remainder)
+;;            (and (= comp1 "more") (= comp2 "than"))
+;;            (gen-neighbours-condition '> quantity property value remainder)
+;;            (and (= comp1 "less") (= comp2 "than"))
+;;            (gen-neighbours-condition '< quantity property value remainder)))))))

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-is-condition tokens)
-      (parse-not-condition tokens)
-      (parse-less-condition tokens)
-      (parse-more-condition tokens)))

Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.

+ (or + (parse-neighbours-condition tokens) + (parse-member-condition tokens) + (parse-not-condition tokens) + (parse-is-condition tokens) + (parse-less-condition tokens) + (parse-more-condition tokens)))

Parse '... or [condition]' from tokens, where left is the already parsed first disjunct.

(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 tokens, where left is the already parsed first conjunct.

+ (if partial + (let [[right remainder] partial] + [(list 'or left right) remainder]))))

Parse '... and [condition]' from tokens, where left is the already parsed first conjunct.

(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 tokens, where conditions may be linked by either 'and' or 'or'.

+ (let [[right remainder] partial] + [(list 'and left right) remainder]))))

Parse conditions from tokens, where conditions may be linked by either 'and' or 'or'.

(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.

+ (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
+ [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'.

@@ -3121,27 +3265,41 @@ net.brehaut.ClojureTools = (function (SH) { [(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].'

+ (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.

+ (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.

+ 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
-  [tokens]
-  (if (= (first tokens) "then")
-    (parse-actions nil (rest tokens))))

Parse a complete rule from this string or sequence of string tokens.

+ [[THEN & tokens]] + (if (= THEN "then") + (or + (parse-probability nil tokens) + (parse-actions nil tokens))))

Parse a complete rule from this string or sequence of string tokens.

(defn parse-rule 
   [line]
   (cond
@@ -3149,5 +3307,13 @@ net.brehaut.ClojureTools = (function (SH) {
    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)))))
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
\ No newline at end of file diff --git a/resources/public/docs/mw-ui/uberdoc.html b/resources/public/docs/mw-ui/uberdoc.html index 296aaea..ade7351 100644 --- a/resources/public/docs/mw-ui/uberdoc.html +++ b/resources/public/docs/mw-ui/uberdoc.html @@ -3133,12 +3133,14 @@ net.brehaut.ClojureTools = (function (SH) { 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.

+ (format "img/tiles/%s.png" (format-css-class statekey))) +
(defn format-mouseover [cell]
+  (str "State " (:state cell) "; altitude: " (:altitude cell) "; fertility: " (:fertility cell)))

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.

+ [:td {:class (format-css-class state) :title (format-mouseover cell)} + [:img {:alt (world/format-cell 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 session as a complete HTML page.

@@ -3152,14 +3154,15 @@ net.brehaut.ClojureTools = (function (SH) { rules/init-rules)) rules (or (session/get :rules) rules/natural-rules) generation (+ (or (session/get :generation) 0) 1) - w2 (engine/transform-world world rules)] + 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.

+ (map render-world-row w2))) + [:p (str "Generation " generation)]]))

Render the world implied by the session as a complete HTML page.

(defn render-world
   []
   (html
@@ -3173,7 +3176,6 @@ net.brehaut.ClojureTools = (function (SH) {
      [:link {:href "css/states.css" :type "text/css" :rel "stylesheet"}]
      [:meta {:http-equiv "refresh" :content "5"}]]
     [:body
-     [:h1 "MicroWorld"]
      (render-world-table)
      ]]))
 

mw-ui.repl

toc
(ns mw-ui.repl
@@ -3213,16 +3215,26 @@ net.brehaut.ClojureTools = (function (SH) {
             [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")}))
+ (layout/render "world.html" {:title "Watch your world grow" + :content (html (world/render-world-table)) + :seconds (or (session/get :seconds) 5) + :maybe-refresh "refresh"})) 
(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"}))
+
(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/parser.md")
+                              :states (list-states)
+                              :components ["mw-engine" "mw-parser" "mw-ui"]}))
(defroutes home-routes
   (GET "/" [] (home-page))
   (GET "/about" [] (about-page))
-  (GET "/world" [] (world-page)))
 

mw-ui.util

toc
+ (GET "/docs" [] (docs-page))) 

mw-ui.util

toc
(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