001 (ns walkmap.read-svg
002 "Utility functions for scalable vector graphics (SVG) into walkmap
003 structures."
004 (:require [clojure.data.zip :as dz]
005 [clojure.data.zip.xml :as zx]
006 [clojure.java.io :as io]
007 [clojure.string :as s]
008 [clojure.xml :as x]
009 [clojure.zip :as z]
010 [taoensso.timbre :as l]
011 [walkmap.path :refer [path]]
012 [walkmap.tag :refer [tag]]
013 [walkmap.utils :refer [kind-type truncate]]
014 [walkmap.vertex :refer [vertex vertex?]]))
015
016 (defn upper-case?
017 [s]
018 (every? #(Character/isUpperCase %) s))
019
020 (defn match->vertex
021 [match-vector x y]
022 (when-not (empty? match-vector)
023 (let [command (nth match-vector 1)
024 xcoord (read-string (nth match-vector 2))
025 ycoord (read-string (nth match-vector 3))
026 ;; upper case command letters mean the coordinates that follow are
027 ;; absolute; lower case, relative.
028 x' (if (upper-case? command) xcoord (+ x xcoord))
029 y' (if (upper-case? command) ycoord (+ y ycoord))]
030 (case (s/lower-case command)
031 ("m" "l") {:vertex (vertex x' y') :x x' :y y'}
032 nil))))
033
034 (defn command-string->vertices
035 "Return the destination of each successive line (`l`, `L`) and move (`m`, `M`)
036 command in this string `s`, expected to be an SVG path command string."
037 [s]
038 (let [cmd-matcher ;; matches a 'command' in the string: a letter followed by
039 ;;spaces and numbers
040 (re-matcher #"[a-zA-Z][^a-zA-Z]*" s)
041 seg-pattern ;; matches a command which initiates a move of the current
042 ;; position.
043 #"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +"]
044 (loop [match (re-find cmd-matcher)
045 result []
046 x 0
047 y 0]
048 (if-not match
049 (filter vertex? result)
050 (let [m (match->vertex (re-find seg-pattern match) x y)]
051 (recur (re-find cmd-matcher) ;loop with 2 new arguments
052 (conj result (:vertex m))
053 (or (:x m) x)
054 (or (:y m) y)))))))
055
056 (defn path-elt->path
057 "Given the SVG path element `elt`, return a walkmap path structure
058 representing the line (`l`, `L`) and move (`m`, `M`) commands in
059 that path."
060 [elt]
061 (if (= (:tag elt) :path)
062 (let [vs (command-string->vertices (-> elt :attrs :d))
063 p (when-not (empty? vs) (apply path vs))]
064 (if (and p (-> elt :attrs :class))
065 (tag p (map keyword (s/split (-> elt :attrs :class) #" ")))
066 p))
067 (throw (IllegalArgumentException.
068 (str "Must be an SVG `path` element: " elt)))))
069
070 (defn progeny
071 "Return all the nodes in the XML structure below this `elt` which match
072 this `predicate`."
073 ;; the name `descendants` is bound in `clojure.core` for something quite
074 ;; different, and I chose not to rebind it.
075 [elt predicate]
076 (if
077 (apply predicate (list elt))
078 (list elt)
079 (reduce
080 concat
081 (remove
082 empty?
083 (map
084 #(progeny % predicate)
085 (:content elt))))))
086
087 (defn read-svg
088 ;; I tried to get this working with all the clever zip stuff in
089 ;; `clojure.zip`, `clojure.data.zip`, and so on. It would probably have
090 ;; been more elegant, but it kept crashing out of heap space on even
091 ;; quite small XML files. So I've implemented my own solution.
092 ([file-name]
093 (read-svg file-name nil))
094 ([file-name map-kind]
095 (let [xml (x/parse (io/file file-name))
096 paths (progeny xml #(= (:tag %) :path))]
097 (remove nil? (map path-elt->path paths)))))