simon/walkmap
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Rationalised functionality into separate namespaces.

Browse source
This commit is contained in:
Simon Brooke 2020-05-24 12:31:19 +01:00
parent 69fd075acc
commit 8a2cb942e6
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
5 changed files with 258 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

162
src/walkmap/core.clj
View file

@ -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
View 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
View 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
View 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
View 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))))]))