Rationalised functionality into separate namespaces.

src/walkmap/core.clj

@@ -5,159 +5,41 @@
             [clojure.string :as s]
             [hiccup.core :refer [html]]
             [me.raynes.fs :as fs]
-            [org.clojars.smee.binary.core :as b]
+            [taoensso.timbre :as l :refer [info error spy]]
-            [taoensso.timbre :as l :refer [info error spy]])
+            [walkmap.stl :refer [decode-binary-stl]]
-  (:import org.clojars.smee.binary.core.BinaryIO
+            [walkmap.svg :refer [stl->svg]]))
-           java.io.DataInput))
 
-(def vect
+(def ^:dynamic *sea-level*
-  "A codec for vectors within a binary STL file."
+  "The sea level on heightmaps we're currently handling. If characters are to
-  (b/ordered-map
+  be able to swin in the sea, we must model the sea bottom, so we need
-    :x :float-le
+  heightmaps which cover at least the continental shelf. However, the sea
-    :y :float-le
+  bottom is not walkable territory and can be culled from walkmaps.
-    :z :float-le))
 
-(def facet
+  **Note** must be a floating point number. `(= 0 0.0)` returns `false`!"
-  "A codec for a vector within a binary STL file."
+  0.0)
-  (b/ordered-map
-    :normal vect
-    :vertices [vect vect vect]
-    :abc :ushort-le))
 
-(def binary-stl
+(defn ocean?
-  "A codec for binary STL files"
+  "Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?"
-  (b/ordered-map
-   :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
-   :count :uint-le
-   :facets (b/repeated facet)))
-
-(defn decode-binary-stl
-  "Parse a binary STL file from this `filename` and return an STL structure
-  representing its contents.
-
-  **NOTE** that we've no way of verifying that the input file is binary STL
-  data, if it is not this will run but will return garbage."
-  [filename]
-  (let [in (io/input-stream filename)]
-    (b/decode binary-stl in)))
-
-(defn- vect2str [prefix v]
-  (str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))
-
-(defn- facet2str [tri]
-  (str
-      (vect2str "facet normal" (:normal tri))
-      "outer loop\n"
-    (apply str
-      (map
-        #(vect2str "vertex" %)
-        (:vertices tri)))
-    "endloop\nendfacet\n"))
-
-(defn write-ascii-stl
-  "Write an `stl` structure as read by `decode-binary-stl` to this
-  `filename` as ASCII encoded STL."
-  ([filename stl]
-   (let [b (fs/base-name filename true)]
-     (write-ascii-stl
-       filename stl
-       (subs b 0 (or (s/index-of b ".") (count b))))))
-  ([filename stl solidname]
-   (l/debug "Solid name is " solidname)
-   (spit
-     filename
-     (str
-       "solid "
-       solidname
-       (s/trim (:header stl))
-       "\n"
-       (apply
-         str
-         (map
-           facet2str
-           (:facets stl)))
-       "endsolid "
-       solidname
-       "\n"))))
-
-(defn binary-stl-to-ascii
-  "Convert the binary STL file indicated by `in-filename`, and write it to
-  `out-filename`, if specified; otherwise, to a file with the same basename
-  as `in-filename` but the extension `.ascii.stl`."
-  ([in-filename]
-   (let [[_ ext] (fs/split-ext in-filename)]
-     (binary-stl-to-ascii
-       in-filename
-       (str
-         (subs
-           in-filename
-           0
-           (or
-             (s/last-index-of in-filename ".")
-             (count in-filename)))
-         ".ascii"
-         ext))))
-  ([in-filename out-filename]
-   (write-ascii-stl out-filename (decode-binary-stl in-filename))))
-
-(defn- facet-to-svg-poly
   [facet]
-  [:polygon
+  (every?
-   {:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}])
+    #(= % *sea-level*)
+    (map :z (:vertices facet))))
 
-(defn stl-to-svg
+(defn cull-ocean-facets
-  "Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into
+  "Ye cannae walk on water. Remove all facets from this `stl` structure which
-  an in-memory (Dali) SVG structure, and return it."
+  are at sea level."
   [stl]
-  (let [minx (reduce
+  (assoc stl :facets (remove ocean? (:facets stl))))
-               min
-               (map
-                 #(reduce min (map :x (:vertices %)))
-                 (:facets stl)))
-        maxx (reduce
-               max
-               (map
-                 #(reduce max (map :x (:vertices %)))
-                 (:facets stl)))
-        miny (reduce
-               min
-               (map
-                 #(reduce min (map :y (:vertices %)))
-                 (:facets stl)))
-        maxy (reduce
-               max
-               (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-to-svg-poly
-           (:facets stl))))]))
 
-(defn binary-stl-file-to-svg
+(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-to-svg (decode-binary-stl in-filename)))
+   (stl->svg (cull-ocean-facets (decode-binary-stl in-filename))))
   ([in-filename out-filename]
-   (let [s (binary-stl-file-to-svg in-filename)]
+   (let [s (binary-stl-file->svg in-filename)]
      ;; (svg/render-svg s out-filename)
      (spit out-filename (html s))
      s)))
 
-;; (def stl (decode-binary-stl "resources/small_hill.stl"))
-
-;; (facet-to-svg-poly (first (:facets stl)))
-
-;; (map facet-to-svg-poly (:facets stl))
-;; (svg/render-svg (stl-to-svg stl) "frobox.svg")
-;; (binary-stl-file-to-svg "resources/small_hill.stl" "resources/small_hill.svg")

src/walkmap/path.clj

@@ -0,0 +1,29 @@
+(ns walkmap.path
+  "Essentially the specification for things we shall consider to be path."
+  (:require [walkmap.polygon :refer [polygon? vertex?]]))
+
+(defn path?
+  "True if `o` satisfies the conditions for a path. A path shall be a map
+  having the key `:nodes`, whose value shall be a sequence of vertices as
+  defined in `walkmap.polygon`."
+  [o]
+  (let
+    [v (:nodes o)]
+    (and
+      (seq? v)
+      (> (count v) 2)
+      (every? vertex? v))))
+
+(defn polygon->path
+  "If `o` is a polygon, return an equivalent path. What's different about
+  a path is that in polygons there is an implicit edge between the first
+  vertex and the last. In paths, there isn't, so we need to add that
+  edge explicitly.
+
+  If `o` is not a polygon, will throw an exception."
+  [o]
+  (if
+    (polygon? o)
+    (assoc (dissoc o :vertices) :nodes (concat (:vertices o) (list (first (:vertices o)))))
+    (throw (Exception. "Not a polygon!"))))
+

src/walkmap/polygon.clj

@@ -0,0 +1,32 @@
+(ns walkmap.polygon
+  "Essentially the specification for things we shall consider to be polygons.")
+
+(defn vertex?
+  "True if `o` satisfies the conditions for a vertex. That is, essentially,
+  that it must rerpresent a two- or three- dimensional vector. A vertex is
+  shall be a map having at least the keys `:x` and `:y`, where the value of
+  those keys is a number. If the key `:z` is also present, its value must also
+  be a number.
+
+  The name  `vector?` was not used as that would clash with a function of that
+  name in `clojure.core` whose semantics are entirely different."
+  [o]
+  (and
+    (map? o)
+    (number? (:x o))
+    (number? (:y o))
+    (or (nil? (:z o)) (number? (:z o)))))
+
+(defn polygon?
+  "True if `o` satisfies the conditions for a polygon. A polygon shall be a
+  map which has a value for the key `:vertices`, where that value is a sequence
+  of vertices."
+  [o]
+  (let
+    [v (:vertices o)]
+    (and
+      (seq? v)
+      (> (count v) 2)
+      (every? vertex? v))))
+
+

src/walkmap/stl.clj

@@ -0,0 +1,126 @@
+(ns walkmap.stl
+  "Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
+  (:require [clojure.java.io :as io :refer [file output-stream input-stream]]
+            ;; [clojure.string :as s]
+            [me.raynes.fs :as fs]
+            [org.clojars.smee.binary.core :as b]
+            [taoensso.timbre :as l :refer [info error spy]]
+            [walkmap.polygon :refer [polygon?]])
+  (:import org.clojars.smee.binary.core.BinaryIO
+           java.io.DataInput))
+
+(defn stl?
+  "True if `o` is recogniseable as an STL structure. An STL structure must
+  have a key `:facets`, whose value must be a sequence of polygons; and
+  may have a key `:header` whose value should be a string, and/or a key
+  `:count`, whose value should be a positive integer.
+
+  If `verify-count?` is passed and is not `false`, verify that the value of
+  the `:count` header is equal to the number of facets."
+  ([o]
+   (stl? o false))
+  ([o verify-count?]
+   (and
+     (map? o)
+     (:facets o)
+     (every? polygon? (:facets o))
+     (if (:header o) (string? (:header o)) true)
+     (if (:count o) (integer? (:count o)) true)
+     (if verify-count? (= (:count o) (count (:facets o))) true))))
+
+(def vect
+  "A codec for vectors within a binary STL file."
+  (b/ordered-map
+    :x :float-le
+    :y :float-le
+    :z :float-le))
+
+(def facet
+  "A codec for a facet (triangle) within a binary STL file."
+  (b/ordered-map
+    :normal vect
+    :vertices [vect vect vect]
+    :abc :ushort-le))
+
+(def binary-stl
+  "A codec for binary STL files"
+  (b/ordered-map
+   :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
+   :count :uint-le
+   :facets (b/repeated facet)))
+
+(defn decode-binary-stl
+  "Parse a binary STL file from this `filename` and return an STL structure
+  representing its contents.
+
+  **NOTE** that we've no way of verifying that the input file is binary STL
+  data, if it is not this will run but will return garbage."
+  [filename]
+  (let [in (io/input-stream filename)]
+    (b/decode binary-stl in)))
+
+(defn- vect->str [prefix v]
+  (str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))
+
+(defn- facet2str [tri]
+  (str
+    (vect->str "facet normal" (:normal tri))
+    "outer loop\n"
+    (apply str
+           (map
+             #(vect->str "vertex" %)
+             (:vertices tri)))
+    "endloop\nendfacet\n"))
+
+(defn stl->ascii
+  "Return as a string an ASCII rendering of the `stl` structure."
+  ([stl]
+   (stl->ascii stl "unknown"))
+  ([stl solidname]
+   (str
+     "solid "
+     solidname
+     (s/trim (:header stl))
+     "\n"
+     (apply
+       str
+       (map
+         facet2str
+         (:facets stl)))
+     "endsolid "
+     solidname
+     "\n")))
+
+(defn write-ascii-stl
+  "Write an `stl` structure as read by `decode-binary-stl` to this
+  `filename` as ASCII encoded STL."
+  ([filename stl]
+   (let [b (fs/base-name filename true)]
+     (write-ascii-stl
+       filename stl
+       (subs b 0 (or (s/index-of b ".") (count b))))))
+  ([filename stl solidname]
+   (l/debug "Solid name is " solidname)
+   (spit
+     filename
+     (stl->ascii stl solidname))))
+
+(defn binary-stl-to-ascii
+  "Convert the binary STL file indicated by `in-filename`, and write it to
+  `out-filename`, if specified; otherwise, to a file with the same basename
+  as `in-filename` but the extension `.ascii.stl`."
+  ([in-filename]
+   (let [[_ ext] (fs/split-ext in-filename)]
+     (binary-stl-to-ascii
+       in-filename
+       (str
+         (subs
+           in-filename
+           0
+           (or
+             (s/last-index-of in-filename ".")
+             (count in-filename)))
+         ".ascii"
+         ext))))
+  ([in-filename out-filename]
+   (write-ascii-stl out-filename (decode-binary-stl in-filename))))

src/walkmap/svg.clj

@@ -0,0 +1,49 @@
+(ns walkmap.stl
+  "Utility functions for writing stereolithography (STL) files (and possibly,
+  later, other geometry files of interest to us) as scalable vector graphics
+  (SVG)."
+  (:require [clojure.string :as s]
+            [taoensso.timbre :as l :refer [info error spy]]
+            [walkmap.polygon :refer [polygon? vertex?]]))
+
+(defn- facet->svg-poly
+  [facet]
+  [:polygon
+   {:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}])
+
+(defn stl->svg
+  "Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into
+  an in-memory (Dali) SVG structure, and return it."
+  [stl]
+  (let [minx (reduce
+               min
+               (map
+                 #(reduce min (map :x (:vertices %)))
+                 (:facets stl)))
+        maxx (reduce
+               max
+               (map
+                 #(reduce max (map :x (:vertices %)))
+                 (:facets stl)))
+        miny (reduce
+               min
+               (map
+                 #(reduce min (map :y (:vertices %)))
+                 (:facets stl)))
+        maxy (reduce
+               max
+               (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))))]))