254 lines
9.2 KiB
Clojure
254 lines
9.2 KiB
Clojure
(ns cc.journeyman.walkmap.stl
|
|
"Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
|
|
(:require [cc.journeyman.walkmap.ocean :refer [ocean?]]
|
|
[cc.journeyman.walkmap.polygon :refer [centre gradient triangle?]]
|
|
[cc.journeyman.walkmap.superstructure :refer [store]]
|
|
[cc.journeyman.walkmap.tag :refer [tag]]
|
|
[cc.journeyman.walkmap.utils :refer [kind-type truncate]]
|
|
[cc.journeyman.walkmap.vertex :as v :refer [vertex]]
|
|
[clojure.core.matrix :refer [set-current-implementation sub]]
|
|
[clojure.java.io :refer [input-stream]]
|
|
[clojure.string :as s]
|
|
[me.raynes.fs :refer [base-name split-ext]]
|
|
[org.clojars.smee.binary.core :as b]
|
|
[taoensso.timbre :refer [debug]])
|
|
(:import [clojure.lang Keyword]))
|
|
|
|
;; We want to use the `[vectorz](https://github.com/mikera/vectorz-clj)`
|
|
;; implementation of core.matrix.
|
|
(set-current-implementation :vectorz)
|
|
|
|
(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? triangle? (:facets o))
|
|
(if (:header o) (string? (:header o)) true)
|
|
(if (:count o) (integer? (:count o)) true)
|
|
(or (nil? (:kind o)) (= (:kind o) :stl))
|
|
(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 vertex->array
|
|
[v]
|
|
[(:x v) (:y v) (or (:z v) 0)])
|
|
|
|
(defn surface-normal
|
|
"From https://www.khronos.org/opengl/wiki/Calculating_a_Surface_Normal
|
|
```
|
|
Begin Function CalculateSurfaceNormal (Input Triangle) Returns Vector
|
|
|
|
Set Vector U to (Triangle.p2 minus Triangle.p1)
|
|
Set Vector V to (Triangle.p3 minus Triangle.p1)
|
|
|
|
Set Normal.x to (multiply U.y by V.z) minus (multiply U.z by V.y)
|
|
Set Normal.y to (multiply U.z by V.x) minus (multiply U.x by V.z)
|
|
Set Normal.z to (multiply U.x by V.y) minus (multiply U.y by V.x)
|
|
|
|
Returning Normal
|
|
|
|
End Function
|
|
```"
|
|
[triangle]
|
|
(if (triangle? triangle)
|
|
(let
|
|
[vertices (:vertices triangle)
|
|
v1 (vertex->array (nth vertices 0))
|
|
u (sub (vertex->array (nth vertices 1)) v1)
|
|
v (sub (vertex->array (nth vertices 2)) v1)
|
|
x (- (* (nth u 1)(nth v 2)) (* (nth u 2) (nth v 1)))
|
|
y (- (* (nth u 2) (nth v 0)) (* (nth u 0) (nth v 2)))
|
|
z (- (* (nth u 0) (nth v 1)) (* (nth u 1 (nth v 0))))]
|
|
(debug (format "Calculating normal for triangle %s" triangle))
|
|
(vertex x y z))
|
|
(throw (IllegalArgumentException.
|
|
(format "Expected :triangle, found %s" (kind-type triangle))))))
|
|
|
|
(defn ensure-normal
|
|
"Ensure this `triangle` has a normal vector/"
|
|
[triangle]
|
|
(if (triangle? triangle)
|
|
(if (:normal triangle) triangle
|
|
(assoc triangle :normal (surface-normal triangle)))
|
|
(throw (IllegalArgumentException.
|
|
(format "Expected :triangle, found %s" (kind-type triangle))))))
|
|
|
|
(defn canonicalise
|
|
"Objects read in from STL won't have all the keys/values we need them to have.
|
|
`o` may be a map (representing a facet or a vertex), or a sequence of such maps;
|
|
if it isn't recognised it is at present just returned unchanged. `map-kind`, if
|
|
passed, must be a keyword indicating the value represented by the `z` axis
|
|
(defaults to `:height`). It is an error, and an exception will be thrown, if
|
|
`map-kind` is not a keyword."
|
|
([o] (canonicalise o :height))
|
|
([o ^Keyword map-kind]
|
|
(canonicalise o map-kind (v/vertex 1 1 1)))
|
|
([o ^Keyword map-kind scale-vertex]
|
|
(when-not
|
|
(keyword? map-kind)
|
|
(throw (IllegalArgumentException.
|
|
(truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
|
|
(cond
|
|
(and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
|
|
;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
|
|
(:facets o) (assoc o
|
|
:kind :stl
|
|
:walkmap.id/id (or (:walkmap.id/id o)
|
|
(keyword (gensym "stl")))
|
|
:facets (canonicalise (:facets o) map-kind))
|
|
;; if it's a triangle it's almost a facet. All it needs now is a normal
|
|
;; vector
|
|
(triangle? o) (ensure-normal o)
|
|
;; if it has :vertices it's a polygon, but it may not yet conform to
|
|
;; `polygon?`
|
|
(:vertices o) (let [f (gradient
|
|
(centre
|
|
(tag
|
|
(assoc o
|
|
:walkmap.id/id (or
|
|
(:walkmap.id/id o)
|
|
(keyword (gensym "poly")))
|
|
:kind :polygon
|
|
:vertices (canonicalise
|
|
(:vertices o)
|
|
map-kind))
|
|
:facet map-kind)))]
|
|
(if (ocean? f)
|
|
(tag f :ocean :no-traversal)
|
|
f))
|
|
;; if it has a value for :x it's a vertex, but it may not yet conform
|
|
;; to `vertex?`; it should also be scaled using the scale-vertex, if any.
|
|
(:x o) (let [c (v/canonicalise o)]
|
|
(if (v/vertex? scale-vertex)
|
|
(v/vertex* c scale-vertex)
|
|
c))
|
|
;; shouldn't happen
|
|
:else o)))
|
|
|
|
(defn decode-binary-stl
|
|
"Parse a binary STL file from this `filename` and return an STL structure
|
|
representing its contents. `map-kind`, if passed, must be a keyword
|
|
or sequence of keywords indicating the semantic value represented by the `z`
|
|
axis (defaults to `:height`).
|
|
|
|
If `superstructure` is supplied and is a map, the generated STL structure
|
|
will be stored in that superstructure, which will be returned.
|
|
|
|
If `scale-vertex` is supplied, it must be a three dimensional vertex (i.e.
|
|
the `:z` key must have a numeric value) representing the amount by which
|
|
each of the vertices read from the STL will be scaled.
|
|
|
|
It is an error, and an exception will be thrown, if `map-kind` is not a
|
|
keyword or sequence of keywords.
|
|
|
|
**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."
|
|
([^String filename]
|
|
(decode-binary-stl filename :height))
|
|
([^String filename ^Keyword map-kind]
|
|
(decode-binary-stl filename map-kind nil))
|
|
([^String filename ^Keyword mapkind superstucture]
|
|
(decode-binary-stl filename mapkind superstucture (v/vertex 1 1 1)))
|
|
([^String filename ^Keyword map-kind superstructure scale-vertex]
|
|
(let [in (input-stream filename)
|
|
stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
|
|
(if
|
|
(map? superstructure)
|
|
(store stl superstructure)
|
|
stl))))
|
|
|
|
(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"
|
|
(s/join
|
|
(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 "
|
|
(or solidname
|
|
(when (:header stl)(s/trim (:header stl))))
|
|
"\n"
|
|
(s/join
|
|
(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 (base-name filename true)]
|
|
(write-ascii-stl
|
|
filename stl
|
|
(subs b 0 (or (s/index-of b ".") (count b))))))
|
|
([filename stl solidname]
|
|
(debug (format "Writing STL to '%s'; solid name is %s" filename 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] (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))))
|