diff --git a/docs/codox/mw-engine.render.html b/docs/codox/mw-engine.render.html
new file mode 100644
index 0000000..d929a27
--- /dev/null
+++ b/docs/codox/mw-engine.render.html
@@ -0,0 +1,14 @@
+
+
mw-engine.render
Render a world as HTML.
+
Adapted (simplified) from mw-ui.render-world; this is for visualisation, not interaction.
+
*state-images-relative-path*
dynamic
render-cell
(render-cell cell)
Render this world cell as a Hiccup table cell.
+
render-world-page
(render-world-page world)
(render-world-page world state-images-relative-path)
render-world-row
(render-world-row row)
Render this world row as a Hiccup table row.
+
render-world-table
(render-world-table world)
(render-world-table world state-images-relative-path)
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->html-file
(world->html-file world output-path)
(world->html-file world output-path state-images-relative-path)
\ No newline at end of file
diff --git a/src/cljc/mw_engine/drainage.clj b/src/cljc/mw_engine/drainage.clj
index 9ad5140..d417443 100644
--- a/src/cljc/mw_engine/drainage.clj
+++ b/src/cljc/mw_engine/drainage.clj
@@ -3,7 +3,9 @@
from a heightmap."
:author "Simon Brooke"}
mw-engine.drainage
- (:require [mw-engine.core :refer [run-world]]
+ (:require [clojure.string :refer [replace]]
+ [hiccup2.core :refer [html]]
+ [mw-engine.core :refer [run-world]]
[mw-engine.heightmap :refer [apply-heightmap]]
[mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours
get-neighbours-with-property-value
@@ -221,11 +223,15 @@
:else (throw (ex-info "Invalid cell?"
{:cell cell}))))
+(defn identify-lake
+ [world cell]
+ (or (is-lake? world cell) cell))
+
(defn find-lakes
"Identify cells in this `world` which are lakes."
[world]
(info "find-lakes started.")
- (let [w' (map-world world is-lake?)]
+ (let [w' (map-world world identify-lake)]
(info "find-lakes completed.")
w'))
@@ -235,4 +241,48 @@
[hmap]
(find-lakes (flow-world-nr (rain-world (flood-hollows (apply-heightmap hmap))))))
-;; (run-drainage "resources/heightmaps/20x20/crucible.png")
\ No newline at end of file
+(defn visualise-drainage
+ [world html-file]
+
+ (let [mxf (apply max (map :flow (flatten world)))
+ scf (/ 128 mxf)
+ mxa (apply max (map :altitude (flatten world)))
+ sca (/ 128 mxa)]
+ (spit
+ html-file
+ (replace
+ (str
+ (html [:html
+ [:head
+ [:title "Drainage visualisation"]
+ [:style "table, table tr td {
+ padding: 0.5em;
+ margin: 0.2em;
+ width: 2em;
+ height: 2em;
+ border-collapse: collapse;
+ border: none;}"]]
+ [:body
+ (into [:table]
+ (map
+ #(into [:tr]
+ (map
+ (fn [c]
+ (let [g (- 255 (int (* sca (:altitude c))))]
+ [:td {:style (if (> (:altitude c) 1)
+ (let [blue (int (* scf (or (:flow c) 0)))
+ o (- g blue)]
+ (format "background-color: rgb(%d, %d, %d)"
+ o
+ o
+ (+ g blue)))
+ "background-color: cornflower-blue")
+ :title (format "state %s, x %d, y %d, rainfall %d, flow %d"
+ (:state c) (:x c) (:y c) (:rainfall c) (:flow c))}
+ (or (:rainfall c) " ")]))
+ %))
+ world))]]))
+ "&"
+ "&"))))
+
+(visualise-drainage (run-drainage "resources/heightmaps/20x20/crucible.png") "test.html")
\ No newline at end of file
diff --git a/src/cljc/mw_engine/render.clj b/src/cljc/mw_engine/render.clj
index ba76005..0f00da2 100644
--- a/src/cljc/mw_engine/render.clj
+++ b/src/cljc/mw_engine/render.clj
@@ -5,7 +5,7 @@
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]])
+ (:require [hiccup2.page :refer [xhtml]])
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -50,24 +50,21 @@
"Render this world cell as a Hiccup table cell."
[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 (: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))))
+ (into [: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)))
+ (into [:table] (map render-world-row world))
[:p
(str "Generation " (:generation (first (flatten world))))]])
([world state-images-relative-path]
@@ -92,7 +89,8 @@
(defn world->html-file
([world output-path]
- (spit output-path (str (html (render-world-page world)))))
+ (spit output-path (str (xhtml (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
+ (world->html-file world output-path))))
+