Investigation of Dali performance issue

src/walkmap/core.clj

@@ -1,44 +1,9 @@
 (ns walkmap.core
-  "At this stage, primarily utility functions dealing with stereolithography
-  (STL) files. Not a stable API yet!"
+  "This namespace mostly gets used as a scratchpad for ideas which haven't yet
+  solidified."
   (:require [clojure.java.io :as io :refer [file output-stream input-stream]]
             [clojure.string :as s]
             [hiccup.core :refer [html]]
             [me.raynes.fs :as fs]
-            [taoensso.timbre :as l :refer [info error spy]]
-            [walkmap.stl :refer [decode-binary-stl]]
-            [walkmap.svg :refer [stl->svg]]))
-
-(def ^:dynamic *sea-level*
-  "The sea level on heightmaps we're currently handling. If characters are to
-  be able to swin in the sea, we must model the sea bottom, so we need
-  heightmaps which cover at least the continental shelf. However, the sea
-  bottom is not walkable territory and can be culled from walkmaps.
-
-  **Note** must be a floating point number. `(= 0 0.0)` returns `false`!"
-  0.0)
-
-(defn ocean?
-  "Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?"
-  [facet]
-  (every?
-    #(= % *sea-level*)
-    (map :z (:vertices facet))))
-
-(defn cull-ocean-facets
-  "Ye cannae walk on water. Remove all facets from this `stl` structure which
-  are at sea level."
-  [stl]
-  (assoc stl :facets (remove ocean? (:facets stl))))
-
-(defn binary-stl-file->svg
-  "Given only an `in-filename`, parse the indicated file, expected to be
-  binary STL, and return an equivalent SVG structure. Given both `in-filename`
-  and `out-filename`, as side-effect write the SVG to the indicated output file."
-  ([in-filename]
-   (stl->svg (cull-ocean-facets (decode-binary-stl in-filename))))
-  ([in-filename out-filename]
-   (let [s (binary-stl-file->svg in-filename)]
-     (spit out-filename (html s))
-     s)))
+            [taoensso.timbre :as l :refer [info error spy]]))
 

src/walkmap/ocean.clj

@@ -0,0 +1,24 @@
+(ns walkmap.ocean
+  "Deal with (specifically, at this stage, cull) ocean areas")
+
+(def ^:dynamic *sea-level*
+  "The sea level on heightmaps we're currently handling. If characters are to
+  be able to swin in the sea, we must model the sea bottom, so we need
+  heightmaps which cover at least the continental shelf. However, the sea
+  bottom is not walkable territory and can be culled from walkmaps.
+
+  **Note** must be a floating point number. `(= 0 0.0)` returns `false`!"
+  0.0)
+
+(defn ocean?
+  "Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?"
+  [facet]
+  (every?
+    #(= % *sea-level*)
+    (map :z (:vertices facet))))
+
+(defn cull-ocean-facets
+  "Ye cannae walk on water. Remove all facets from this `stl` structure which
+  are at sea level."
+  [stl]
+  (assoc stl :facets (remove ocean? (:facets stl))))

src/walkmap/svg.clj

@@ -3,15 +3,68 @@
   later, other geometry files of interest to us) as scalable vector graphics
   (SVG)."
   (:require [clojure.string :as s]
+            [dali.io :as neatly-folded-clock]
+            [hiccup.core :refer [html]]
             [taoensso.timbre :as l :refer [info error spy]]
+            [walkmap.ocean :refer [cull-ocean-facets]]
             [walkmap.polygon :refer [polygon?]]
+            [walkmap.stl :refer [decode-binary-stl]]
             [walkmap.vertex :refer [vertex?]]))
 
+(def ^:dynamic *preferred-svg-render*
+  "Mainly for debugging dali; switch SVG renderer to use. Expected values:
+  `:dali`, `:hiccup`."
+  :dali)
+
 (defn- facet->svg-poly
+  ;; When we use this version of facet->svg-poly with the Dali renderer, it's
+  ;; still (for the isle_of_man map) 10 times slower than hiccup, also using
+  ;; this version (890.863814 msecs vs 86.904891 msecs
   [facet]
   [:polygon
    {:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}])
 
+(defn- dali-facet->svg-poly
+  [facet]
+  (vec
+    (cons
+      :polygon
+      (map #(vec (list (:x %) (:y %))) (:vertices facet)))))
+
+(defn dali-stl->svg
+  "Format this `stl` as SVG for the `hiccup` renderer on a page with these
+  bounds."
+  [stl minx maxx miny maxy]
+  [:dali/page
+   {:xmlns "http://www.w3.org/2000/svg"
+    :version "1.2"
+    :width (- maxx minx)
+    :height (- maxy miny)
+    :viewBox (s/join " " (map str [minx miny maxx maxy]))}
+   (vec
+     (cons
+       :g
+       (map
+         dali-facet->svg-poly
+         (:facets stl))))])
+
+(defn hiccup-stl->svg
+  "Format this `stl` as SVG for the `hiccup` renderer on a page with these
+  bounds."
+  [stl minx maxx miny maxy]
+  [:svg
+   {:xmlns "http://www.w3.org/2000/svg"
+    :version "1.2"
+    :width (- maxx minx)
+    :height (- maxy miny)
+    :viewBox (s/join " " (map str [minx miny maxx maxy]))}
+   (vec
+     (cons
+       :g
+       (map
+         facet->svg-poly
+         (:facets stl))))])
+
 (defn stl->svg
   "Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into
   an in-memory hiccup representation of SVG structure, and return it."
@@ -36,15 +89,23 @@
                (map
                  #(reduce max (map :y (:vertices %)))
                  (:facets stl)))]
-    [:svg
-     {:xmlns "http://www.w3.org/2000/svg"
-      :version "1.2"
-      :width (- maxx minx)
-      :height (- maxy miny)
-      :viewBox (s/join " " (map str [minx miny maxx maxy]))}
-     (vec
-       (cons
-         :g
-         (map
-           facet->svg-poly
-           (:facets stl))))]))
+    (l/info "Generating SVG for " *preferred-svg-render* " renderer")
+    (case *preferred-svg-render*
+      :hiccup (hiccup-stl->svg stl minx maxx miny maxy)
+      :dali (dali-stl->svg stl minx maxx miny maxy)
+      (throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))))
+
+(defn binary-stl-file->svg
+  "Given only an `in-filename`, parse the indicated file, expected to be
+  binary STL, and return an equivalent SVG structure. Given both `in-filename`
+  and `out-filename`, as side-effect write the SVG to the indicated output file."
+  ([in-filename]
+   (stl->svg (cull-ocean-facets (decode-binary-stl in-filename))))
+  ([in-filename out-filename]
+   (let [s (binary-stl-file->svg in-filename)]
+     (l/info "Emitting SVG with " *preferred-svg-render* " renderer")
+     (case *preferred-svg-render*
+       :dali (neatly-folded-clock/render-svg s out-filename)
+       :hiccup (spit out-filename (html s))
+       (throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))
+     s)))