diff --git a/src/walkmap/path.clj b/src/walkmap/path.clj
index abec970..e1ac91b 100644
--- a/src/walkmap/path.clj
+++ b/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
diff --git a/src/walkmap/read_svg.clj b/src/walkmap/read_svg.clj
index bf227e3..b86f205 100644
--- a/src/walkmap/read_svg.clj
+++ b/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)
- 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'})))
+ (when-not (empty? match-vector)
+ (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'}
+ 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)]
- (loop [match (re-find matcher) ;loop starts with 2 set arguments
+ (let [cmd-matcher ;; matches a 'command' in the string: a letter followed by
+ ;;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)]
- (recur (re-find matcher) ;loop with 2 new arguments
+ (let [m (match->vertex (re-find seg-pattern match) x y)]
+ (recur (re-find cmd-matcher) ;loop with 2 new arguments
(conj result (:vertex m))
- (:x m)
- (:y m)))))))
+ (or (:x m) x)
+ (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
- (path (command-string->vertices (-> elt :attrs :d)))
- (when (-> elt :attrs :class)
- (map keyword (s/split (-> elt :attrs :class) #" ")))))
+ (if (= (-> elt :tag) :path)
+ (let [vs (command-string->vertices (-> elt :attrs :d))
+ p (when-not (empty? vs) (apply path vs))]
+ (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))))
-
-(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")))
-
+ (remove nil? (map path-elt->path paths)))))
diff --git a/src/walkmap/tag.clj b/src/walkmap/tag.clj
index 1cc8de1..3b98677 100644
--- a/src/walkmap/tag.clj
+++ b/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))))))
diff --git a/src/walkmap/utils.clj b/src/walkmap/utils.clj
index 639b9c5..45759fe 100644
--- a/src/walkmap/utils.clj
+++ b/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"))