diff --git a/.gitignore b/.gitignore index ea35471..08cf6ba 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ eastwood.txt .nrepl-port .classpath +test.html \ No newline at end of file diff --git a/project.clj b/project.clj index f3885f4..02eabd2 100644 --- a/project.clj +++ b/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"] diff --git a/src/cljc/mw_engine/core.clj b/src/cljc/mw_engine/core.clj index 1471c94..11cf114 100644 --- a/src/cljc/mw_engine/core.clj +++ b/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`." diff --git a/src/cljc/mw_engine/flow.clj b/src/cljc/mw_engine/flow.clj index e64a0d3..8b0f0d5 100644 --- a/src/cljc/mw_engine/flow.clj +++ b/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? diff --git a/src/cljc/mw_engine/render.clj b/src/cljc/mw_engine/render.clj new file mode 100644 index 0000000..2416a76 --- /dev/null +++ b/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)))) \ No newline at end of file diff --git a/src/cljc/mw_engine/world.clj b/src/cljc/mw_engine/world.clj index ed769a0..00b4024 100644 --- a/src/cljc/mw_engine/world.clj +++ b/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." diff --git a/test/mw_engine/core_test.clj b/test/mw_engine/core_test.clj index ae0742a..dbe2add 100644 --- a/test/mw_engine/core_test.clj +++ b/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"