Can now adequately read paths from SVG

Not yet reading curvature, which will probably one day be necessary.

src/walkmap/path.clj

@@ -5,6 +5,7 @@
   (:require [clojure.string :as s]
             [walkmap.edge :as e]
             [walkmap.polygon :refer [polygon?]]
+            [walkmap.utils :refer [kind-type]]
             [walkmap.vertex :refer [vertex?]]))
 
 (defn path?
@@ -30,7 +31,7 @@
     (throw (IllegalArgumentException.
              (str
                "Each item on path must be a vertex: "
-               (s/join " " (map #(or (:kind %) (type %) "nil") vertices)))))))
+               (s/join " " (map kind-type vertices)))))))
 
 (defn polygon->path
   "If `o` is a polygon, return an equivalent path. What's different about

src/walkmap/read_svg.clj

@@ -7,10 +7,11 @@
             [clojure.string :as s]
             [clojure.xml :as x]
             [clojure.zip :as z]
-            [taoensso.timbre :as l :refer [info error spy]]
+            [taoensso.timbre :as l]
             [walkmap.path :refer [path]]
 ;;            [walkmap.polygon :refer [polygon]]
             [walkmap.tag :refer [tag]]
+            [walkmap.utils :refer [kind-type truncate]]
             [walkmap.vertex :refer [vertex vertex?]]))
 
 (defn upper-case?
@@ -19,38 +20,53 @@
 
 (defn match->vertex
   [match-vector x y]
-  (let [command (nth match-vector 1)
+  (when-not (empty? match-vector)
-        xcoord (read-string (nth match-vector 2))
+    (let [command (nth match-vector 1)
-        ycoord (read-string (nth match-vector 3))
+          xcoord (read-string (nth match-vector 2))
-        ;; upper case command letters mean the coordinates that follow are
+          ycoord (read-string (nth match-vector 3))
-        ;; absolute; lower case, relative.
+          ;; upper case command letters mean the coordinates that follow are
-        x' (if (upper-case? command) xcoord (+ x xcoord))
+          ;; absolute; lower case, relative.
-        y' (if (upper-case? command) ycoord (+ y ycoord))]
+          x' (if (upper-case? command) xcoord (+ x xcoord))
-    (case (s/lower-case command)
+          y' (if (upper-case? command) ycoord (+ y ycoord))]
-      ("m" "l") {:vertex (vertex x' y') :x x' :y y'})))
+      (case (s/lower-case command)
+        ("m" "l") {:vertex (vertex x' y') :x x' :y y'}
+        nil))))
 
 (defn command-string->vertices
+  "Return the destination of each successive line (`l`, `L`) and move (`m`, `M`)
+  command in this string `s`, expected to be an SVG path command string."
   [s]
-  (let [matcher (re-matcher #"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +" s)]
+  (let [cmd-matcher ;; matches a 'command' in the string: a letter followed by
-    (loop [match (re-find matcher) ;loop starts with 2 set arguments
+        ;;spaces and numbers
+        (re-matcher #"[a-zA-Z][^a-zA-Z]*" s)
+        seg-pattern ;; matches a command which initiates a move of the current
+        ;; position.
+        #"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +"]
+    (loop [match (re-find cmd-matcher)
            result []
            x 0
            y 0]
       (if-not match
         (filter vertex? result)
-        (let [m (match->vertex match x y)]
+        (let [m (match->vertex (re-find seg-pattern match) x y)]
-          (recur (re-find matcher)    ;loop with 2 new arguments
+          (recur (re-find cmd-matcher)    ;loop with 2 new arguments
                  (conj result (:vertex m))
-                 (:x m)
+                 (or (:x m) x)
-                 (:y m)))))))
+                 (or (:y m) y)))))))
 
 (defn path-elt->path
-
+  "Given the SVG path element `elt`, return a walkmap path structure
+  representing the line (`l`, `L`) and move (`m`, `M`) commands in
+  that path."
   [elt]
-  (tag
+  (if (= (-> elt :tag) :path)
-    (path (command-string->vertices (-> elt :attrs :d)))
+    (let [vs (command-string->vertices (-> elt :attrs :d))
-    (when (-> elt :attrs :class)
+          p  (when-not (empty? vs) (apply path vs))]
-      (map keyword (s/split (-> elt :attrs :class) #" ")))))
+      (if (and p (-> elt :attrs :class))
+        (tag p (map keyword (s/split (-> elt :attrs :class) #" ")))
+        p))
+    (throw (IllegalArgumentException.
+             (str "Must be an SVG `path` element: " elt)))))
 
 (defn progeny
   "Return all the nodes in the XML structure below this `elt` which match
@@ -79,17 +95,4 @@
   ([file-name map-kind]
     (let [xml (x/parse (io/file file-name))
           paths (progeny xml #(= (:tag %) :path))]
-      (map path-elt->path paths))))
+      (remove nil? (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")))
-

src/walkmap/tag.clj

@@ -2,7 +2,9 @@
   "Code for tagging, untagging, and finding tags on objects. Note the use of
   the namespaced keyword, `:walkmap.tag/tags`, denoted in this file `::tags`.
   This is in an attempt to avoid name clashes with other uses of this key."
-  (:require [clojure.set :refer [difference union]]))
+  (:require [clojure.set :refer [difference union]]
+            [taoensso.timbre :as l]
+            [walkmap.utils :refer [kind-type]]))
 
 (defn tagged?
   "True if this `object` is tagged with each of these `tags`. It is an error
@@ -20,9 +22,9 @@
           (set? ot)
           (every? ot tags)))
       (throw (IllegalArgumentException.
-               (str "Must be keyword(s): " (map type tags)))))
+               (str "Must be keyword(s): " (map kind-type tags)))))
     (throw (IllegalArgumentException.
-             (str "Must be a map: " (type object))))))
+             (str "Must be a map: " (kind-type object))))))
 
 (defn tag
   "Return an object like this `object` but with these `tags` added to its tags,
@@ -35,6 +37,7 @@
   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]
+  (l/debug "Tagging" (or (:kind object) (type object) nil) "with" tags)
   (let [tags' (flatten tags)]
     (if
       (map? object)
@@ -42,9 +45,9 @@
         (every? keyword? tags')
         (assoc object ::tags (union (set tags') (::tags object)))
         (throw (IllegalArgumentException.
-                 (str "Must be keyword(s): " (map type tags')))))
+                 (str "Must be keyword(s): " (map kind-type tags')))))
       (throw (IllegalArgumentException.
-               (str "Must be a map: " (type object)))))))
+               (str "Must be a map: " (kind-type object)))))))
 
 (defmacro tags
   "Return the tags of this object, if any."
@@ -64,6 +67,6 @@
       (every? keyword? tags)
       (assoc object ::tags (difference (::tags object) (set tags)))
       (throw (IllegalArgumentException.
-               (str "Must be keywords: " (map type tags)))))
+               (str "Must be keywords: " (map kind-type tags)))))
     (throw (IllegalArgumentException.
-             (str "Must be a map: " (type object))))))
+             (str "Must be a map: " (kind-type object))))))

src/walkmap/utils.clj

@@ -26,4 +26,10 @@
     (subs s 0 n)
     s))
 
-
+(defn kind-type
+  "Identify the type of an `object`, e.g. for logging. If it has a `:kind` key,
+  it's one of ours, and that's what we want. Otherwise, we want its type; but
+  the type of `nil` is `nil`, which doesn't get printed when assembling error
+  ,essages, so return \"nil\"."
+  [object]
+  (or (:kind object) (type object) "nil"))