001 (ns walkmap.stl
002 "Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
003 (:require [clojure.java.io :as io :refer [file output-stream input-stream]]
004 [clojure.string :as s]
005 [me.raynes.fs :as fs]
006 [org.clojars.smee.binary.core :as b]
007 [taoensso.timbre :as l :refer [info error spy]]
008 [walkmap.edge :as e]
009 [walkmap.polygon :refer [polygon?]]
010 [walkmap.tag :refer [tag]]
011 [walkmap.vertex :as v])
012 (:import org.clojars.smee.binary.core.BinaryIO
013 java.io.DataInput))
014
015 (defn stl?
016 "True if `o` is recogniseable as an STL structure. An STL structure must
017 have a key `:facets`, whose value must be a sequence of polygons; and
018 may have a key `:header` whose value should be a string, and/or a key
019 `:count`, whose value should be a positive integer.
020
021 If `verify-count?` is passed and is not `false`, verify that the value of
022 the `:count` header is equal to the number of facets."
023 ([o]
024 (stl? o false))
025 ([o verify-count?]
026 (and
027 (map? o)
028 (:facets o)
029 (every? polygon? (:facets o))
030 (if (:header o) (string? (:header o)) true)
031 (if (:count o) (integer? (:count o)) true)
032 (or (nil? (:kind o)) (= (:kind o) :stl))
033 (if verify-count? (= (:count o) (count (:facets o))) true))))
034
035 (def vect
036 "A codec for vectors within a binary STL file."
037 (b/ordered-map
038 :x :float-le
039 :y :float-le
040 :z :float-le))
041
042 (def facet
043 "A codec for a facet (triangle) within a binary STL file."
044 (b/ordered-map
045 :normal vect
046 :vertices [vect vect vect]
047 :abc :ushort-le))
048
049 (def binary-stl
050 "A codec for binary STL files"
051 (b/ordered-map
052 :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
053 :count :uint-le
054 :facets (b/repeated facet)))
055
056 (defn centre
057 "Return a canonicalised `facet` (i.e. a triangular polygon) with an added
058 key `:centre` whose value represents the centre of this facet in 3
059 dimensions. This only works for triangles, so is here not in
060 `walkmap.polygon`. It is an error (although no exception is currently
061 thrown) if the object past is not a triangular polygon."
062 [facet]
063 (let [vs (:vertices facet)
064 v1 (first vs)
065 opposite (e/edge (nth vs 1) (nth vs 2))
066 oc (e/centre opposite)]
067 (assoc
068 facet
069 :centre
070 (v/vertex
071 (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
072 (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
073 (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
074
075 (defn canonicalise
076 "Objects read in from STL won't have all the keys/values we need them to have.
077 `o` may be a map (representing a facet or a vertex), or a sequence of such maps;
078 if it isn't recognised it is at present just returned unchanged. `map-kind`, if
079 passed, must be a keyword indicating the value represented by the `z` axis
080 (defaults to `:height`). It is an error, and an exception will be thrown, if
081 `map-kind` is not a keyword."
082 ([o] (canonicalise o :height))
083 ([o map-kind]
084 (when-not
085 (keyword? map-kind)
086 (throw (IllegalArgumentException.
087 (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
088 (cond
089 (and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
090 ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
091 (:facets o) (assoc o
092 :kind :stl
093 :id (or (:id o) (keyword (gensym "stl")))
094 :facets (canonicalise (:facets o) map-kind))
095 ;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
096 (:vertices o) (centre
097 (tag
098 (assoc o
099 :id (or (:id o) (keyword (gensym "poly")))
100 :kind :polygon
101 :vertices (canonicalise (:vertices o) map-kind))
102 :facet map-kind))
103 ;; if it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?`
104 (:x o) (v/canonicalise o)
105 ;; shouldn't happen
106 :else o)))
107
108 (defn decode-binary-stl
109 "Parse a binary STL file from this `filename` and return an STL structure
110 representing its contents. `map-kind`, if passed, must be a keyword
111 indicating the value represented by the `z` axis (defaults to `:height`).
112 It is an error, and an exception will be thrown, if `map-kind` is not a
113 keyword.
114
115 **NOTE** that we've no way of verifying that the input file is binary STL
116 data, if it is not this will run but will return garbage."
117 ([filename]
118 (decode-binary-stl filename :height))
119 ([filename map-kind]
120 (when-not
121 (keyword? map-kind)
122 (throw (IllegalArgumentException.
123 (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
124 (let [in (io/input-stream filename)]
125 (canonicalise (b/decode binary-stl in) map-kind))))
126
127 (defn- vect->str [prefix v]
128 (str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))
129
130 (defn- facet2str [tri]
131 (str
132 (vect->str "facet normal" (:normal tri))
133 "outer loop\n"
134 (apply str
135 (map
136 #(vect->str "vertex" %)
137 (:vertices tri)))
138 "endloop\nendfacet\n"))
139
140 (defn stl->ascii
141 "Return as a string an ASCII rendering of the `stl` structure."
142 ([stl]
143 (stl->ascii stl "unknown"))
144 ([stl solidname]
145 (str
146 "solid "
147 solidname
148 (s/trim (:header stl))
149 "\n"
150 (apply
151 str
152 (map
153 facet2str
154 (:facets stl)))
155 "endsolid "
156 solidname
157 "\n")))
158
159 (defn write-ascii-stl
160 "Write an `stl` structure as read by `decode-binary-stl` to this
161 `filename` as ASCII encoded STL."
162 ([filename stl]
163 (let [b (fs/base-name filename true)]
164 (write-ascii-stl
165 filename stl
166 (subs b 0 (or (s/index-of b ".") (count b))))))
167 ([filename stl solidname]
168 (l/debug "Solid name is " solidname)
169 (spit
170 filename
171 (stl->ascii stl solidname))))
172
173 (defn binary-stl-to-ascii
174 "Convert the binary STL file indicated by `in-filename`, and write it to
175 `out-filename`, if specified; otherwise, to a file with the same basename
176 as `in-filename` but the extension `.ascii.stl`."
177 ([in-filename]
178 (let [[_ ext] (fs/split-ext in-filename)]
179 (binary-stl-to-ascii
180 in-filename
181 (str
182 (subs
183 in-filename
184 0
185 (or
186 (s/last-index-of in-filename ".")
187 (count in-filename)))
188 ".ascii"
189 ext))))
190 ([in-filename out-filename]
191 (write-ascii-stl out-filename (decode-binary-stl in-filename))))