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