Added: scaling and storing STL; beginnings of search

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."))))
+
 

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?`
+     ;; if it has :vertices it's a polygon, but it may not yet conform to
-     (:vertices o) (centre
+     ;; `polygon?`
+     (:vertices o) (gradient
+                     (centre
                        (tag
                          (assoc o
-                         :walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "poly")))
+                           :walkmap.id/id (or
+                                            (:walkmap.id/id o)
+                                            (keyword (gensym "poly")))
                            :kind :polygon
                            :vertices (canonicalise (:vertices o) map-kind))
-                       :facet map-kind))
+                         :facet map-kind)))
-     ;; if it has a value for :x it's a vertex, but it doesn't yet conform to `vertex?`
+     ;; if it has a value for :x it's a vertex, but it may not yet conform
-     (:x o) (v/canonicalise o)
+     ;; 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)]
+   (decode-binary-stl filename map-kind nil))
-     (canonicalise (b/decode binary-stl in) map-kind))))
+  ([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"))

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))))))
+
+

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])))