From 819aa0fbc4d0fb11d44c4a24621872fcce134a8a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 31 May 2020 10:33:56 +0100 Subject: [PATCH] Added: scaling and storing STL; beginnings of search --- src/walkmap/polygon.clj | 48 +++++++++++++++++++-- src/walkmap/stl.clj | 79 +++++++++++++++++++--------------- src/walkmap/superstructure.clj | 17 +++++++- src/walkmap/vertex.clj | 16 ++++++- 4 files changed, 119 insertions(+), 41 deletions(-) diff --git a/src/walkmap/polygon.clj b/src/walkmap/polygon.clj index e3c42b9..ab6420e 100644 --- a/src/walkmap/polygon.clj +++ b/src/walkmap/polygon.clj @@ -2,8 +2,9 @@ "Essentially the specification for things we shall consider to be polygons." (:require [clojure.string :as s] [walkmap.edge :as e] + [walkmap.tag :as t] [walkmap.utils :refer [kind-type]] - [walkmap.vertex :refer [vertex?]])) + [walkmap.vertex :refer [vertex vertex?]])) (defn polygon? "True if `o` satisfies the conditions for a polygon. A polygon shall be a @@ -20,22 +21,26 @@ (or (nil? (:kind o)) (= (:kind o) :polygon))))) (defn triangle? + "True if `o` satisfies the conditions for a triangle. A triangle shall be a + polygon with exactly three vertices." [o] (and (coll? o) (= (count (:vertices o)) 3))) (defn polygon + "Return a polygon constructed from these `vertices`." [vertices] (when-not (every? vertex? vertices) (throw (IllegalArgumentException. (str - "Each item on path must be a vertex: " + "Each item on vertices must be a vertex: " (s/join " " (map kind-type (remove vertex? vertices))))))) {:vertices vertices :walkmap.id/id (keyword (gensym "poly")) :kind :polygon}) (defn gradient - "Return a unit vector representing the gradient across `triangle`." + "Return a polygon like `triangle` but with a key `:gradient` whose value is a + unit vector representing the gradient across `triangle`." [triangle] (when-not (triangle? triangle) (throw (IllegalArgumentException. @@ -43,5 +48,40 @@ (let [order (sort #(max (:z %1) (:z %2)) (:vertices triangle)) highest (first order) lowest (last order)] - (e/unit-vector (e/edge lowest highest)))) + (assoc triangle :gradient (e/unit-vector (e/edge lowest highest))))) + +(defn triangle-centre + "Return a canonicalised `facet` (i.e. a triangular polygon) with an added + key `:centre` whose value represents the centre of this facet in 3 + dimensions. This only works for triangles, so is here not in + `walkmap.polygon`. It is an error (although no exception is currently + thrown) if the object past is not a triangular polygon." + [facet] + (when-not (triangle? facet) + (throw (IllegalArgumentException. + (s/join " " ["Must be a triangle:" (kind-type facet)])))) + (let [vs (:vertices facet) + v1 (first vs) + opposite (e/edge (nth vs 1) (nth vs 2)) + oc (e/centre opposite)] + (assoc + facet + :centre + (vertex + (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3)) + (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3)) + (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3)))))) + +(defn centre + [poly] + (when-not (polygon? poly) + (throw (IllegalArgumentException. + (s/join " " ["Must be a polygon:" (kind-type poly)])))) + (case (count (:vertices poly)) + 3 (triangle-centre poly) + ;; else + (throw + (UnsupportedOperationException. + "The general case of centre for polygons is not yet implemented.")))) + diff --git a/src/walkmap/stl.clj b/src/walkmap/stl.clj index 16aaf95..5e5da98 100644 --- a/src/walkmap/stl.clj +++ b/src/walkmap/stl.clj @@ -4,9 +4,10 @@ [clojure.string :as s] [me.raynes.fs :as fs] [org.clojars.smee.binary.core :as b] - [taoensso.timbre :as l :refer [info error spy]] + [taoensso.timbre :as l] [walkmap.edge :as e] - [walkmap.polygon :refer [polygon?]] + [walkmap.polygon :refer [centre gradient polygon?]] + [walkmap.superstructure :refer [store]] [walkmap.tag :refer [tag]] [walkmap.utils :as u] [walkmap.vertex :as v]) @@ -54,25 +55,6 @@ :count :uint-le :facets (b/repeated facet))) -(defn centre - "Return a canonicalised `facet` (i.e. a triangular polygon) with an added - key `:centre` whose value represents the centre of this facet in 3 - dimensions. This only works for triangles, so is here not in - `walkmap.polygon`. It is an error (although no exception is currently - thrown) if the object past is not a triangular polygon." - [facet] - (let [vs (:vertices facet) - v1 (first vs) - opposite (e/edge (nth vs 1) (nth vs 2)) - oc (e/centre opposite)] - (assoc - facet - :centre - (v/vertex - (+ (:x v1) (* (- (:x oc) (:x v1)) 2/3)) - (+ (:y v1) (* (- (:y oc) (:y v1)) 2/3)) - (+ (:z v1) (* (- (:z oc) (:z v1)) 2/3)))))) - (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; @@ -82,6 +64,8 @@ `map-kind` is not a keyword." ([o] (canonicalise o :height)) ([o map-kind] + (canonicalise o map-kind (v/vertex 1 1 1))) + ([o map-kind scale-vertex] (when-not (keyword? map-kind) (throw (IllegalArgumentException. @@ -93,25 +77,42 @@ :kind :stl :walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "stl"))) :facets (canonicalise (:facets o) map-kind)) - ;; if it has :vertices it's a polygon, but it doesn't yet conform to `polygon?` - (:vertices o) (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 it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?` - (:x o) (v/canonicalise o) + ;; if it has :vertices it's a polygon, but it may not yet conform to + ;; `polygon?` + (:vertices o) (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 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 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 - indicating the value represented by the `z` axis (defaults to `:height`). + 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. + 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." @@ -122,8 +123,16 @@ (keyword? map-kind) (throw (IllegalArgumentException. (u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80)))) - (let [in (io/input-stream filename)] - (canonicalise (b/decode binary-stl in) map-kind)))) + (decode-binary-stl filename map-kind nil)) + ([filename mapkind superstucture] + (decode-binary-stl filename mapkind superstucture (v/vertex 1 1 1))) + ([filename map-kind superstructure scale-vertex] + (let [in (io/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")) diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj index 7593bcc..50ad5b9 100644 --- a/src/walkmap/superstructure.clj +++ b/src/walkmap/superstructure.clj @@ -4,7 +4,6 @@ [taoensso.timbre :as l] [walkmap.path :as p] [walkmap.polygon :as q] - [walkmap.stl :as s] [walkmap.utils :as u] [walkmap.vertex :as v])) @@ -166,3 +165,19 @@ (u/deep-merge s (in-store-find-objects o) (index-vertices s o)) (:walkmap.id/id o) (in-store-replace-with-keys o)))) + +(defn search-vertices + "Search superstructure `s` for vertices within the box defined by vertices + `minv` and `maxv`. Every coordinate in `minv` must have a lower value than + the equivalent coordinate in `maxv`. If `d2?` is supplied and not false, + search only in the x,y projection." + ([s minv maxv] + (search-vertices s minv maxv false)) + ([s minv maxv d2?] + (let [minv' (if d2? (assoc minv :z Double/NEGATIVE_INFINITY) minv) + maxv' (if d2? (assoc maxv :z Double/POSITIVE_INFINITY) maxv)] + (filter + #(v/within-box? % minv maxv) + (filter #(= (:kind %) :vertex) (vals s)))))) + + diff --git a/src/walkmap/vertex.clj b/src/walkmap/vertex.clj index 679608e..de7c81e 100644 --- a/src/walkmap/vertex.clj +++ b/src/walkmap/vertex.clj @@ -7,7 +7,7 @@ [clojure.string :as s] [taoensso.timbre :as l] [walkmap.geometry :refer [=ish]] - [walkmap.utils :refer [truncate]])) + [walkmap.utils :refer [kind-type truncate]])) (defn vertex-key "Making sure we get the same key everytime we key a vertex with the same @@ -133,3 +133,17 @@ (throw (IllegalArgumentException. (truncate (str "Not a vertex: " (or o "nil")) 80))))))) + +(defn within-box? + "True if `target` is within the box defined by `minv` and `maxv`. All + arguments must be vertices; additionally, both `minv` and `maxv` must + have `:z` coordinates." + [target minv maxv] + (when-not (and (vertex? target) (vertex? minv) (vertex? maxv)) + (throw (IllegalArgumentException. + (s/join " " ["Arguments to `within-box?` must be vertices:" + (map kind-type [target minv maxv])])))) + (every? + (map + #(< (% minv) (or (% target) 0) (% maxv)) + [:x :y :z])))