mirror of
https://github.com/penpot/penpot.git
synced 2026-05-26 18:33:43 +00:00
1049 lines
26 KiB
Clojure
1049 lines
26 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC
|
|
|
|
(ns app.common.svg
|
|
(:require
|
|
#?(:clj [clojure.xml :as xml]
|
|
:cljs [tubax.core :as tubax])
|
|
#?(:cljs ["./svg/optimizer.js" :as svgo])
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.geom.matrix :as gmt]
|
|
[app.common.geom.point :as gpt]
|
|
[app.common.geom.shapes :as gsh]
|
|
[app.common.math :as mth]
|
|
[app.common.uuid :as uuid]
|
|
[cuerdas.core :as str])
|
|
#?(:clj
|
|
(:import
|
|
clojure.lang.XMLHandler
|
|
java.io.InputStream
|
|
javax.xml.XMLConstants
|
|
javax.xml.parsers.SAXParserFactory
|
|
org.apache.commons.io.IOUtils)))
|
|
|
|
|
|
;; Regex for XML ids per Spec
|
|
;; https://www.w3.org/TR/2008/REC-xml-20081126/#sec-common-syn
|
|
(def xml-id-regex #"#([:A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF][\.\-\:0-9\xB7A-Z_a-z\xC0-\xD6\xD8-\xF6\xF8-\u02FF\u0300-\u036F\u0370-\u037D\u037F-\u1FFF\u200C-\u200D\u203F-\u2040\u2070-\u218F\u2C00-\u2FEF\u3001-\uD7FF\uF900-\uFDCF\uFDF0-\uFFFD\u10000-\uEFFFF]*)")
|
|
|
|
(def matrices-regex #"(matrix|translate|scale|rotate|skewX|skewY)\(([^\)]*)\)")
|
|
(def number-regex #"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?")
|
|
|
|
(def tags-to-remove #{:linearGradient :radialGradient :metadata :mask :clipPath :filter :title})
|
|
|
|
(defn- camelize
|
|
[s]
|
|
(when (string? s)
|
|
(let [vendor? (str/starts-with? s "-")
|
|
result #?(:cljs (js* "~{}.replace(\":\", \"-\").replace(/-./g, x=>x[1].toUpperCase())", s)
|
|
:clj (str/camel s))]
|
|
(if ^boolean vendor?
|
|
(str/capital result)
|
|
result))))
|
|
|
|
;; https://www.w3.org/TR/SVG11/eltindex.html
|
|
(def svg-tags
|
|
#{:a
|
|
:altGlyph
|
|
:altGlyphDef
|
|
:altGlyphItem
|
|
:animate
|
|
:animateColor
|
|
:animateMotion
|
|
:animateTransform
|
|
:circle
|
|
:clipPath
|
|
:color-profile
|
|
:cursor
|
|
:defs
|
|
:desc
|
|
:ellipse
|
|
:feBlend
|
|
:feColorMatrix
|
|
:feComponentTransfer
|
|
:feComposite
|
|
:feConvolveMatrix
|
|
:feDiffuseLighting
|
|
:feDisplacementMap
|
|
:feDistantLight
|
|
:feFlood
|
|
:feFuncA
|
|
:feFuncB
|
|
:feFuncG
|
|
:feFuncR
|
|
:feGaussianBlur
|
|
:feImage
|
|
:feMerge
|
|
:feMergeNode
|
|
:feMorphology
|
|
:feOffset
|
|
:fePointLight
|
|
:feSpecularLighting
|
|
:feSpotLight
|
|
:feTile
|
|
:feTurbulence
|
|
:filter
|
|
:font
|
|
:font-face
|
|
:font-face-format
|
|
:font-face-name
|
|
:font-face-src
|
|
:font-face-uri
|
|
:foreignObject
|
|
:g
|
|
:glyph
|
|
:glyphRef
|
|
:hkern
|
|
:image
|
|
:line
|
|
:linearGradient
|
|
:marker
|
|
:mask
|
|
:metadata
|
|
:missing-glyph
|
|
:mpath
|
|
:path
|
|
:pattern
|
|
:polygon
|
|
:polyline
|
|
:radialGradient
|
|
:rect
|
|
:set
|
|
:stop
|
|
:style
|
|
:svg
|
|
:switch
|
|
:symbol
|
|
:text
|
|
:textPath
|
|
:title
|
|
:tref
|
|
:tspan
|
|
:use
|
|
:view
|
|
:vkern})
|
|
|
|
;; https://www.w3.org/TR/SVG11/attindex.html
|
|
(def svg-attrs
|
|
#{:accent-height
|
|
:accumulate
|
|
:additive
|
|
:alphabetic
|
|
:amplitude
|
|
:arabic-form
|
|
:ascent
|
|
:attributeName
|
|
:attributeType
|
|
:azimuth
|
|
:baseFrequency
|
|
:baseProfile
|
|
:bbox
|
|
:begin
|
|
:bias
|
|
:by
|
|
:calcMode
|
|
:cap-height
|
|
:class
|
|
:clipPathUnits
|
|
:contentScriptType
|
|
:contentStyleType
|
|
:cx
|
|
:cy
|
|
:d
|
|
:descent
|
|
:diffuseConstant
|
|
:divisor
|
|
:dur
|
|
:dx
|
|
:dy
|
|
:edgeMode
|
|
:elevation
|
|
:end
|
|
:exponent
|
|
:externalResourcesRequired
|
|
:fill
|
|
:filterRes
|
|
:filterUnits
|
|
:font-family
|
|
:font-size
|
|
:font-stretch
|
|
:font-style
|
|
:font-variant
|
|
:font-weight
|
|
:format
|
|
:from
|
|
:fx
|
|
:fy
|
|
:g1
|
|
:g2
|
|
:glyph-name
|
|
:glyphRef
|
|
:gradientTransform
|
|
:gradientUnits
|
|
:hanging
|
|
:height
|
|
:horiz-adv-x
|
|
:horiz-origin-x
|
|
:horiz-origin-y
|
|
:id
|
|
:ideographic
|
|
:in
|
|
:in2
|
|
:intercept
|
|
:k
|
|
:k1
|
|
:k2
|
|
:k3
|
|
:k4
|
|
:kernelMatrix
|
|
:kernelUnitLength
|
|
:keyPoints
|
|
:keySplines
|
|
:keyTimes
|
|
:lang
|
|
:lengthAdjust
|
|
:limitingConeAngle
|
|
:local
|
|
:markerHeight
|
|
:markerUnits
|
|
:markerWidth
|
|
:maskContentUnits
|
|
:maskUnits
|
|
:mathematical
|
|
:max
|
|
:media
|
|
:method
|
|
:min
|
|
:mode
|
|
:name
|
|
:numOctaves
|
|
:offset
|
|
:operator
|
|
:order
|
|
:orient
|
|
:orientation
|
|
:origin
|
|
:overline-position
|
|
:overline-thickness
|
|
:panose-1
|
|
:path
|
|
:pathLength
|
|
:patternContentUnits
|
|
:patternTransform
|
|
:patternUnits
|
|
:points
|
|
:pointsAtX
|
|
:pointsAtY
|
|
:pointsAtZ
|
|
:preserveAlpha
|
|
:preserveAspectRatio
|
|
:primitiveUnits
|
|
:r
|
|
:radius
|
|
:refX
|
|
:refY
|
|
:rendering-intent
|
|
:repeatCount
|
|
:repeatDur
|
|
:requiredExtensions
|
|
:requiredFeatures
|
|
:restart
|
|
:result
|
|
:rotate
|
|
:rx
|
|
:ry
|
|
:scale
|
|
:seed
|
|
:slope
|
|
:spacing
|
|
:specularConstant
|
|
:specularExponent
|
|
:spreadMethod
|
|
:startOffset
|
|
:stdDeviation
|
|
:stemh
|
|
:stemv
|
|
:stitchTiles
|
|
:strikethrough-position
|
|
:strikethrough-thickness
|
|
:string
|
|
:style
|
|
:surfaceScale
|
|
:systemLanguage
|
|
:tableValues
|
|
:target
|
|
:targetX
|
|
:targetY
|
|
:textLength
|
|
:title
|
|
:to
|
|
:transform
|
|
:type
|
|
:u1
|
|
:u2
|
|
:underline-position
|
|
:underline-thickness
|
|
:unicode
|
|
:unicode-range
|
|
:units-per-em
|
|
:v-alphabetic
|
|
:v-hanging
|
|
:v-ideographic
|
|
:v-mathematical
|
|
:values
|
|
:version
|
|
:vert-adv-y
|
|
:vert-origin-x
|
|
:vert-origin-y
|
|
:viewBox
|
|
:viewTarget
|
|
:width
|
|
:widths
|
|
:x
|
|
:x-height
|
|
:x1
|
|
:x2
|
|
:xChannelSelector
|
|
:xmlns:xlink
|
|
:xlink:actuate
|
|
:xlink:arcrole
|
|
:xlink:href
|
|
:xlink:role
|
|
:xlink:show
|
|
:xlink:title
|
|
:xlink:type
|
|
:xml:base
|
|
:xml:lang
|
|
:xml:space
|
|
:y
|
|
:y1
|
|
:y2
|
|
:yChannelSelector
|
|
:z
|
|
:zoomAndPan})
|
|
|
|
(def svg-presentation-attrs
|
|
"A set of presentation SVG attributes as per SVG spec."
|
|
#{:alignment-baseline
|
|
:baseline-shift
|
|
:clip-path
|
|
:clip-rule
|
|
:clip
|
|
:color-interpolation-filters
|
|
:color-interpolation
|
|
:color-profile
|
|
:color-rendering
|
|
:color
|
|
:cursor
|
|
:direction
|
|
:display
|
|
:dominant-baseline
|
|
:enable-background
|
|
:fill-opacity
|
|
:fill-rule
|
|
:fill
|
|
:filter
|
|
:flood-color
|
|
:flood-opacity
|
|
:font-family
|
|
:font-size-adjust
|
|
:font-size
|
|
:font-stretch
|
|
:font-style
|
|
:font-variant
|
|
:font-weight
|
|
:glyph-orientation-horizontal
|
|
:glyph-orientation-vertical
|
|
:image-rendering
|
|
:kerning
|
|
:letter-spacing
|
|
:lighting-color
|
|
:marker-end
|
|
:marker-mid
|
|
:marker-start
|
|
:mask
|
|
:opacity
|
|
:overflow
|
|
:pointer-events
|
|
:shape-rendering
|
|
:stop-color
|
|
:stop-opacity
|
|
:stroke-dasharray
|
|
:stroke-dashoffset
|
|
:stroke-linecap
|
|
:stroke-linejoin
|
|
:stroke-miterlimit
|
|
:stroke-opacity
|
|
:stroke-width
|
|
:stroke
|
|
:text-anchor
|
|
:text-decoration
|
|
:text-rendering
|
|
:unicode-bidi
|
|
:visibility
|
|
:word-spacing
|
|
:writing-mode
|
|
:mask-type})
|
|
|
|
(def inheritable-props
|
|
#{:style
|
|
:clip-rule
|
|
:color
|
|
:color-interpolation
|
|
:color-interpolation-filters
|
|
:color-profile
|
|
:color-rendering
|
|
:cursor
|
|
:direction
|
|
:dominant-baseline
|
|
:fill
|
|
:fill-opacity
|
|
:fill-rule
|
|
:font
|
|
:font-family
|
|
:font-size
|
|
:font-size-adjust
|
|
:font-stretch
|
|
:font-style
|
|
:font-variant
|
|
:font-weight
|
|
:glyph-orientation-horizontal
|
|
:glyph-orientation-vertical
|
|
:image-rendering
|
|
:letter-spacing
|
|
:marker
|
|
:marker-end
|
|
:marker-mid
|
|
:marker-start
|
|
:paint-order
|
|
:pointer-events
|
|
:shape-rendering
|
|
:stroke
|
|
:stroke-dasharray
|
|
:stroke-dashoffset
|
|
:stroke-linecap
|
|
:stroke-linejoin
|
|
:stroke-miterlimit
|
|
:stroke-opacity
|
|
:stroke-width
|
|
:text-anchor
|
|
:text-rendering
|
|
:transform
|
|
:visibility
|
|
:word-spacing
|
|
:writing-mode})
|
|
|
|
(def gradient-tags
|
|
#{:linearGradient
|
|
:radialGradient})
|
|
|
|
(def filter-tags
|
|
#{:filter
|
|
:feBlend
|
|
:feColorMatrix
|
|
:feComponentTransfer
|
|
:feComposite
|
|
:feConvolveMatrix
|
|
:feDiffuseLighting
|
|
:feDisplacementMap
|
|
:feFlood
|
|
:feGaussianBlur
|
|
:feImage
|
|
:feMerge
|
|
:feMorphology
|
|
:feOffset
|
|
:feSpecularLighting
|
|
:feTile
|
|
:feTurbulence})
|
|
|
|
(def parent-tags
|
|
#{:g
|
|
:svg
|
|
:text
|
|
:tspan})
|
|
|
|
;; By spec: https://www.w3.org/TR/SVG11/single-page.html#struct-GElement
|
|
(def svg-group-safe-tags
|
|
#{:animate
|
|
:animateColor
|
|
:animateMotion
|
|
:animateTransform
|
|
:set
|
|
:desc
|
|
:metadata
|
|
:title
|
|
:circle
|
|
:ellipse
|
|
:line
|
|
:path
|
|
:polygon
|
|
:polyline
|
|
:rect
|
|
:defs
|
|
:g
|
|
:svg
|
|
:symbol
|
|
:use
|
|
:linearGradient
|
|
:radialGradient
|
|
:a
|
|
:altGlyphDef
|
|
:clipPath
|
|
:color-profile
|
|
:cursor
|
|
:filter
|
|
:font
|
|
:font-face
|
|
:foreignObject
|
|
:image
|
|
:marker
|
|
:mask
|
|
:pattern
|
|
:style
|
|
:switch
|
|
:text
|
|
:view})
|
|
|
|
(defn prop-key
|
|
"Convert an attr key to a react compatible prop key. Returns nil if key is empty or invalid"
|
|
[k]
|
|
(let [kn (cond
|
|
(string? k) k
|
|
(keyword? k) (name k))]
|
|
(case kn
|
|
("" nil) nil
|
|
"class" :className
|
|
"for" :htmlFor
|
|
(let [kn1 (subs kn 0 1)]
|
|
(if (= kn1 (str/upper kn1))
|
|
(-> kn camelize str/capital keyword)
|
|
(-> kn camelize keyword))))))
|
|
|
|
(def svg-props
|
|
"A set of all attrs (including the presentation) converted to
|
|
camelCase for make it React compatible."
|
|
(let [xf (map prop-key)]
|
|
(-> #{}
|
|
(into xf svg-attrs)
|
|
(into xf svg-presentation-attrs))))
|
|
|
|
;; Defaults for some tags per spec https://www.w3.org/TR/SVG11/single-page.html
|
|
;; they are basically the defaults that can be percents and we need to replace because
|
|
;; otherwise won't work as expected in the workspace
|
|
(def svg-tag-defaults
|
|
(let [filter-default {:units :filterUnits
|
|
:default "objectBoundingBox"
|
|
"objectBoundingBox" {}
|
|
"userSpaceOnUse" {:x "-10%" :y "-10%" :width "120%" :height "120%"}}
|
|
filter-values (->> filter-tags
|
|
(reduce #(merge %1 (hash-map %2 filter-default)) {}))]
|
|
|
|
(merge {:linearGradient {:units :gradientUnits
|
|
:default "objectBoundingBox"
|
|
"objectBoundingBox" {}
|
|
"userSpaceOnUse" {:x1 "0%" :y1 "0%" :x2 "100%" :y2 "0%"}}
|
|
:radialGradient {:units :gradientUnits
|
|
:default "objectBoundingBox"
|
|
"objectBoundingBox" {}
|
|
"userSpaceOnUse" {:cx "50%" :cy "50%" :r "50%"}}
|
|
:mask {:units :maskUnits
|
|
:default "userSpaceOnUse"
|
|
"objectBoundingBox" {}
|
|
"userSpaceOnUse" {:x "-10%" :y "-10%" :width "120%" :height "120%"}}}
|
|
filter-values)))
|
|
|
|
(defn extract-ids [val]
|
|
(when (some? val)
|
|
(->> (re-seq xml-id-regex val)
|
|
(mapv second))))
|
|
|
|
(defn fix-dot-number
|
|
"Fixes decimal numbers starting in dot but without leading 0"
|
|
[num-str]
|
|
(cond
|
|
(str/starts-with? num-str ".")
|
|
(dm/str "0" num-str)
|
|
|
|
(str/starts-with? num-str "-.")
|
|
(dm/str "-0" (subs num-str 1))
|
|
|
|
:else
|
|
num-str))
|
|
|
|
(defn parse-style
|
|
[style]
|
|
(reduce (fn [res item]
|
|
(let [[k v] (-> (str/trim item) (str/split ":" 2))
|
|
k (keyword k)]
|
|
(if (contains? res k)
|
|
res
|
|
(assoc res (keyword k) v))))
|
|
{}
|
|
(str/split style ";")))
|
|
|
|
;; FIXME: rename to `format-style` or directly use parse-style on code...
|
|
(defn format-styles
|
|
"Transform string based styles found on attrs map to key-value map."
|
|
[attrs]
|
|
(if (contains? attrs :style)
|
|
(update attrs :style
|
|
(fn [style]
|
|
(if (string? style)
|
|
(parse-style style)
|
|
style)))
|
|
attrs))
|
|
|
|
(defn attrs->props
|
|
"Transforms and cleans svg attributes to react compatible props"
|
|
([attrs]
|
|
(attrs->props attrs true))
|
|
|
|
([attrs whitelist?]
|
|
(reduce-kv (fn [res k v]
|
|
(let [k (prop-key k)]
|
|
(cond
|
|
(nil? k)
|
|
res
|
|
|
|
(nil? v)
|
|
res
|
|
|
|
(= k :style)
|
|
(let [v (if (string? v) (parse-style v) v)
|
|
v (not-empty (attrs->props v false))]
|
|
(if v
|
|
(assoc res k v)
|
|
res))
|
|
|
|
:else
|
|
(if (or (not whitelist?) (contains? svg-props k))
|
|
(let [v (if (string? v) (str/trim v) v)]
|
|
(assoc res k v))
|
|
res))))
|
|
{}
|
|
attrs)))
|
|
|
|
(defn update-attr-ids
|
|
"Replaces the ids inside a property"
|
|
[attrs replace-fn]
|
|
(letfn [(update-ids [key val]
|
|
(cond
|
|
(map? val)
|
|
(d/mapm update-ids val)
|
|
|
|
(= key :id)
|
|
(replace-fn val)
|
|
|
|
:else
|
|
(let [replace-id
|
|
(fn [result it]
|
|
(let [to-replace (replace-fn it)]
|
|
(str/replace result (str "#" it) (str "#" to-replace))))]
|
|
(reduce replace-id val (extract-ids val)))))]
|
|
|
|
(d/mapm update-ids attrs)))
|
|
|
|
(defn replace-attrs-ids
|
|
"Replaces the ids inside a property"
|
|
[attrs ids-mapping]
|
|
(if (empty? ids-mapping)
|
|
attrs
|
|
(update-attr-ids attrs (fn [id] (get ids-mapping id id)))))
|
|
|
|
(defn generate-id-mapping
|
|
[content]
|
|
(letfn [(visit-node [result node]
|
|
(let [element-id (dm/get-in node [:attrs :id])
|
|
result (if (some? element-id)
|
|
(assoc result element-id (dm/str (uuid/next)))
|
|
result)]
|
|
(reduce visit-node result (:content node))))]
|
|
(visit-node {} content)))
|
|
|
|
(defn extract-defs
|
|
[{:keys [attrs] :as node}]
|
|
(if-not (map? node)
|
|
[{} node]
|
|
|
|
(let [remove-node? (fn [{:keys [tag]}] (and (some? tag)
|
|
(or (contains? tags-to-remove tag)
|
|
(not (contains? svg-tags tag)))))
|
|
rec-result (->> (:content node) (map extract-defs))
|
|
node (assoc node :content (->> rec-result (map second) (filterv (comp not remove-node?))))
|
|
|
|
current-node-defs (if (contains? attrs :id)
|
|
(hash-map (:id attrs) node)
|
|
(hash-map))
|
|
|
|
node-defs (->> rec-result (map first) (reduce merge current-node-defs))]
|
|
|
|
[node-defs node])))
|
|
|
|
(defn find-attr-references
|
|
[attrs]
|
|
(->> attrs
|
|
(mapcat (fn [[_ attr-value]]
|
|
(if (string? attr-value)
|
|
(extract-ids attr-value)
|
|
(find-attr-references attr-value))))))
|
|
|
|
(defn find-node-references
|
|
[node]
|
|
(let [current (->> (find-attr-references (:attrs node)) (into #{}))
|
|
children (->> (:content node) (map find-node-references) (flatten) (into #{}))]
|
|
(vec (into current children))))
|
|
|
|
(defn find-def-references
|
|
[defs references]
|
|
(loop [result (into #{} references)
|
|
checked? #{}
|
|
to-check (first references)
|
|
pending (rest references)]
|
|
|
|
(cond
|
|
(nil? to-check)
|
|
result
|
|
|
|
(checked? to-check)
|
|
(recur result
|
|
checked?
|
|
(first pending)
|
|
(rest pending))
|
|
|
|
:else
|
|
(let [node (get defs to-check)
|
|
new-refs (find-node-references node)
|
|
pending (concat pending new-refs)]
|
|
(recur (into result new-refs)
|
|
(conj checked? to-check)
|
|
(first pending)
|
|
(rest pending))))))
|
|
|
|
(defn svg-transform-matrix
|
|
[shape]
|
|
(if (:svg-viewbox shape)
|
|
(let [{svg-x :x
|
|
svg-y :y
|
|
svg-width :width
|
|
svg-height :height} (:svg-viewbox shape)
|
|
{:keys [x y width height]} (:selrect shape)
|
|
|
|
scale-x (/ width svg-width)
|
|
scale-y (/ height svg-height)]
|
|
|
|
(gmt/multiply
|
|
(gmt/matrix)
|
|
|
|
;; Paths doesn't have transform so we have to transform its gradients
|
|
(if (or (= :path (:type shape))
|
|
(= :group (:type shape)))
|
|
(gsh/transform-matrix shape)
|
|
(gmt/matrix))
|
|
|
|
(gmt/translate-matrix (gpt/point (- x (* scale-x svg-x)) (- y (* scale-y svg-y))))
|
|
(gmt/scale-matrix (gpt/point scale-x scale-y))))
|
|
|
|
;; :else
|
|
(gmt/matrix)))
|
|
|
|
;; Parse transform attributes to native matrix format so we can transform paths instead of
|
|
;; relying in SVG transformation. This is necessary to import SVG's and not to break path tooling
|
|
;;
|
|
;; Transforms spec:
|
|
;; https://www.w3.org/TR/SVG11/single-page.html#coords-TransformAttribute
|
|
|
|
(defn- format-translate-params
|
|
[params]
|
|
(assert (or (= (count params) 1) (= (count params) 2)))
|
|
(if (= (count params) 1)
|
|
[(gpt/point (nth params 0) 0)]
|
|
[(gpt/point (nth params 0) (nth params 1))]))
|
|
|
|
(defn- format-scale-params
|
|
[params]
|
|
(assert (or (= (count params) 1) (= (count params) 2)))
|
|
(if (= (count params) 1)
|
|
[(gpt/point (nth params 0))]
|
|
[(gpt/point (nth params 0) (nth params 1))]))
|
|
|
|
(defn- format-rotate-params
|
|
[params]
|
|
(assert (or (= (count params) 1) (= (count params) 3)) (str "??" (count params)))
|
|
(if (= (count params) 1)
|
|
[(nth params 0) (gpt/point 0 0)]
|
|
[(nth params 0) (gpt/point (nth params 1) (nth params 2))]))
|
|
|
|
(defn- format-skew-x-params
|
|
[params]
|
|
(assert (= (count params) 1))
|
|
[(nth params 0) 0])
|
|
|
|
(defn- format-skew-y-params
|
|
[params]
|
|
(assert (= (count params) 1))
|
|
[0 (nth params 0)])
|
|
|
|
(defn- to-matrix
|
|
[type params]
|
|
(case type
|
|
"matrix" (apply gmt/matrix params)
|
|
"translate" (apply gmt/translate-matrix (format-translate-params params))
|
|
"scale" (apply gmt/scale-matrix (format-scale-params params))
|
|
"rotate" (apply gmt/rotate-matrix (format-rotate-params params))
|
|
"skewX" (apply gmt/skew-matrix (format-skew-x-params params))
|
|
"skewY" (apply gmt/skew-matrix (format-skew-y-params params))))
|
|
|
|
(def ^:private
|
|
xf-parse-numbers
|
|
(comp
|
|
(map first)
|
|
(keep not-empty)
|
|
(map d/parse-double)))
|
|
|
|
(defn parse-numbers
|
|
[data]
|
|
(->> (re-seq number-regex data)
|
|
(into [] xf-parse-numbers)))
|
|
|
|
(defn parse-transform
|
|
[transform]
|
|
(if (string? transform)
|
|
(->> (re-seq matrices-regex transform)
|
|
(map (fn [[_ type params]]
|
|
(let [params (parse-numbers params)]
|
|
(to-matrix type params))))
|
|
(reduce gmt/multiply (gmt/matrix)))
|
|
|
|
(gmt/matrix)))
|
|
|
|
(defn format-move [[x y]] (str "M" x " " y))
|
|
(defn format-line [[x y]] (str "L" x " " y))
|
|
|
|
(defn points->path
|
|
[points-str]
|
|
(let [points (->> points-str
|
|
(re-seq number-regex)
|
|
(filter (comp not empty? first))
|
|
(mapv (comp d/parse-double first))
|
|
(partition 2))
|
|
|
|
head (first points)
|
|
other (rest points)]
|
|
|
|
(str (format-move head)
|
|
(->> other (map format-line) (str/join " ")))))
|
|
|
|
(defn polyline->path [{:keys [attrs] :as node}]
|
|
(let [tag :path
|
|
attrs (-> attrs
|
|
(dissoc :points)
|
|
(assoc :d (points->path (:points attrs))))]
|
|
|
|
(assoc node :attrs attrs :tag tag)))
|
|
|
|
(defn polygon->path [{:keys [attrs] :as node}]
|
|
(let [tag :path
|
|
attrs (-> attrs
|
|
(dissoc :points)
|
|
(assoc :d (str (points->path (:points attrs)) "Z")))]
|
|
(assoc node :attrs attrs :tag tag)))
|
|
|
|
(defn line->path [{:keys [attrs] :as node}]
|
|
(let [tag :path
|
|
{:keys [x1 y1 x2 y2]} attrs
|
|
x1 (or x1 0)
|
|
y1 (or y1 0)
|
|
x2 (or x2 0)
|
|
y2 (or y2 0)
|
|
attrs (-> attrs
|
|
(dissoc :x1 :x2 :y1 :y2)
|
|
(assoc :d (str "M" x1 "," y1 " L" x2 "," y2)))]
|
|
|
|
(assoc node :attrs attrs :tag tag)))
|
|
|
|
(defn add-transform [attrs transform]
|
|
(letfn [(append-transform [old-transform]
|
|
(if (or (nil? old-transform) (empty? old-transform))
|
|
transform
|
|
(str transform " " old-transform)))]
|
|
|
|
(cond-> attrs
|
|
transform
|
|
(update :transform append-transform))))
|
|
|
|
(defn inherit-attributes
|
|
[group-attrs {:keys [attrs] :as node}]
|
|
(if (map? node)
|
|
(let [attrs (-> (format-styles attrs)
|
|
(add-transform (:transform group-attrs)))
|
|
group-attrs (format-styles group-attrs)
|
|
|
|
;; Don't inherit a property that is already in the style attribute
|
|
inherit-style (-> (:style group-attrs) (d/without-keys (keys attrs)))
|
|
inheritable-props (->> inheritable-props (remove #(contains? (:styles attrs) %)))
|
|
group-attrs (-> group-attrs (assoc :style inherit-style))
|
|
|
|
attrs (-> (select-keys group-attrs inheritable-props)
|
|
(d/deep-merge attrs)
|
|
(d/without-nils))]
|
|
(assoc node :attrs attrs))
|
|
node))
|
|
|
|
(defn map-nodes [mapfn node]
|
|
(let [update-content
|
|
(fn [content] (cond->> content
|
|
(vector? content)
|
|
(mapv (partial map-nodes mapfn))))]
|
|
|
|
(cond-> node
|
|
(map? node)
|
|
(-> (mapfn)
|
|
(d/update-when :content update-content)))))
|
|
|
|
(defn reduce-nodes [redfn value node]
|
|
(let [reduce-content
|
|
(fn [value content]
|
|
(loop [current (first content)
|
|
content (rest content)
|
|
value value]
|
|
(if (nil? current)
|
|
value
|
|
(recur (first content)
|
|
(rest content)
|
|
(reduce-nodes redfn value current)))))]
|
|
|
|
(if (map? node)
|
|
(-> (redfn value node)
|
|
(reduce-content (:content node)))
|
|
value)))
|
|
|
|
(defn fix-default-values
|
|
"Gives values to some SVG elements which defaults won't work when imported into the platform"
|
|
[svg-data]
|
|
(let [add-defaults
|
|
(fn [{:keys [tag attrs] :as node}]
|
|
(let [prop (get-in svg-tag-defaults [tag :units])
|
|
default-units (get-in svg-tag-defaults [tag :default])
|
|
units (get attrs prop default-units)
|
|
tag-default (get-in svg-tag-defaults [tag units])]
|
|
(d/update-when node :attrs #(merge tag-default %))))
|
|
|
|
fix-node-defaults
|
|
(fn [node]
|
|
(cond-> node
|
|
(contains? svg-tag-defaults (:tag node))
|
|
(add-defaults)))]
|
|
|
|
(->> svg-data (map-nodes fix-node-defaults))))
|
|
|
|
(defn calculate-ratio
|
|
;; sqrt((actual-width)**2 + (actual-height)**2)/sqrt(2).
|
|
[width height]
|
|
(/ (mth/hypot width height)
|
|
(mth/sqrt 2)))
|
|
|
|
(defn fix-percents
|
|
"Changes percents to a value according to the size of the svg imported"
|
|
[svg-data]
|
|
;; https://www.w3.org/TR/SVG11/single-page.html#coords-Units
|
|
(let [viewbox {:x (:offset-x svg-data)
|
|
:y (:offset-y svg-data)
|
|
:width (:width svg-data)
|
|
:height (:height svg-data)
|
|
:ratio (calculate-ratio (:width svg-data) (:height svg-data))}]
|
|
(letfn [(fix-length [prop-length val]
|
|
(* (get viewbox prop-length) (/ val 100.)))
|
|
|
|
(fix-coord [prop-coord prop-length val]
|
|
(+ (get viewbox prop-coord)
|
|
(fix-length prop-length val)))
|
|
|
|
(fix-percent-attr-viewbox [attr-key attr-val]
|
|
(let [is-percent? (str/ends-with? attr-val "%")
|
|
is-x? #{:x :x1 :x2 :cx}
|
|
is-y? #{:y :y1 :y2 :cy}
|
|
is-width? #{:width}
|
|
is-height? #{:height}
|
|
is-other? #{:r :stroke-width}]
|
|
|
|
(if is-percent?
|
|
(let [attr-num (d/parse-double (str/rtrim attr-val "%"))]
|
|
(str (cond
|
|
(is-x? attr-key) (fix-coord :x :width attr-num)
|
|
(is-y? attr-key) (fix-coord :y :height attr-num)
|
|
(is-width? attr-key) (fix-length :width attr-num)
|
|
(is-height? attr-key) (fix-length :height attr-num)
|
|
(is-other? attr-key) (fix-length :ratio attr-num)
|
|
:else attr-val)))
|
|
attr-val)))
|
|
|
|
(fix-percent-attrs-viewbox [attrs]
|
|
(d/mapm fix-percent-attr-viewbox attrs))
|
|
|
|
(fix-percent-attr-numeric [_ attr-val]
|
|
(let [is-percent? (str/ends-with? attr-val "%")]
|
|
(if is-percent?
|
|
(str (let [attr-num (d/parse-double (str/rtrim attr-val "%"))]
|
|
(/ attr-num 100)))
|
|
attr-val)))
|
|
|
|
(fix-percent-attrs-numeric [attrs]
|
|
(d/mapm fix-percent-attr-numeric attrs))
|
|
|
|
(fix-percent-values [node]
|
|
(let [units (or (get-in node [:attrs :filterUnits])
|
|
(get-in node [:attrs :gradientUnits])
|
|
(get-in node [:attrs :patternUnits])
|
|
(get-in node [:attrs :clipUnits]))]
|
|
(cond-> node
|
|
(or (= "objectBoundingBox" units) (nil? units))
|
|
(update :attrs fix-percent-attrs-numeric)
|
|
|
|
(not= "objectBoundingBox" units)
|
|
(update :attrs fix-percent-attrs-viewbox))))]
|
|
|
|
(->> svg-data (map-nodes fix-percent-values)))))
|
|
|
|
(defn collect-images [svg-data]
|
|
(let [redfn (fn [acc {:keys [tag attrs]}]
|
|
(cond-> acc
|
|
(= :image tag)
|
|
(conj {:href (or (:href attrs) (:xlink:href attrs))
|
|
:width (d/parse-integer (:width attrs) 0)
|
|
:height (d/parse-integer (:height attrs) 0)})))]
|
|
(reduce-nodes redfn [] svg-data)))
|
|
|
|
#?(:clj
|
|
(defn- secure-parser-factory
|
|
[^InputStream input ^XMLHandler handler]
|
|
(.. (doto (SAXParserFactory/newInstance)
|
|
(.setFeature XMLConstants/FEATURE_SECURE_PROCESSING true)
|
|
(.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true))
|
|
(newSAXParser)
|
|
(parse input handler))))
|
|
|
|
(defn strip-doctype
|
|
[data]
|
|
(cond-> data
|
|
(str/includes? data "<!DOCTYPE")
|
|
(str/replace #"<\!DOCTYPE[^>]*>" "")))
|
|
|
|
|
|
(defn parse
|
|
[text]
|
|
#?(:cljs (tubax/xml->clj text)
|
|
:clj (let [text (strip-doctype text)]
|
|
(dm/with-open [istream (IOUtils/toInputStream text "UTF-8")]
|
|
(xml/parse istream secure-parser-factory)))))
|
|
|
|
;; FIXME pass correct plugin set
|
|
#?(:cljs
|
|
(defn optimize
|
|
([input] (optimize input nil))
|
|
([input options]
|
|
(svgo/optimize input (clj->js options)))))
|