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)))))
098  
099  ;; (read-svg "resources/iom/manual_roads.svg")
100