From 9892af65e3923484288a8916d0e6e8aedd0f6d6e Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Thu, 28 May 2020 17:48:01 +0100
Subject: [PATCH] #3: Good progress towards getting SVG reading going, but not
 there yet.

---
 project.clj                    |  1 +
 src/walkmap/path.clj           |  8 ++-
 src/walkmap/read_svg.clj       | 95 ++++++++++++++++++++++++++++++++++
 src/walkmap/stl.clj            |  5 +-
 src/walkmap/superstructure.clj |  2 +-
 src/walkmap/svg.clj            | 10 +++-
 src/walkmap/tag.clj            | 20 ++++---
 src/walkmap/utils.clj          | 28 ++++++----
 src/walkmap/vertex.clj         | 13 ++---
 test/walkmap/tag_test.clj      |  5 +-
 10 files changed, 155 insertions(+), 32 deletions(-)
 create mode 100644 src/walkmap/read_svg.clj

diff --git a/project.clj b/project.clj
index 48b6db4..348e8ed 100644
--- a/project.clj
+++ b/project.clj
@@ -5,6 +5,7 @@
           :output-path "docs/codox"
           :source-uri "https://github.com/simon-brooke/walkmap/blob/master/{filepath}#L{line}"}
   :dependencies [[org.clojure/clojure "1.8.0"]
+                 [org.clojure/data.zip "1.0.0"]
                  [org.clojure/math.numeric-tower "0.0.4"]
                  [org.clojure/math.combinatorics "0.1.6"]
                  [com.taoensso/timbre "4.10.0"]
diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj
index 5ea5a5e..abec970 100644
--- a/src/walkmap/path.clj
+++ b/src/walkmap/path.clj
@@ -2,7 +2,8 @@
   "Essentially the specification for things we shall consider to be path.
   **Note that** for these purposes `path` means any continuous linear
   feature, where such features specifically include watercourses."
-  (:require [walkmap.edge :as e]
+  (:require [clojure.string :as s]
+            [walkmap.edge :as e]
             [walkmap.polygon :refer [polygon?]]
             [walkmap.vertex :refer [vertex?]]))
 
@@ -26,7 +27,10 @@
   (if
     (every? vertex? vertices)
     {:vertices vertices :id (keyword (gensym "path")) :kind :path}
-    (throw (IllegalArgumentException. "Each item on path must be a vertex."))))
+    (throw (IllegalArgumentException.
+             (str
+               "Each item on path must be a vertex: "
+               (s/join " " (map #(or (:kind %) (type %) "nil") vertices)))))))
 
 (defn polygon->path
   "If `o` is a polygon, return an equivalent path. What's different about
diff --git a/src/walkmap/read_svg.clj b/src/walkmap/read_svg.clj
new file mode 100644
index 0000000..bf227e3
--- /dev/null
+++ b/src/walkmap/read_svg.clj
@@ -0,0 +1,95 @@
+(ns walkmap.read-svg
+  "Utility functions for  scalable vector graphics (SVG) into walkmap
+  structures."
+  (:require [clojure.data.zip :as dz]
+            [clojure.data.zip.xml :as zx]
+            [clojure.java.io :as io]
+            [clojure.string :as s]
+            [clojure.xml :as x]
+            [clojure.zip :as z]
+            [taoensso.timbre :as l :refer [info error spy]]
+            [walkmap.path :refer [path]]
+;;            [walkmap.polygon :refer [polygon]]
+            [walkmap.tag :refer [tag]]
+            [walkmap.vertex :refer [vertex vertex?]]))
+
+(defn upper-case?
+  [s]
+  (every? #(Character/isUpperCase %) s))
+
+(defn match->vertex
+  [match-vector x y]
+  (let [command (nth match-vector 1)
+        xcoord (read-string (nth match-vector 2))
+        ycoord (read-string (nth match-vector 3))
+        ;; upper case command letters mean the coordinates that follow are
+        ;; absolute; lower case, relative.
+        x' (if (upper-case? command) xcoord (+ x xcoord))
+        y' (if (upper-case? command) ycoord (+ y ycoord))]
+    (case (s/lower-case command)
+      ("m" "l") {:vertex (vertex x' y') :x x' :y y'})))
+
+(defn command-string->vertices
+  [s]
+  (let [matcher (re-matcher #"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +" s)]
+    (loop [match (re-find matcher) ;loop starts with 2 set arguments
+           result []
+           x 0
+           y 0]
+      (if-not match
+        (filter vertex? result)
+        (let [m (match->vertex match x y)]
+          (recur (re-find matcher)    ;loop with 2 new arguments
+                 (conj result (:vertex m))
+                 (:x m)
+                 (:y m)))))))
+
+(defn path-elt->path
+
+  [elt]
+  (tag
+    (path (command-string->vertices (-> elt :attrs :d)))
+    (when (-> elt :attrs :class)
+      (map keyword (s/split (-> elt :attrs :class) #" ")))))
+
+(defn progeny
+  "Return all the nodes in the XML structure below this `elt` which match
+  this `predicate`."
+  ;; the name `descendants` is bound in `clojure.core` for something quite
+  ;; different, and I chose not to rebind it.
+  [elt predicate]
+  (if
+    (apply predicate (list elt))
+    (list elt)
+    (reduce
+      concat
+      (remove
+        empty?
+        (map
+          #(progeny % predicate)
+          (:content elt))))))
+
+(defn read-svg
+  ;; I tried to get this working with all the clever zip stuff in
+  ;; `clojure.zip`, `clojure.data.zip`, and so on. It would probably have
+  ;; been more elegant, but it kept crashing out of heap space on even
+  ;; quite small XML files. So I've implemented my own solution.
+  ([file-name]
+   (read-svg file-name nil))
+  ([file-name map-kind]
+    (let [xml (x/parse (io/file file-name))
+          paths (progeny xml #(= (:tag %) :path))]
+      (map path-elt->path paths))))
+
+(read-svg "resources/iom/manual_roads.svg")
+
+
+;; (def xx (z/xml-zip (x/parse (io/file "resources/iom/manual_roads.svg"))))
+
+;; (type xx)
+;; (first xx)
+
+;; (zx/xml-> xx :svg :g :path)
+
+;; (def xxx (x/parse (io/file "resources/iom/manual_roads.svg")))
+
diff --git a/src/walkmap/stl.clj b/src/walkmap/stl.clj
index 89e6c9e..e1c23b0 100644
--- a/src/walkmap/stl.clj
+++ b/src/walkmap/stl.clj
@@ -8,6 +8,7 @@
             [walkmap.edge :as e]
             [walkmap.polygon :refer [polygon?]]
             [walkmap.tag :refer [tag]]
+            [walkmap.utils :as u]
             [walkmap.vertex :as v])
   (:import org.clojars.smee.binary.core.BinaryIO
            java.io.DataInput))
@@ -84,7 +85,7 @@
    (when-not
      (keyword? map-kind)
      (throw (IllegalArgumentException.
-              (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
+              (u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
    (cond
      (and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
      ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
@@ -120,7 +121,7 @@
    (when-not
      (keyword? map-kind)
      (throw (IllegalArgumentException.
-              (subs (str "Must be a keyword: " (or map-kind "nil")) 0 80))))
+              (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))))
 
diff --git a/src/walkmap/superstructure.clj b/src/walkmap/superstructure.clj
index abd0375..ced5abe 100644
--- a/src/walkmap/superstructure.clj
+++ b/src/walkmap/superstructure.clj
@@ -40,7 +40,7 @@
           ;; stage we need to build a map.
           (assoc vi (:id v) (assoc current (:id o) (:id v))))
         (throw (IllegalArgumentException. "Not a vertex: " v)))
-      (throw (IllegalArgumentException. (subs (str "No `:id` value: " o) 0 80))))
+      (throw (IllegalArgumentException. (u/truncate (str "No `:id` value: " o) 80))))
     ;; it shouldn't actually be an error to try to index a vertex, but it
     ;; also isn't useful to do so, so I'd be inclined to ignore it.
     (:vertex-index s)))
diff --git a/src/walkmap/svg.clj b/src/walkmap/svg.clj
index 3649e55..bbb9d9f 100644
--- a/src/walkmap/svg.clj
+++ b/src/walkmap/svg.clj
@@ -2,7 +2,9 @@
   "Utility functions for writing stereolithography (STL) files (and possibly,
   later, other geometry files of interest to us) as scalable vector graphics
   (SVG)."
-  (:require [clojure.string :as s]
+  (:require [clojure.java.io :as io]
+            [clojure.string :as s]
+            [clojure.xml :as x]
             [dali.io :as neatly-folded-clock]
             [hiccup.core :refer [html]]
             [taoensso.timbre :as l :refer [info error spy]]
@@ -106,3 +108,9 @@
        :hiccup (spit out-filename (html s))
        (throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))
      s)))
+
+
+(defn read-svg
+  ([file-name]
+   (read-svg file-name nil))
+  ([file-name map-kind]
diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj
index 72b4977..1cc8de1 100644
--- a/src/walkmap/tag.clj
+++ b/src/walkmap/tag.clj
@@ -30,17 +30,21 @@
   thrown) if
 
   1. `object` is not a map;
-  2. any of `tags` is not a keyword."
+  2. any of `tags` is not a keyword or sequence of keywords.
+
+  It's legal to include sequences of keywords in `tags`, so that users can do
+  useful things like `(tag obj (map keyword some-strings))`."
   [object & tags]
-  (if
-    (map? object)
+  (let [tags' (flatten tags)]
     (if
-      (every? keyword? tags)
-      (assoc object ::tags (union (set tags) (::tags object)))
+      (map? object)
+      (if
+        (every? keyword? tags')
+        (assoc object ::tags (union (set tags') (::tags object)))
+        (throw (IllegalArgumentException.
+                 (str "Must be keyword(s): " (map type tags')))))
       (throw (IllegalArgumentException.
-               (str "Must be keyword(s): " (map type tags)))))
-    (throw (IllegalArgumentException.
-             (str "Must be a map: " (type object))))))
+               (str "Must be a map: " (type object)))))))
 
 (defmacro tags
   "Return the tags of this object, if any."
diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj
index 95f26f6..639b9c5 100644
--- a/src/walkmap/utils.clj
+++ b/src/walkmap/utils.clj
@@ -1,9 +1,6 @@
 (ns walkmap.utils
   "Miscellaneous utility functions."
-  (:require [clojure.math.numeric-tower :as m]
-            [walkmap.path :as p]
-            [walkmap.polygon :as q]
-            [walkmap.vertex :as v]))
+  (:require [clojure.math.numeric-tower :as m]))
 
 (defn deep-merge
   "Recursively merges maps. If vals are not maps, the last value wins."
@@ -13,11 +10,20 @@
     (apply merge-with deep-merge vals)
     (last vals)))
 
-(defn vertices
-  "If `o` is an object with vertices, return those vertices, else nil."
-  [o]
-  (cond
-    (v/vertex? o) (list o)
-    (q/polygon? o) (:vertices o)
-    (p/path? o) (:vertices o)))
+;; (defn vertices
+;;   "If `o` is an object with vertices, return those vertices, else nil."
+;;   [o]
+;;   (cond
+;;     (v/vertex? o) (list o)
+;;     (q/polygon? o) (:vertices o)
+;;     (p/path? o) (:vertices o)))
+
+(defn truncate
+  "If string `s` is more than `n` characters long, return the first `n`
+  characters; otherwise, return `s`."
+  [s n]
+  (if (and (string? s) (number? n) (> (count s) n))
+    (subs s 0 n)
+    s))
+
 
diff --git a/src/walkmap/vertex.clj b/src/walkmap/vertex.clj
index 6c92f11..7c3bc83 100644
--- a/src/walkmap/vertex.clj
+++ b/src/walkmap/vertex.clj
@@ -5,7 +5,8 @@
   two vertices, create an edge from them and use `walkmap.edge/length`."
   (:require [clojure.math.numeric-tower :as m]
             [clojure.string :as s]
-            [walkmap.geometry :refer [=ish]]))
+            [walkmap.geometry :refer [=ish]]
+            [walkmap.utils :refer [truncate]]))
 
 (defn vertex-key
   "Making sure we get the same key everytime we key a vertex with the same
@@ -25,7 +26,7 @@
         (str "vert_" (:x o) "_" (:y o))
         :else
         (throw (IllegalArgumentException.
-                 (subs (str "Not a vertex: " (or o "nil")) 0 80))))
+                 (truncate (str "Not a vertex: " (or o "nil")) 80))))
       "."
       "-")))
 
@@ -79,10 +80,10 @@
     (assoc o :kind :vertex :id (vertex-key o))
     (throw
       (IllegalArgumentException.
-        (subs
+        (truncate
           (str "Not a proto-vertex: must have numeric `:x` and `:y`: "
                (or o "nil"))
-          0 80)))))
+          80)))))
 
 (def ensure3d
   "Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise
@@ -98,7 +99,7 @@
        (cond
          (not (vertex? o)) (throw
                              (IllegalArgumentException.
-                               (subs (str "Not a vertex: " (or o "nil")) 0 80)))
+                               (truncate (str "Not a vertex: " (or o "nil")) 80)))
          (:z o) o
          :else (assoc o :z dflt))))))
 
@@ -111,4 +112,4 @@
         (assoc o :z 0.0)
         (throw
           (IllegalArgumentException.
-            (subs (str "Not a vertex: " (or o "nil")) 0 80)))))))
+            (truncate (str "Not a vertex: " (or o "nil")) 80)))))))
diff --git a/test/walkmap/tag_test.clj b/test/walkmap/tag_test.clj
index 00d578a..01d208e 100644
--- a/test/walkmap/tag_test.clj
+++ b/test/walkmap/tag_test.clj
@@ -47,5 +47,8 @@
     (is (thrown? IllegalArgumentException (tagged? {} :foo "bar" :ban))
         "An exception should be thrown if any of `tags` is not a keyword: `tagged?`.")
     (is (thrown? IllegalArgumentException (untag {} :foo "bar" :ban))
-        "An exception should be thrown if any of `tags` is not a keywordp: `untag`.")))
+        "An exception should be thrown if any of `tags` is not a keywordp: `untag`.")
+    (let [o (tag {} :foo '(:bar :ban) :froboz)]
+      (is (tagged? o :ban :bar :foo :froboz)
+          "It's now allowed to include lists of tags in the arg list for `tag`."))))