Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Extend parsing of SVG path definitions #98

Draft
wants to merge 13 commits into
base: feature/no-org
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
317 changes: 284 additions & 33 deletions src/thi/ng/geom/path.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -18,15 +18,41 @@

(defmulti sample-segment (fn [s res last?] (get s :type)))

(defmethod sample-segment :move
[{pt :point} res last?]
(gu/sample-uniform res last? [pt]))

(defmethod sample-segment :line
[{[a b] :points} res last?]
(gu/sample-segment-with-res a b res last?))

(defmethod sample-segment :line-strip
[{points :points} res last?]
(gu/sample-uniform res last? points))

(defmethod sample-segment :close
[{[a b] :points} res last?]
(gu/sample-segment-with-res a b res last?))

(defmethod sample-segment :bezier
;; Implementing geometry capabilities for the elliptical arc command
;; will involve building out geometry capabilities for the currently
;; largely unimplemented Ellipse2 type - or an Arc2 type
#_(defmethod sample-segment :arc
nil)

(defmethod sample-segment :cubic
[{points :points} res last?]
(b/sample-with-res res last? points))

(defmethod sample-segment :cubic-chain
[{points :points} res last?]
(b/sample-with-res res last? points))

(defmethod sample-segment :quadratic
[{points :points} res last?]
(b/sample-with-res res last? points))

(defmethod sample-segment :quadratic-chain
[{points :points} res last?]
(b/sample-with-res res last? points))

Expand All @@ -44,44 +70,269 @@
(conj paths curr)
paths)))

(def coordinate-regex #"[\-\+]?[0-9]+\.?[0-9]*|\.[0-9]+")


(defn parse-svg-coords
[coords]
(->> coords
(re-seq #"[0-9\.\-\+]+")
#?(:clj (map #(Double/parseDouble %)) :cljs (map js/parseFloat))
(partition 2)
(mapv vec2)))
(re-seq coordinate-regex)
#?(:clj (mapv #(Double/parseDouble %)) :cljs (map js/parseFloat))))

(defn svg-coord-pairs [parsed-coords]
(mapv vec2 (partition 2 parsed-coords)))

;; the general parsing strategy is designed to line up with the intended output:
;; a sequence of segments.
;; 1. use command regex to generate a partially parsed sequence of commands
;; 2. loop through this sequence while holding on to some "current position"
;; state information to ensure the segments begin and end correctly



;; regex to separate by command indicators; supporting an arbitrary number of
;; coordinate pairs

;; used to generate the sequence of path commands
(def ^:private cmd-regex #"(?i)([achlmqstvz])([^achlmqstvz]*)")

(comment
(parse-svg-coords "40,40")

(parse-svg-path
"M 10,80 20,20 40,40 0,10 Z")

(parse-svg-path "m 10 80")
(parse-svg-path "M 10 80")

(re-seq cmd-regex "M 10,80 20,20 40,40 0,10 Z")

)

(defn move-to [cmd current-pos [start-pt & line-coords]]
;; implicit line: return the segment and the current position
;; (as described by the final point in the line)
(if line-coords
(let [line (reduce (fn [pts nxt] (conj pts (vec2 nxt)))
[start-pt]
line-coords)]
[{:type :line :points line}
(peek line)])
;; standard move: return only the current position
[{:type :move :point start-pt}
start-pt]))

(defn line-to [cmd current-pos pts]
(let [rel (= "l" cmd)]
(if (not= 1 (count pts))
[{:type :line-strip :points (reduce conj [current-pos] pts)
:relative? rel}
(peek pts)]
[{:type :line :points [current-pos (first pts)]
:relative? rel}
(first pts)])))

(defn h-line-to [cmd [cx cy :as current-pos] [next-x & xs]]
(let [rel (= "h" cmd)]
(if xs
[{:type :line-strip
:points (reduce (fn [pts x] (conj pts (vec2 x cy)))
[current-pos (vec2 next-x cy)]
xs)
:relative? rel}
(vec2 (peek xs) cy)]
[{:type :line :points [current-pos (vec2 next-x cy)]
:relative? rel}
(vec2 next-x cy)])))

(defn v-line-to [cmd [cx cy :as current-pos] [next-y & ys]]
(let [rel (= "v" cmd)]
(if ys
[{:type :line-strip
:points (reduce (fn [pts y] (conj pts (vec2 cx y)))
[current-pos (vec2 cx next-y)]
ys)
:relative? rel}
(vec2 cx (peek ys))]
[{:type :line :points [current-pos (vec2 cx next-y)]
:relative? rel}
(vec2 cx next-y)])))

(defn cubic-to [cmd current-pos pts]
(let [rel (= "c" cmd)]
[{:type :cubic :points (reduce conj [current-pos] pts)
:relative? rel}
(peek pts)]))

(defn cubic-chain-to [cmd current-pos pts]
(let [rel (= "s" cmd)]
[{:type :cubic-chain :points (reduce conj [current-pos] pts)
:relative? rel}
(peek pts)]))

(defn quadratic-to [cmd current-pos pts]
(let [rel (= "q" cmd)]
[{:type :quadratic :points (reduce conj [current-pos] pts)
:relative? rel}
(peek pts)]))

(defn quadratic-chain-to [cmd current-pos pts]
(let [rel (= "t" cmd)]
[{:type :quadratic-chain :points (reduce conj [current-pos] pts)
:relative? rel}
(peek pts)]))

(defn arc-to [cmd current-pos pts]
(let [rel (= "a" cmd)]
[{:type :arc :points (reduce conj [current-pos] [pts])
:relative? rel}
(peek pts)]))


(defn parse-svg-path
([svg]
([path-str]
(parse-svg-path
(->> svg
(re-seq #"([MLCZz])\s*(((([0-9\.\-]+)\,?){2}\s*){0,3})")
(map (fn [[_ t c]]
[t (parse-svg-coords c)])))
[0 0] [0 0]))
([[[type points :as seg] & more] p0 pc]
(when seg
(cond
(= "M" type)
(let [p (first points)] (recur more p p))

(= "L" type)
(let [p (first points)]
(lazy-seq (cons {:type :line :points [pc p]}
(parse-svg-path more p0 p))))

(= "C" type)
(let [p (last points)]
(lazy-seq (cons {:type :bezier :points (cons pc points)}
(parse-svg-path more p0 p))))

(or (= "Z" type) (= "z" type))
(lazy-seq (cons {:type :close :points [pc p0]}
(parse-svg-path more p0 p0)))

:default
(err/unsupported! (str "Unsupported path segment type" type))))))
(map (fn parse-coords [[_m cmd coord-str]]
[cmd
(let [parsed (parse-svg-coords coord-str)]
;; don't partition coordinates into pairs for 1d line commands
(if (#{"V" "v" "H" "h"} cmd) parsed
(svg-coord-pairs parsed)))])
(re-seq cmd-regex path-str))
{:origin [0 0]
:current [0 0]}))
([[[cmd coords :as seg] & more]
{:keys [current origin]
:as pts}]
(if (nil? seg)
'()
(case cmd
"M"
(let [[new-segment new-pos]
(move-to cmd current coords)]
(if new-segment
(lazy-seq
(cons new-segment
(parse-svg-path more (assoc pts :current new-pos))))
(recur more (assoc pts :current new-pos))))
"m"
(let [[line-segment new-pos]
(move-to cmd current coords)]
(if line-segment
(lazy-seq
(cons line-segment
(parse-svg-path
more
(assoc pts :current new-pos))))
(recur more (assoc pts :current new-pos))))
"L" (let [[line-segment new-pos] (line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"l" (let [[line-segment new-pos] (line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"H" (let [[line-segment new-pos] (h-line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"h" (let [[line-segment new-pos] (h-line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"V" (let [[line-segment new-pos] (h-line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"v" (let [[line-segment new-pos] (v-line-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"Q" (let [[line-segment new-pos] (quadratic-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"q" (let [[line-segment new-pos] (quadratic-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"T" (let [[line-segment new-pos] (quadratic-chain-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"t" (let [[line-segment new-pos] (quadratic-chain-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"C" (let [[line-segment new-pos] (cubic-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"c" (let [[line-segment new-pos] (cubic-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"S" (let [[line-segment new-pos] (cubic-chain-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"s" (let [[line-segment new-pos] (cubic-chain-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"A" (let [[line-segment new-pos] (arc-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"a" (let [[line-segment new-pos] (arc-to cmd current coords)]
(lazy-seq
(cons line-segment
(parse-svg-path more (assoc pts :current new-pos)))))
"Z" (lazy-seq (cons {:type :close :points [current origin]}
(parse-svg-path more (assoc pts :current origin))))
"z" (lazy-seq (cons {:type :close :points [current origin]}
(parse-svg-path more (assoc pts :current origin))))
nil))))

(comment
(defn parse-svg-path-old
([svg]
(parse-svg-path-old
(->> svg
(re-seq #"([MLCZz])\s*(((([0-9\.\-]+)\,?){2}\s*){0,3})")
(map (fn [[_ t c]]
[t (parse-svg-coords c)])))
[0 0] [0 0]))
([[[type points :as seg] & more] p0 pc]
(when seg
(cond
(= "M" type)
(let [p (first points)] (recur more p p))

(= "L" type)
(let [p (first points)]
(lazy-seq (cons {:type :line :points [pc p]}
(parse-svg-path-old more p0 p))))

(= "C" type)
(let [p (last points)]
(lazy-seq (cons {:type :bezier :points (cons pc points)}
(parse-svg-path-old more p0 p))))

(or (= "Z" type) (= "z" type))
(lazy-seq (cons {:type :close :points [pc p0]}
(parse-svg-path-old more p0 p0)))

:default
(err/unsupported! (str "Unsupported path segment type" type))))))

(parse-svg-path-old "M 10 10 C 20 20, 40 20, 50 10")
(parse-svg-path-old "M 10 10 ")

(gu/sample-uniform 1.0 true [(vec2 10 10)])

)

#?(:clj
(defn parse-svg
Expand Down
Loading