mirror of
https://github.com/penpot/penpot.git
synced 2026-05-23 17:03:41 +00:00
516 lines
22 KiB
Clojure
516 lines
22 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.main.data.workspace.svg-upload
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.geom.matrix :as gmt]
|
|
[app.common.geom.point :as gpt]
|
|
[app.common.geom.shapes :as gsh]
|
|
[app.common.pages.changes-builder :as pcb]
|
|
[app.common.spec :refer [max-safe-int min-safe-int]]
|
|
[app.common.types.shape :as cts]
|
|
[app.common.types.shape-tree :as ctst]
|
|
[app.common.uuid :as uuid]
|
|
[app.main.data.workspace.changes :as dch]
|
|
[app.main.data.workspace.selection :as dws]
|
|
[app.main.data.workspace.shapes :as dwsh]
|
|
[app.main.data.workspace.state-helpers :as wsh]
|
|
[app.util.color :as uc]
|
|
[app.util.path.parser :as upp]
|
|
[app.util.svg :as usvg]
|
|
[beicon.core :as rx]
|
|
[cuerdas.core :as str]
|
|
[potok.core :as ptk]))
|
|
|
|
(defonce default-rect {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
|
|
(defonce default-circle {:r 0 :cx 0 :cy 0})
|
|
(defonce default-image {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
|
|
|
|
(defn- assert-valid-num [attr num]
|
|
(when (or (not (d/num? num))
|
|
(>= num max-safe-int )
|
|
(<= num min-safe-int))
|
|
(ex/raise (str (d/name attr) " attribute invalid: " num)))
|
|
|
|
;; If the number is between 0-1 we round to 1 (same in negative form
|
|
(cond
|
|
(and (> num 0) (< num 1)) 1
|
|
(and (< num 0) (> num -1)) -1
|
|
:else num))
|
|
|
|
(defn- assert-valid-pos-num [attr num]
|
|
(let [num (assert-valid-num attr num)]
|
|
(when (< num 0)
|
|
(ex/raise (str (d/name attr) " attribute invalid: " num)))
|
|
num))
|
|
|
|
(defn- svg-dimensions [data]
|
|
(let [width (get-in data [:attrs :width] 100)
|
|
height (get-in data [:attrs :height] 100)
|
|
viewbox (get-in data [:attrs :viewBox] (str "0 0 " width " " height))
|
|
[x y width height] (->> (str/split viewbox #"\s+")
|
|
(map d/parse-double))]
|
|
[(assert-valid-num :x x)
|
|
(assert-valid-num :y y)
|
|
(assert-valid-pos-num :width width)
|
|
(assert-valid-pos-num :height height)]))
|
|
|
|
(defn tag->name
|
|
"Given a tag returns its layer name"
|
|
[tag]
|
|
(str "svg-" (cond (string? tag) tag
|
|
(keyword? tag) (d/name tag)
|
|
(nil? tag) "node"
|
|
:else (str tag))))
|
|
|
|
(defn setup-fill [shape]
|
|
(cond-> shape
|
|
;; Color present as attribute
|
|
(uc/color? (str/trim (get-in shape [:svg-attrs :fill])))
|
|
(-> (update :svg-attrs dissoc :fill)
|
|
(update-in [:svg-attrs :style] dissoc :fill)
|
|
(assoc-in [:fills 0 :fill-color] (-> (get-in shape [:svg-attrs :fill])
|
|
(str/trim)
|
|
(uc/parse-color))))
|
|
|
|
;; Color present as style
|
|
(uc/color? (str/trim (get-in shape [:svg-attrs :style :fill])))
|
|
(-> (update-in [:svg-attrs :style] dissoc :fill)
|
|
(update :svg-attrs dissoc :fill)
|
|
(assoc-in [:fills 0 :fill-color] (-> (get-in shape [:svg-attrs :style :fill])
|
|
(str/trim)
|
|
(uc/parse-color))))
|
|
|
|
(get-in shape [:svg-attrs :fill-opacity])
|
|
(-> (update :svg-attrs dissoc :fill-opacity)
|
|
(update-in [:svg-attrs :style] dissoc :fill-opacity)
|
|
(assoc-in [:fills 0 :fill-opacity] (-> (get-in shape [:svg-attrs :fill-opacity])
|
|
(d/parse-double))))
|
|
|
|
(get-in shape [:svg-attrs :style :fill-opacity])
|
|
(-> (update-in [:svg-attrs :style] dissoc :fill-opacity)
|
|
(update :svg-attrs dissoc :fill-opacity)
|
|
(assoc-in [:fills 0 :fill-opacity] (-> (get-in shape [:svg-attrs :style :fill-opacity])
|
|
(d/parse-double))))))
|
|
|
|
(defn setup-stroke [shape]
|
|
(let [stroke-linecap (-> (or (get-in shape [:svg-attrs :stroke-linecap])
|
|
(get-in shape [:svg-attrs :style :stroke-linecap]))
|
|
((d/nilf str/trim))
|
|
((d/nilf keyword)))
|
|
|
|
shape
|
|
(cond-> shape
|
|
(uc/color? (str/trim (get-in shape [:svg-attrs :stroke])))
|
|
(-> (update :svg-attrs dissoc :stroke)
|
|
(assoc-in [:strokes 0 :stroke-color] (-> (get-in shape [:svg-attrs :stroke])
|
|
(str/trim)
|
|
(uc/parse-color))))
|
|
|
|
(uc/color? (str/trim (get-in shape [:svg-attrs :style :stroke])))
|
|
(-> (update-in [:svg-attrs :style] dissoc :stroke)
|
|
(assoc-in [:strokes 0 :stroke-color] (-> (get-in shape [:svg-attrs :style :stroke])
|
|
(str/trim)
|
|
(uc/parse-color))))
|
|
|
|
(get-in shape [:svg-attrs :stroke-opacity])
|
|
(-> (update :svg-attrs dissoc :stroke-opacity)
|
|
(assoc-in [:strokes 0 :stroke-opacity] (-> (get-in shape [:svg-attrs :stroke-opacity])
|
|
(d/parse-double))))
|
|
|
|
(get-in shape [:svg-attrs :style :stroke-opacity])
|
|
(-> (update-in [:svg-attrs :style] dissoc :stroke-opacity)
|
|
(assoc-in [:strokes 0 :stroke-opacity] (-> (get-in shape [:svg-attrs :style :stroke-opacity])
|
|
(d/parse-double))))
|
|
|
|
(get-in shape [:svg-attrs :stroke-width])
|
|
(-> (update :svg-attrs dissoc :stroke-width)
|
|
(assoc-in [:strokes 0 :stroke-width] (-> (get-in shape [:svg-attrs :stroke-width])
|
|
(d/parse-double))))
|
|
|
|
(get-in shape [:svg-attrs :style :stroke-width])
|
|
(-> (update-in [:svg-attrs :style] dissoc :stroke-width)
|
|
(assoc-in [:strokes 0 :stroke-width] (-> (get-in shape [:svg-attrs :style :stroke-width])
|
|
(d/parse-double))))
|
|
|
|
(and stroke-linecap (= (:type shape) :path))
|
|
(-> (update-in [:svg-attrs :style] dissoc :stroke-linecap)
|
|
(cond-> (#{:round :square} stroke-linecap)
|
|
(assoc :stroke-cap-start stroke-linecap
|
|
:stroke-cap-end stroke-linecap))))]
|
|
|
|
(cond-> shape
|
|
(d/any-key? (get-in shape [:strokes 0]) :stroke-color :stroke-opacity :stroke-width :stroke-cap-start :stroke-cap-end)
|
|
(assoc-in [:strokes 0 :stroke-style] :svg))))
|
|
|
|
(defn setup-opacity [shape]
|
|
(cond-> shape
|
|
(get-in shape [:svg-attrs :opacity])
|
|
(-> (update :svg-attrs dissoc :opacity)
|
|
(assoc :opacity (get-in shape [:svg-attrs :opacity])))
|
|
|
|
(get-in shape [:svg-attrs :style :opacity])
|
|
(-> (update-in [:svg-attrs :style] dissoc :opacity)
|
|
(assoc :opacity (get-in shape [:svg-attrs :style :opacity])))
|
|
|
|
|
|
(get-in shape [:svg-attrs :mix-blend-mode])
|
|
(-> (update :svg-attrs dissoc :mix-blend-mode)
|
|
(assoc :blend-mode (-> (get-in shape [:svg-attrs :mix-blend-mode]) keyword)))
|
|
|
|
(get-in shape [:svg-attrs :style :mix-blend-mode])
|
|
(-> (update-in [:svg-attrs :style] dissoc :mix-blend-mode)
|
|
(assoc :blend-mode (-> (get-in shape [:svg-attrs :style :mix-blend-mode]) keyword)))))
|
|
|
|
(defn create-raw-svg [name frame-id svg-data {:keys [attrs] :as data}]
|
|
(let [{:keys [x y width height offset-x offset-y]} svg-data]
|
|
(-> {:id (uuid/next)
|
|
:type :svg-raw
|
|
:name name
|
|
:frame-id frame-id
|
|
:width width
|
|
:height height
|
|
:x x
|
|
:y y
|
|
:content (cond-> data
|
|
(map? data) (update :attrs usvg/clean-attrs))}
|
|
(assoc :svg-attrs attrs)
|
|
(assoc :svg-viewbox (-> (select-keys svg-data [:width :height])
|
|
(assoc :x offset-x :y offset-y)))
|
|
(cts/setup-rect-selrect))))
|
|
|
|
(defn create-svg-root [frame-id svg-data]
|
|
(let [{:keys [name x y width height offset-x offset-y]} svg-data]
|
|
(-> {:id (uuid/next)
|
|
:type :group
|
|
:name name
|
|
:frame-id frame-id
|
|
:width width
|
|
:height height
|
|
:x (+ x offset-x)
|
|
:y (+ y offset-y)}
|
|
(cts/setup-rect-selrect)
|
|
(assoc :svg-attrs (-> (:attrs svg-data)
|
|
(dissoc :viewBox :xmlns)
|
|
(d/without-keys usvg/inheritable-props))))))
|
|
|
|
(defn create-group [name frame-id svg-data {:keys [attrs]}]
|
|
(let [svg-transform (usvg/parse-transform (:transform attrs))
|
|
{:keys [x y width height offset-x offset-y]} svg-data]
|
|
(-> {:id (uuid/next)
|
|
:type :group
|
|
:name name
|
|
:frame-id frame-id
|
|
:x (+ x offset-x)
|
|
:y (+ y offset-y)
|
|
:width width
|
|
:height height}
|
|
(assoc :svg-transform svg-transform)
|
|
(assoc :svg-attrs (d/without-keys attrs usvg/inheritable-props))
|
|
(assoc :svg-viewbox (-> (select-keys svg-data [:width :height])
|
|
(assoc :x offset-x :y offset-y)))
|
|
(cts/setup-rect-selrect))))
|
|
|
|
(defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
|
|
(when (and (contains? attrs :d) (seq (:d attrs)))
|
|
(let [svg-transform (usvg/parse-transform (:transform attrs))
|
|
path-content (upp/parse-path (:d attrs))
|
|
content (cond-> path-content
|
|
svg-transform
|
|
(gsh/transform-content svg-transform))
|
|
|
|
selrect (gsh/content->selrect content)
|
|
points (gsh/rect->points selrect)
|
|
|
|
origin (gpt/negate (gpt/point svg-data))]
|
|
(-> {:id (uuid/next)
|
|
:type :path
|
|
:name name
|
|
:frame-id frame-id
|
|
:content content
|
|
:selrect selrect
|
|
:points points}
|
|
(assoc :svg-viewbox (select-keys selrect [:x :y :width :height]))
|
|
(assoc :svg-attrs (dissoc attrs :d :transform))
|
|
(assoc :svg-transform svg-transform)
|
|
(gsh/translate-to-frame origin)))))
|
|
|
|
(defn calculate-rect-metadata [rect-data transform]
|
|
(let [points (-> (gsh/rect->points rect-data)
|
|
(gsh/transform-points transform))
|
|
|
|
center (gsh/center-points points)
|
|
rect-shape (gsh/center->rect center (:width rect-data) (:height rect-data))
|
|
selrect (gsh/rect->selrect rect-shape)
|
|
rect-points (gsh/rect->points rect-shape)
|
|
|
|
[shape-transform shape-transform-inv rotation]
|
|
(gsh/calculate-adjust-matrix points rect-points (neg? (:a transform)) (neg? (:d transform)))]
|
|
|
|
(merge rect-shape
|
|
{:selrect selrect
|
|
:points points
|
|
:rotation rotation
|
|
:transform shape-transform
|
|
:transform-inverse shape-transform-inv})))
|
|
|
|
|
|
(defn create-rect-shape [name frame-id svg-data {:keys [attrs] :as data}]
|
|
(let [svg-transform (usvg/parse-transform (:transform attrs))
|
|
transform (->> svg-transform
|
|
(gmt/transform-in (gpt/point svg-data)))
|
|
|
|
rect (->> (select-keys attrs [:x :y :width :height])
|
|
(d/mapm #(d/parse-double %2)))
|
|
|
|
origin (gpt/negate (gpt/point svg-data))
|
|
|
|
rect-data (-> (merge default-rect rect)
|
|
(update :x - (:x origin))
|
|
(update :y - (:y origin)))
|
|
|
|
metadata (calculate-rect-metadata rect-data transform)]
|
|
(-> {:id (uuid/next)
|
|
:type :rect
|
|
:name name
|
|
:frame-id frame-id}
|
|
(cond->
|
|
(contains? attrs :rx) (assoc :rx (d/parse-double (:rx attrs 0)))
|
|
(contains? attrs :ry) (assoc :ry (d/parse-double (:ry attrs 0))))
|
|
|
|
(merge metadata)
|
|
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
|
|
(assoc :svg-attrs (dissoc attrs :x :y :width :height :rx :ry :transform)))))
|
|
|
|
|
|
(defn create-circle-shape [name frame-id svg-data {:keys [attrs] :as data}]
|
|
(let [svg-transform (usvg/parse-transform (:transform attrs))
|
|
transform (->> svg-transform
|
|
(gmt/transform-in (gpt/point svg-data)))
|
|
|
|
circle (->> (select-keys attrs [:r :ry :rx :cx :cy])
|
|
(d/mapm #(d/parse-double %2)))
|
|
|
|
{:keys [cx cy]} circle
|
|
|
|
rx (or (:r circle) (:rx circle))
|
|
ry (or (:r circle) (:ry circle))
|
|
|
|
rect {:x (- cx rx)
|
|
:y (- cy ry)
|
|
:width (* 2 rx)
|
|
:height (* 2 ry)}
|
|
|
|
origin (gpt/negate (gpt/point svg-data))
|
|
|
|
rect-data (-> rect
|
|
(update :x - (:x origin))
|
|
(update :y - (:y origin)))
|
|
|
|
metadata (calculate-rect-metadata rect-data transform)]
|
|
(-> {:id (uuid/next)
|
|
:type :circle
|
|
:name name
|
|
:frame-id frame-id}
|
|
|
|
(merge metadata)
|
|
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
|
|
(assoc :svg-attrs (dissoc attrs :cx :cy :r :rx :ry :transform)))))
|
|
|
|
(defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}]
|
|
(let [svg-transform (usvg/parse-transform (:transform attrs))
|
|
transform (->> svg-transform
|
|
(gmt/transform-in (gpt/point svg-data)))
|
|
|
|
image-url (or (:href attrs) (:xlink:href attrs))
|
|
image-data (get-in svg-data [:image-data image-url])
|
|
|
|
rect (->> (select-keys attrs [:x :y :width :height])
|
|
(d/mapm #(d/parse-double %2)))
|
|
|
|
origin (gpt/negate (gpt/point svg-data))
|
|
|
|
rect-data (-> (merge default-image rect)
|
|
(update :x - (:x origin))
|
|
(update :y - (:y origin)))
|
|
|
|
rect-metadata (calculate-rect-metadata rect-data transform)]
|
|
|
|
(when (some? image-data)
|
|
(-> {:id (uuid/next)
|
|
:type :image
|
|
:name name
|
|
:frame-id frame-id
|
|
:metadata {:width (:width image-data)
|
|
:height (:height image-data)
|
|
:mtype (:mtype image-data)
|
|
:id (:id image-data)}}
|
|
|
|
(merge rect-metadata)
|
|
(assoc :svg-viewbox (select-keys rect [:x :y :width :height]))
|
|
(assoc :svg-attrs (dissoc attrs :x :y :width :height :href :xlink:href))))))
|
|
|
|
(defn parse-svg-element [frame-id svg-data element-data unames]
|
|
(let [{:keys [tag attrs hidden]} element-data
|
|
attrs (usvg/format-styles attrs)
|
|
element-data (cond-> element-data (map? element-data) (assoc :attrs attrs))
|
|
name (ctst/generate-unique-name unames (or (:id attrs) (tag->name tag)))
|
|
att-refs (usvg/find-attr-references attrs)
|
|
references (usvg/find-def-references (:defs svg-data) att-refs)
|
|
|
|
href-id (-> (or (:href attrs) (:xlink:href attrs) "")
|
|
(subs 1))
|
|
defs (:defs svg-data)
|
|
|
|
use-tag? (and (= :use tag) (contains? defs href-id))]
|
|
|
|
(if use-tag?
|
|
(let [;; Merge the data of the use definition with the properties passed as attributes
|
|
use-data (-> (get defs href-id)
|
|
(update :attrs #(d/deep-merge % (dissoc attrs :xlink:href :href))))
|
|
displacement (gpt/point (d/parse-double (:x attrs "0")) (d/parse-double (:y attrs "0")))
|
|
disp-matrix (str (gmt/translate-matrix displacement))
|
|
element-data (-> element-data
|
|
(assoc :tag :g)
|
|
(update :attrs dissoc :x :y :width :height :href :xlink:href)
|
|
(update :attrs usvg/add-transform disp-matrix)
|
|
(assoc :content [use-data]))]
|
|
(parse-svg-element frame-id svg-data element-data unames))
|
|
|
|
;; SVG graphic elements
|
|
;; :circle :ellipse :image :line :path :polygon :polyline :rect :text :use
|
|
(let [shape (-> (case tag
|
|
(:g :a :svg) (create-group name frame-id svg-data element-data)
|
|
:rect (create-rect-shape name frame-id svg-data element-data)
|
|
(:circle
|
|
:ellipse) (create-circle-shape name frame-id svg-data element-data)
|
|
:path (create-path-shape name frame-id svg-data element-data)
|
|
:polyline (create-path-shape name frame-id svg-data (-> element-data usvg/polyline->path))
|
|
:polygon (create-path-shape name frame-id svg-data (-> element-data usvg/polygon->path))
|
|
:line (create-path-shape name frame-id svg-data (-> element-data usvg/line->path))
|
|
:image (create-image-shape name frame-id svg-data element-data)
|
|
#_other (create-raw-svg name frame-id svg-data element-data)))]
|
|
(when (some? shape)
|
|
(let [shape (-> shape
|
|
(assoc :fills [])
|
|
(assoc :strokes [])
|
|
(assoc :svg-defs (select-keys (:defs svg-data) references))
|
|
(setup-fill)
|
|
(setup-stroke))
|
|
|
|
shape (cond-> shape
|
|
hidden (assoc :hidden true))
|
|
|
|
children (cond->> (:content element-data)
|
|
(or (= tag :g) (= tag :svg))
|
|
(mapv #(usvg/inherit-attributes attrs %)))]
|
|
[shape children]))))))
|
|
|
|
(defn add-svg-child-changes [page-id objects selected frame-id parent-id svg-data [unames changes] [index data]]
|
|
(let [[shape children] (parse-svg-element frame-id svg-data data unames)]
|
|
(if (some? shape)
|
|
(let [shape-id (:id shape)
|
|
|
|
new-shape (dwsh/make-new-shape shape objects selected)
|
|
changes (-> changes
|
|
(pcb/add-object new-shape)
|
|
(pcb/change-parent parent-id [new-shape] index))
|
|
|
|
unames (conj unames (:name new-shape))
|
|
|
|
reducer-fn (partial add-svg-child-changes page-id objects selected frame-id shape-id svg-data)]
|
|
(reduce reducer-fn [unames changes] (d/enumerate children)))
|
|
|
|
[unames changes])))
|
|
|
|
(defn create-svg-shapes
|
|
[svg-data {:keys [x y] :as position}]
|
|
(ptk/reify ::create-svg-shapes
|
|
ptk/WatchEvent
|
|
(watch [it state _]
|
|
(try
|
|
(let [page-id (:current-page-id state)
|
|
objects (wsh/lookup-page-objects state page-id)
|
|
frame-id (ctst/top-nested-frame objects position)
|
|
selected (wsh/lookup-selected state)
|
|
|
|
[vb-x vb-y vb-width vb-height] (svg-dimensions svg-data)
|
|
x (- x vb-x (/ vb-width 2))
|
|
y (- y vb-y (/ vb-height 2))
|
|
|
|
unames (ctst/retrieve-used-names objects)
|
|
|
|
svg-name (->> (str/replace (:name svg-data) ".svg" "")
|
|
(ctst/generate-unique-name unames))
|
|
|
|
svg-data (-> svg-data
|
|
(assoc :x x
|
|
:y y
|
|
:offset-x vb-x
|
|
:offset-y vb-y
|
|
:width vb-width
|
|
:height vb-height
|
|
:name svg-name))
|
|
|
|
[def-nodes svg-data] (-> svg-data
|
|
(usvg/fix-default-values)
|
|
(usvg/fix-percents)
|
|
(usvg/extract-defs))
|
|
|
|
svg-data (assoc svg-data :defs def-nodes)
|
|
|
|
root-shape (create-svg-root frame-id svg-data)
|
|
root-id (:id root-shape)
|
|
|
|
;; In penpot groups have the size of their children. To respect the imported svg size and empty space let's create a transparent shape as background to respect the imported size
|
|
base-background-shape {:tag :rect
|
|
:attrs {:x "0"
|
|
:y "0"
|
|
:width (str (:width root-shape))
|
|
:height (str (:height root-shape))
|
|
:fill "none"
|
|
:id "base-background"}
|
|
:hidden true
|
|
:content []}
|
|
|
|
svg-data (-> svg-data
|
|
(assoc :defs def-nodes)
|
|
(assoc :content (into [base-background-shape] (:content svg-data))))
|
|
|
|
;; Creates the root shape
|
|
new-shape (dwsh/make-new-shape root-shape objects selected)
|
|
|
|
changes (-> (pcb/empty-changes it page-id)
|
|
(pcb/with-objects objects)
|
|
(pcb/add-object new-shape))
|
|
|
|
root-attrs (-> (:attrs svg-data)
|
|
(usvg/format-styles))
|
|
|
|
;; Reduce the children to create the changes to add the children shapes
|
|
[_ changes]
|
|
(reduce (partial add-svg-child-changes page-id objects selected frame-id root-id svg-data)
|
|
[unames changes]
|
|
(d/enumerate (->> (:content svg-data)
|
|
(mapv #(usvg/inherit-attributes root-attrs %)))))
|
|
changes (pcb/resize-parents changes
|
|
(->> changes
|
|
:redo-changes
|
|
(filter #(= :add-obj (:type %)))
|
|
(map :id)
|
|
reverse
|
|
vec))]
|
|
|
|
(rx/of (dch/commit-changes changes)
|
|
(dws/select-shapes (d/ordered-set root-id))))
|
|
|
|
(catch :default e
|
|
(.error js/console "Error SVG" e)
|
|
(rx/throw {:type :svg-parser
|
|
:data e}))))))
|