From 77cfb32bb2127dfbcd7117661250e2079c8042b7 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 13 Jul 2014 23:56:29 +0100 Subject: [PATCH] Almost working; rule editor doesn't save. --- resources/public/docs/mw-engine/uberdoc.html | 10 +++++-- resources/public/docs/mw-parser/uberdoc.html | 18 ++++++------ resources/public/docs/mw-ui/uberdoc.html | 27 +++++++++++++++++- resources/public/rulesets/basic.txt | 1 + resources/templates/base.html | 8 ++++++ resources/templates/rules.html | 14 ++++++++++ src/mw_ui/routes/home.clj | 29 +++++++++++++++++++- 7 files changed, 94 insertions(+), 13 deletions(-) create mode 120000 resources/public/rulesets/basic.txt create mode 100644 resources/templates/rules.html diff --git a/resources/public/docs/mw-engine/uberdoc.html b/resources/public/docs/mw-engine/uberdoc.html index 843e0b9..e83d53a 100644 --- a/resources/public/docs/mw-engine/uberdoc.html +++ b/resources/public/docs/mw-engine/uberdoc.html @@ -3055,12 +3055,18 @@ See world.clj.

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
+
(defn- apply-rules
   [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.

+             true (apply-rules cell world (rest rules))))))

Derive a cell from this cell of this world by applying these rules. If an + exception is thrown, cache its message on the cell and set state to error

+
(defn- transform-cell
+  [cell world rules]
+  (try
+    (apply-rules cell world rules)
+    (catch Exception e (merge {:state :error :error (.getMessage e)} cell))))

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.

diff --git a/resources/public/docs/mw-parser/uberdoc.html b/resources/public/docs/mw-parser/uberdoc.html index b3b9e2d..0c68227 100644 --- a/resources/public/docs/mw-parser/uberdoc.html +++ b/resources/public/docs/mw-parser/uberdoc.html @@ -3053,7 +3053,7 @@ objective is to parse rules out of a block of text from a textarea

function, and return the sequence of such functions.

(defn compile-string
   [string]
-  (map compile-rule (split string #"\n")))

Compile each non-comment line of the file indicated by this filename into + (map compile-rule (remove comment? (split string #"\n"))))

Compile each non-comment line of the file indicated by this filename into an executable anonymous function, and return the sequence of such functions.

(defn compile-file 
   [filename]
@@ -3224,16 +3224,16 @@ front of the sequence of tokens it returns nil.

         (= 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 =)
+            (gen-neighbours-condition comparator quantity property value remainder '=)
             (and (= comp1 "more") (= comp2 "than"))
-            (gen-neighbours-condition '> quantity property value remainder >)
+            (gen-neighbours-condition '> quantity property value remainder '>)
             (and (= comp1 "less") (= comp2 "than"))
-            (gen-neighbours-condition '< quantity property value remainder <)))))))
+ (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'

+ (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)))]       
@@ -3247,10 +3247,10 @@ front of the sequence of tokens it returns nil.

         (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

+ (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
diff --git a/resources/public/docs/mw-ui/uberdoc.html b/resources/public/docs/mw-ui/uberdoc.html
index e4ef147..2d2ec5b 100644
--- a/resources/public/docs/mw-ui/uberdoc.html
+++ b/resources/public/docs/mw-ui/uberdoc.html
@@ -3210,6 +3210,7 @@ net.brehaut.ClojureTools = (function (SH) {
 
(ns mw-ui.routes.home
   (:use 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]
@@ -3219,6 +3220,11 @@ net.brehaut.ClojureTools = (function (SH) {
                                :content (html (world/render-world-table)) 
                                :seconds (or (session/get :seconds) 5) 
                                :maybe-refresh "refresh"}))

+
(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 about-page []
   (layout/render "about.html" {:title "About MicroWorld" :content (util/md->html "/md/about.md")}))

 
(defn list-states []
@@ -3231,10 +3237,29 @@ net.brehaut.ClojureTools = (function (SH) {
                               :parser (util/md->html "/md/mw-parser.md")
                               :states (list-states)
                               :components ["mw-engine" "mw-parser" "mw-ui"]}))

+
(defn rules-page 
+  ([request]
+    (let [rule-text (:src request)
+          error 
+          (try 
+            (do
+              (if rule-text
+                (session/put! :rules (compiler/compile-string rule-text)))
+              (session/put! :rule-text rule-text)
+              nil)
+            (catch Exception e (.getMessage e)))]
+      (layout/render "rules.html" {:title "Edit Rules" 
+                                   :rule-text (or (session/get :rule-text) (slurp "resources/public/rulesets/basic.txt"))
+                                   :error error})))
+  ([]
+    (rules-page nil)))

 
(defroutes home-routes
   (GET "/" [] (home-page))
   (GET "/about" [] (about-page))
-  (GET "/docs"  [] (docs-page)))
 
mw-ui.util
toc

+  (GET "/docs"  [] (docs-page))
+  (GET "/world"  [] (world-page))
+  (GET "/rules" request (rules-page request))
+  (POST "/rules" request (rules-page request)))
 

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

diff --git a/resources/public/rulesets/basic.txt b/resources/public/rulesets/basic.txt new file mode 120000 index 0000000..6cafe03 --- /dev/null +++ b/resources/public/rulesets/basic.txt @@ -0,0 +1 @@ +/home/simon/workspace/MicroWorld/mw-parser/resources/rules.txt \ No newline at end of file diff --git a/resources/templates/base.html b/resources/templates/base.html index 971dee4..4191f0c 100644 --- a/resources/templates/base.html +++ b/resources/templates/base.html @@ -23,6 +23,8 @@
+ {% if error %} +
+

{{error}}

+
+ {% endif %} + {% block content %} {% endblock %}
diff --git a/resources/templates/rules.html b/resources/templates/rules.html new file mode 100644 index 0000000..24ac35d --- /dev/null +++ b/resources/templates/rules.html @@ -0,0 +1,14 @@ +{% extends "templates/base.html" %} +{% block content %} +
+ +

+ + +

+ +
+ +{% endblock %} \ No newline at end of file diff --git a/src/mw_ui/routes/home.clj b/src/mw_ui/routes/home.clj index ddd3f02..8a70a4c 100644 --- a/src/mw_ui/routes/home.clj +++ b/src/mw_ui/routes/home.clj @@ -1,6 +1,7 @@ (ns mw-ui.routes.home (:use 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] @@ -12,6 +13,12 @@ :seconds (or (session/get :seconds) 5) :maybe-refresh "refresh"})) +(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 about-page [] (layout/render "about.html" {:title "About MicroWorld" :content (util/md->html "/md/about.md")})) @@ -27,7 +34,27 @@ :states (list-states) :components ["mw-engine" "mw-parser" "mw-ui"]})) +(defn rules-page + ([request] + (let [rule-text (:src request) + error + (try + (do + (if rule-text + (session/put! :rules (compiler/compile-string rule-text))) + (session/put! :rule-text rule-text) + nil) + (catch Exception e (.getMessage e)))] + (layout/render "rules.html" {:title "Edit Rules" + :rule-text (or (session/get :rule-text) (slurp "resources/public/rulesets/basic.txt")) + :error error}))) + ([] + (rules-page nil))) + (defroutes home-routes (GET "/" [] (home-page)) (GET "/about" [] (about-page)) - (GET "/docs" [] (docs-page))) + (GET "/docs" [] (docs-page)) + (GET "/world" [] (world-page)) + (GET "/rules" request (rules-page request)) + (POST "/rules" request (rules-page request)))