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.polygon :refer [polygon?]]
009 [walkmap.vertex :refer [canonicalise-vertex]])
010 (:import org.clojars.smee.binary.core.BinaryIO
011 java.io.DataInput))
012
013 (defn stl?
014 "True if `o` is recogniseable as an STL structure. An STL structure must
015 have a key `:facets`, whose value must be a sequence of polygons; and
016 may have a key `:header` whose value should be a string, and/or a key
017 `:count`, whose value should be a positive integer.
018
019 If `verify-count?` is passed and is not `false`, verify that the value of
020 the `:count` header is equal to the number of facets."
021 ([o]
022 (stl? o false))
023 ([o verify-count?]
024 (and
025 (map? o)
026 (:facets o)
027 (every? polygon? (:facets o))
028 (if (:header o) (string? (:header o)) true)
029 (if (:count o) (integer? (:count o)) true)
030 (or (nil? (:kind o)) (= (:kind o) :stl))
031 (if verify-count? (= (:count o) (count (:facets o))) true))))
032
033 (def vect
034 "A codec for vectors within a binary STL file."
035 (b/ordered-map
036 :x :float-le
037 :y :float-le
038 :z :float-le))
039
040 (def facet
041 "A codec for a facet (triangle) within a binary STL file."
042 (b/ordered-map
043 :normal vect
044 :vertices [vect vect vect]
045 :abc :ushort-le))
046
047 (def binary-stl
048 "A codec for binary STL files"
049 (b/ordered-map
050 :header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
051 :count :uint-le
052 :facets (b/repeated facet)))
053
054 (defn canonicalise
055 "Objects read in from STL won't have all the keys/values we need them to have."
056 [o]
057 (cond
058 (and (coll? o) (not (map? o))) (map canonicalise o)
059 ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
060 (:facets o) (assoc o
061 :kind :stl
062 :id (or (:id o) (keyword (gensym "stl")))
063 :facets (canonicalise (:facets o)))
064 ;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?`
065 (:vertices o) (assoc o
066 :id (or (:id o) (keyword (gensym "poly")))
067 :kind :polygon
068 :vertices (canonicalise (:vertices o)))
069 ;; if it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?`
070 (:x o) (canonicalise-vertex o)
071 ;; shouldn't happen
072 :else o))
073
074 (defn decode-binary-stl
075 "Parse a binary STL file from this `filename` and return an STL structure
076 representing its contents.
077
078 **NOTE** that we've no way of verifying that the input file is binary STL
079 data, if it is not this will run but will return garbage."
080 [filename]
081 (let [in (io/input-stream filename)]
082 (canonicalise (b/decode binary-stl in))))
083
084 (defn- vect->str [prefix v]
085 (str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))
086
087 (defn- facet2str [tri]
088 (str
089 (vect->str "facet normal" (:normal tri))
090 "outer loop\n"
091 (apply str
092 (map
093 #(vect->str "vertex" %)
094 (:vertices tri)))
095 "endloop\nendfacet\n"))
096
097 (defn stl->ascii
098 "Return as a string an ASCII rendering of the `stl` structure."
099 ([stl]
100 (stl->ascii stl "unknown"))
101 ([stl solidname]
102 (str
103 "solid "
104 solidname
105 (s/trim (:header stl))
106 "\n"
107 (apply
108 str
109 (map
110 facet2str
111 (:facets stl)))
112 "endsolid "
113 solidname
114 "\n")))
115
116 (defn write-ascii-stl
117 "Write an `stl` structure as read by `decode-binary-stl` to this
118 `filename` as ASCII encoded STL."
119 ([filename stl]
120 (let [b (fs/base-name filename true)]
121 (write-ascii-stl
122 filename stl
123 (subs b 0 (or (s/index-of b ".") (count b))))))
124 ([filename stl solidname]
125 (l/debug "Solid name is " solidname)
126 (spit
127 filename
128 (stl->ascii stl solidname))))
129
130 (defn binary-stl-to-ascii
131 "Convert the binary STL file indicated by `in-filename`, and write it to
132 `out-filename`, if specified; otherwise, to a file with the same basename
133 as `in-filename` but the extension `.ascii.stl`."
134 ([in-filename]
135 (let [[_ ext] (fs/split-ext in-filename)]
136 (binary-stl-to-ascii
137 in-filename
138 (str
139 (subs
140 in-filename
141 0
142 (or
143 (s/last-index-of in-filename ".")
144 (count in-filename)))
145 ".ascii"
146 ext))))
147 ([in-filename out-filename]
148 (write-ascii-stl out-filename (decode-binary-stl in-filename))))