Rationalised functionality into separate namespaces.
This commit is contained in:
parent
69fd075acc
commit
8a2cb942e6
|
|
@ -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")
|
||||
|
|
|
|||
29
src/walkmap/path.clj
Normal file
29
src/walkmap/path.clj
Normal file
|
|
@ -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!"))))
|
||||
|
||||
32
src/walkmap/polygon.clj
Normal file
32
src/walkmap/polygon.clj
Normal file
|
|
@ -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))))
|
||||
|
||||
|
||||
126
src/walkmap/stl.clj
Normal file
126
src/walkmap/stl.clj
Normal file
|
|
@ -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))))
|
||||
49
src/walkmap/svg.clj
Normal file
49
src/walkmap/svg.clj
Normal file
|
|
@ -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))))]))
|
||||
Loading…
Reference in a new issue