Still some bugs in rules generated from rule-language source. However,

a great deal does work.
This commit is contained in:
Simon Brooke 2014-07-14 23:23:11 +01:00
parent ad0e992000
commit b666540ac9
12 changed files with 34 additions and 16 deletions

View file

@ -3065,8 +3065,15 @@ further rules can be applied.</p>
</td><td class="codes"><pre class="brush: clojure">(defn- transform-cell </td><td class="codes"><pre class="brush: clojure">(defn- transform-cell
[cell world rules] [cell world rules]
(try (try
(merge
(apply-rules cell world rules) (apply-rules cell world rules)
(catch Exception e (merge {:state :error :error (.getMessage e)} cell)))) </pre></td></tr><tr><td class="docs"><p>Return a row derived from this row of this world by applying these rules to each cell.</p> {:generation (+ (or (:generation cell) 0) 1)})
(catch Exception e
(merge cell {:error
(format &quot;%s at generation %d when in state %s&quot;
(.getMessage e)
(:generation cell)
(:state cell))})))) </pre></td></tr><tr><td class="docs"><p>Return a row derived from this row of this world by applying these rules to each cell.</p>
</td><td class="codes"><pre class="brush: clojure">(defn- transform-world-row </td><td class="codes"><pre class="brush: clojure">(defn- transform-world-row
[row world rules] [row world rules]
(map #(transform-cell % world rules) row))</pre></td></tr><tr><td class="docs"><p>Return a world derived from this world by applying these rules to each cell.</p> (map #(transform-cell % world rules) row))</pre></td></tr><tr><td class="docs"><p>Return a world derived from this world by applying these rules to each cell.</p>
@ -3287,7 +3294,7 @@ ignored). Darker shades are higher.</p>
(fn [cell world] (fn [cell world]
(cond (and (= (:state cell) :new) (&gt; (get-int cell :altitude) snowline)) (merge cell {:state :snow}))) (cond (and (= (:state cell) :new) (&gt; (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
;; in between, we have a wasteland. ;; in between, we have a wasteland.
(fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :waste})))))</pre></td></tr><tr><td class="docs"> (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland})))))</pre></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(def natural-rules (flatten </td><td class="codes"><pre class="brush: clojure">(def natural-rules (flatten
(list (list
vegetation-rules vegetation-rules
@ -3373,12 +3380,15 @@ ignored). Darker shades are higher.</p>
* `cell` a cell within that world; * `cell` a cell within that world;
* `depth` an integer representing the distance from [x,y] that * `depth` an integer representing the distance from [x,y] that
should be searched; should be searched;
* `property` a keyword representing a property of the neighbours. * `property` a keyword representing a property of the neighbours;
* `value` a value of that property * `value` a value of that property;
* `op` a comparator function to use in place of `=`.
</code></pre> </code></pre>
<p> It gets messy.</p>
</td><td class="codes"><pre class="brush: clojure">(defn get-neighbours-with-property-value </td><td class="codes"><pre class="brush: clojure">(defn get-neighbours-with-property-value
([world x y depth property value comparator] ([world x y depth property value op]
(filter #(apply comparator (list (get % property) value)) (get-neighbours world x y depth))) (filter #(eval (list op (get % property) value)) (get-neighbours world x y depth)))
([world x y depth property value] ([world x y depth property value]
(get-neighbours-with-property-value world x y depth property value =)) (get-neighbours-with-property-value world x y depth property value =))
([world cell depth property value] ([world cell depth property value]

View file

@ -3226,9 +3226,9 @@ front of the sequence of tokens it returns nil.</p>
(cond (and (= comp1 &quot;equal&quot;) (= comp2 &quot;to&quot;)) (cond (and (= comp1 &quot;equal&quot;) (= comp2 &quot;to&quot;))
(gen-neighbours-condition comparator quantity property value remainder '=) (gen-neighbours-condition comparator quantity property value remainder '=)
(and (= comp1 &quot;more&quot;) (= comp2 &quot;than&quot;)) (and (= comp1 &quot;more&quot;) (= comp2 &quot;than&quot;))
(gen-neighbours-condition '&gt; quantity property value remainder '&gt;) (gen-neighbours-condition comparator quantity property value remainder '&gt;)
(and (= comp1 &quot;less&quot;) (= comp2 &quot;than&quot;)) (and (= comp1 &quot;less&quot;) (= comp2 &quot;than&quot;))
(gen-neighbours-condition '&lt; quantity property value remainder '&lt;)))))))</pre></td></tr><tr><td class="docs"> (gen-neighbours-condition comparator quantity property value remainder '&lt;)))))))</pre></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(defn parse-some-neighbours-condition </td><td class="codes"><pre class="brush: clojure">(defn parse-some-neighbours-condition
[[SOME NEIGHBOURS &amp; rest]] [[SOME NEIGHBOURS &amp; rest]]
(cond (cond

View file

@ -3124,6 +3124,7 @@ net.brehaut.ClojureTools = (function (SH) {
[mw-engine.world :as world] [mw-engine.world :as world]
[mw-engine.heightmap :as heightmap] [mw-engine.heightmap :as heightmap]
[mw-engine.natural-rules :as rules] [mw-engine.natural-rules :as rules]
[mw-parser.bulk :as compiler]
[hiccup.core :refer [html]] [hiccup.core :refer [html]]
[noir.session :as session]))</pre></td></tr><tr><td class="docs"> [noir.session :as session]))</pre></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(defn format-css-class [statekey] </td><td class="codes"><pre class="brush: clojure">(defn format-css-class [statekey]
@ -3135,12 +3136,13 @@ net.brehaut.ClojureTools = (function (SH) {
[statekey] [statekey]
(format &quot;img/tiles/%s.png&quot; (format-css-class statekey)))</pre></td></tr><tr><td class="docs"> (format &quot;img/tiles/%s.png&quot; (format-css-class statekey)))</pre></td></tr><tr><td class="docs">
</td><td class="codes"><pre class="brush: clojure">(defn format-mouseover [cell] </td><td class="codes"><pre class="brush: clojure">(defn format-mouseover [cell]
(str &quot;State &quot; (:state cell) &quot;; altitude: &quot; (:altitude cell) &quot;; fertility: &quot; (:fertility cell)))</pre></td></tr><tr><td class="docs"><p>Render this world cell as a Hiccup table cell.</p> (str cell))</pre></td></tr><tr><td class="docs"><p>Render this world cell as a Hiccup table cell.</p>
</td><td class="codes"><pre class="brush: clojure">(defn render-cell </td><td class="codes"><pre class="brush: clojure">(defn render-cell
[cell] [cell]
(let [state (:state cell)] (let [state (:state cell)]
[:td {:class (format-css-class state) :title (format-mouseover cell)} [:td {:class (format-css-class state) :title (format-mouseover cell)}
[:img {:alt (world/format-cell cell) :src (format-image-path state)}]]))</pre></td></tr><tr><td class="docs"><p>Render this world row as a Hiccup table row.</p> [:a {:href (format &quot;inspect?x=%d&amp;amp;y=%d&quot; (:x cell) (:y cell))}
[:img {:alt (world/format-cell cell) :src (format-image-path state)}]]]))</pre></td></tr><tr><td class="docs"><p>Render this world row as a Hiccup table row.</p>
</td><td class="codes"><pre class="brush: clojure">(defn render-world-row </td><td class="codes"><pre class="brush: clojure">(defn render-world-row
[row] [row]
(apply vector (cons :tr (map render-cell row))))</pre></td></tr><tr><td class="docs"><p>Render the world implied by the session as a complete HTML page.</p> (apply vector (cons :tr (map render-cell row))))</pre></td></tr><tr><td class="docs"><p>Render the world implied by the session as a complete HTML page.</p>
@ -3152,7 +3154,9 @@ net.brehaut.ClojureTools = (function (SH) {
(world/make-world 20 20) (world/make-world 20 20)
&quot;resources/public/img/20x20/hill.png&quot;) &quot;resources/public/img/20x20/hill.png&quot;)
rules/init-rules)) rules/init-rules))
rules (or (session/get :rules) rules/natural-rules) rules (or (session/get :rules)
(do (session/put! :rules (compiler/compile-file &quot;resources/rulesets/basic.txt&quot;))
(session/get :rules)))
generation (+ (or (session/get :generation) 0) 1) generation (+ (or (session/get :generation) 0) 1)
w2 (engine/transform-world world rules) w2 (engine/transform-world world rules)
] ]

Binary file not shown.

After

Width:  |  Height:  |  Size: 395 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 641 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 160 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 591 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 805 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 368 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 718 B

View file

@ -3,6 +3,7 @@
[mw-engine.world :as world] [mw-engine.world :as world]
[mw-engine.heightmap :as heightmap] [mw-engine.heightmap :as heightmap]
[mw-engine.natural-rules :as rules] [mw-engine.natural-rules :as rules]
[mw-parser.bulk :as compiler]
[hiccup.core :refer [html]] [hiccup.core :refer [html]]
[noir.session :as session])) [noir.session :as session]))
@ -19,14 +20,15 @@
(format "img/tiles/%s.png" (format-css-class statekey))) (format "img/tiles/%s.png" (format-css-class statekey)))
(defn format-mouseover [cell] (defn format-mouseover [cell]
(str "State " (:state cell) "; altitude: " (:altitude cell) "; fertility: " (:fertility cell))) (str cell))
(defn render-cell (defn render-cell
"Render this world cell as a Hiccup table cell." "Render this world cell as a Hiccup table cell."
[cell] [cell]
(let [state (:state cell)] (let [state (:state cell)]
[:td {:class (format-css-class state) :title (format-mouseover cell)} [:td {:class (format-css-class state) :title (format-mouseover cell)}
[:img {:alt (world/format-cell cell) :src (format-image-path state)}]])) [:a {:href (format "inspect?x=%d&amp;y=%d" (:x cell) (:y cell))}
[:img {:alt (world/format-cell cell) :src (format-image-path state)}]]]))
(defn render-world-row (defn render-world-row
"Render this world row as a Hiccup table row." "Render this world row as a Hiccup table row."
@ -42,7 +44,9 @@
(world/make-world 20 20) (world/make-world 20 20)
"resources/public/img/20x20/hill.png") "resources/public/img/20x20/hill.png")
rules/init-rules)) rules/init-rules))
rules (or (session/get :rules) rules/natural-rules) rules (or (session/get :rules)
(do (session/put! :rules (compiler/compile-file "resources/rulesets/basic.txt"))
(session/get :rules)))
generation (+ (or (session/get :generation) 0) 1) generation (+ (or (session/get :generation) 0) 1)
w2 (engine/transform-world world rules) w2 (engine/transform-world world rules)
] ]