Work in support of new development in the-great-game, q.v.

.gitignore

@@ -16,3 +16,4 @@ eastwood.txt
 .nrepl-port
 .classpath
 
+test.html

project.clj

@@ -11,7 +11,8 @@
                  [org.clojure/tools.namespace "1.4.4"]
                  [com.taoensso/timbre "6.2.1"]
                  [fivetonine/collage "0.3.0"]
-                 [hiccup "1.0.5"]
+                 ;; [hiccup "1.0.5"]
+                 [hiccup "2.0.0-RC3"]
                  [net.mikera/imagez "0.12.0"]]
   :description "Cellular automaton world builder."
   :jvm-opts ["-Xmx4g"]

src/cljc/mw_engine/core.clj

@@ -49,6 +49,11 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(def ^:dynamic *with-history*
+  "I suspect that caching history on the cells is greatly worsening the
+   memory problems. Make it optional, but by default false."
+  false)
+
 (defn apply-rule
   "Apply a single `rule` to a `cell`. What this is about is that I want to be able,
    for debugging purposes, to tag a cell with the rule text of the rule which
@@ -67,7 +72,9 @@
                             (.getMessage e)
                             (-> rule meta :lisp)
                             cell))))]
-    (add-history-event result rule)))
+    (if *with-history*
+      (add-history-event result rule)
+      result)))
 
 (defn- apply-rules
   "Derive a cell from this `cell` of this `world` by applying these `rules`."

src/cljc/mw_engine/flow.clj

@@ -138,8 +138,8 @@
    rules))
 
 (defn plan-flows
-  "Plan, but do not execute, all the flows in this `world` implied by these
-   those of these `rules` (which are expected to be pre-compiled) which are
+  "Plan, but do not execute, all the flows in this `world` implied by those of 
+   these `rules` (which are expected to be pre-compiled) which are
    flow rules. Return the list of plans, as flow objects."
   [world rules]
   (remove nil?

src/cljc/mw_engine/render.clj

@@ -0,0 +1,98 @@
+(ns mw-engine.render
+  "Render a world as HTML.
+   
+   Adapted (simplified) from mw-ui.render-world; this is for visualisation, not
+   interaction."
+  ;; TODO: but possibly it would be better if there is to be a newer version of
+  ;; mw-ui, to base it on this.
+  (:require [hiccup2.core :refer [html]])
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License
+;;;; as published by the Free Software Foundation; either version 2
+;;;; of the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+;;;; USA.
+;;;;
+;;;; Copyright (C) 2024 Simon Brooke
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:dynamic *state-images-relative-path* "img/tiles/")
+
+(defn format-css-class
+  "Format this statekey, assumed to be a keyword indicating a state in the
+   world, into a CSS class"
+  [statekey]
+  (name statekey))
+
+(defn format-image-path
+  "Render this statekey, assumed to be a keyword indicating a state in the
+   world, into a path which should recover the corresponding image file."
+  [statekey]
+  (format "%s%s.png" *state-images-relative-path* (format-css-class statekey)))
+
+(defn format-mouseover [cell]
+  (str cell))
+
+(defn render-cell
+  "Render this world cell as a Hiccup table cell."
+  [cell]
+  (let [state (:state cell)]
+    [:td {:class (format-css-class state) :title (format-mouseover cell)}
+     
+      [:img {:alt (:state cell) :src (format-image-path state)}]]))
+
+
+(defn render-world-row
+  "Render this world row as a Hiccup table row."
+  [row]
+  (apply vector (cons :tr (map render-cell row))))
+
+(defn render-world-table
+  "Render this `world` as a complete HTML table in a DIV. If 
+   `state-images-relative-path` is passed, use that to override the default path."
+  ([world] 
+    [:div {:class "world"}
+     (apply vector
+            (cons :table
+                  (map render-world-row world)))
+     [:p
+      (str "Generation " (:generation (first (flatten world))))]])
+  ([world state-images-relative-path]
+   (binding [*state-images-relative-path* state-images-relative-path]
+     (render-world-table world))))
+
+(defn render-world-page
+  ([world]
+   [:html
+    [:head
+     [:title "Rendered world"]
+     [:style "div.world table, div.world table tr td {
+	padding: 0;
+	margin: 0;
+	border-collapse: collapse;
+	border: none;}"]]
+    [:body
+     (render-world-table world)]])
+  ([world state-images-relative-path]
+   (binding [*state-images-relative-path* state-images-relative-path]
+     (render-world-page world))))
+
+(defn world->html-file
+  ([world output-path]
+  (spit output-path (str (html (render-world-page world)))))
+  ([world output-path state-images-relative-path]
+   (binding [*state-images-relative-path* state-images-relative-path]
+     (world->html-file world output-path))))

src/cljc/mw_engine/world.clj

@@ -77,16 +77,20 @@
   "Truncate the print name of the state of this cell to at most limit characters."
   [cell limit]
   (let [s (:state cell)]
-    (cond (> (count (str s)) limit) (subs s 0 limit)
-          :else s)))
+    (try
+      (cond (> (count (str s)) limit) (subs (name s) 0 limit)
+          :else s)
+      (catch Exception any 
+        (throw (ex-info (.getMessage any) 
+                        {:cell cell
+                         :limit limit
+                         :exception-class (.getClass any)}))))))
 
 (defn format-cell
   "Return a formatted string summarising the current state of this cell."
   [cell]
-  (format "%10s(%2d/%2d)"
-          (truncate-state cell 10)
-          (population cell :deer)
-          (population cell :wolves)))
+  (format "%10s"
+          (truncate-state cell 10)))
 
 (defn- format-world-row
   "Format one row in the state of a world for printing."

test/mw_engine/core_test.clj

@@ -1,12 +1,13 @@
 (ns mw-engine.core-test
   (:require [clojure.test :refer [deftest is testing]]
-            [mw-engine.core :refer [apply-rule transform-world]]
+            [mw-engine.core :refer [*with-history* apply-rule transform-world]]
             [mw-engine.utils :refer [map-world]]
             [mw-engine.world :refer [make-world]]))
 
 (deftest apply-rule-test
   (testing "Application of a single rule"
-    (let [afn (vary-meta
+    (binding [*with-history* true]
+      (let [afn (vary-meta
                (eval
                (fn [cell _world]
                  (cond
@@ -19,7 +20,21 @@
       (is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
           "Rule should fire when state is correct") 
       (is (seq? (:history (apply-rule nil {:state :new} afn)))
-          "Event cached on history of cell"))))
+          "Event cached on history of cell")))
+    (binding [*with-history* false]
+      (let [afn (vary-meta
+                 (eval
+                  (fn [cell _world]
+                    (cond
+                      (= (:state cell) :new)
+                      (merge cell {:state :grassland}))))
+                 merge {:rule-type :production
+                        :rule "Test source"})
+            modified-cell (apply-rule nil {:state :new} afn)] 
+        (is (= (:state modified-cell) :grassland)
+            "Rule should fire when state is correct")
+        (is (nil? (:history modified-cell))
+            "No event cached on history of cell")))))
 
 (deftest transform-world-tests
   (testing "Application of a single rule"