From f2c39f90174947dc95f40646a96db5164a4efddf Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 29 May 2020 11:23:24 +0100 Subject: [PATCH] Can now adequately read paths from SVG Not yet reading curvature, which will probably one day be necessary. --- src/walkmap/path.clj | 3 +- src/walkmap/read_svg.clj | 73 +++++++++++++++++++++------------------- src/walkmap/tag.clj | 17 ++++++---- src/walkmap/utils.clj | 8 ++++- 4 files changed, 57 insertions(+), 44 deletions(-) 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"))