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