diff --git a/src/walkmap/core.clj b/src/walkmap/core.clj index 4ce52f4..32b96d8 100644 --- a/src/walkmap/core.clj +++ b/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]]) - (:import org.clojars.smee.binary.core.BinaryIO - java.io.DataInput)) + [taoensso.timbre :as l :refer [info error spy]] + [walkmap.stl :refer [decode-binary-stl]] + [walkmap.svg :refer [stl->svg]])) -(def vect - "A codec for vectors within a binary STL file." - (b/ordered-map - :x :float-le - :y :float-le - :z :float-le)) +(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. -(def facet - "A codec for a vector within a binary STL file." - (b/ordered-map - :normal vect - :vertices [vect vect vect] - :abc :ushort-le)) + **Note** must be a floating point number. `(= 0 0.0)` returns `false`!" + 0.0) -(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- 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 +(defn ocean? + "Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?" [facet] - [:polygon - {:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}]) + (every? + #(= % *sea-level*) + (map :z (:vertices facet)))) -(defn stl-to-svg - "Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into - an in-memory (Dali) SVG structure, and return it." +(defn cull-ocean-facets + "Ye cannae walk on water. Remove all facets from this `stl` structure which + are at sea level." [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-to-svg-poly - (:facets stl))))])) + (assoc stl :facets (remove ocean? (: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") diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj new file mode 100644 index 0000000..03af49e --- /dev/null +++ b/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!")))) + diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj new file mode 100644 index 0000000..d000994 --- /dev/null +++ b/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)))) + + diff --git a/src/walkmap/stl.clj b/src/walkmap/stl.clj new file mode 100644 index 0000000..e6926d2 --- /dev/null +++ b/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)))) diff --git a/src/walkmap/svg.clj b/src/walkmap/svg.clj new file mode 100644 index 0000000..f656027 --- /dev/null +++ b/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))))]))