mirror of
https://github.com/penpot/penpot.git
synced 2026-04-25 11:18:36 +00:00
516 lines
20 KiB
Clojure
516 lines
20 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) UXBOX Labs SL
|
|
|
|
(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.math :as mth]
|
|
[app.common.pages :as cp]
|
|
[app.common.spec :refer [max-safe-int min-safe-int]]
|
|
[app.common.uuid :as uuid]
|
|
[app.main.data.workspace.changes :as dch]
|
|
[app.main.data.workspace.common :as dwc]
|
|
[app.main.data.workspace.state-helpers :as wsh]
|
|
[app.main.repo :as rp]
|
|
[app.util.color :as uc]
|
|
[app.util.path.parser :as upp]
|
|
[app.util.svg :as usvg]
|
|
[app.util.uri :as uu]
|
|
[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})
|
|
|
|
(defn- assert-valid-num [attr num]
|
|
(when (or (nil? num)
|
|
(mth/nan? num)
|
|
(not (mth/finite? 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? (get-in shape [:svg-attrs :fill]))
|
|
(-> (update :svg-attrs dissoc :fill)
|
|
(assoc :fill-color (-> (get-in shape [:svg-attrs :fill])
|
|
(uc/parse-color))))
|
|
|
|
;; Color present as style
|
|
(uc/color? (get-in shape [:svg-attrs :style :fill]))
|
|
(-> (update-in [:svg-attrs :style] dissoc :fill)
|
|
(assoc :fill-color (-> (get-in shape [:svg-attrs :style :fill])
|
|
(uc/parse-color))))
|
|
|
|
(get-in shape [:svg-attrs :fill-opacity])
|
|
(-> (update :svg-attrs dissoc :fill-opacity)
|
|
(assoc :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)
|
|
(assoc :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? (get-in shape [:svg-attrs :stroke]))
|
|
(-> (update :svg-attrs dissoc :stroke)
|
|
(assoc :stroke-color (get-in shape [:svg-attrs :stroke])))
|
|
|
|
(uc/color? (get-in shape [:svg-attrs :style :stroke]))
|
|
(-> (update-in [:svg-attrs :style] dissoc :stroke)
|
|
(assoc :stroke-color (get-in shape [:svg-attrs :style :stroke])))
|
|
|
|
(get-in shape [:svg-attrs :stroke-width])
|
|
(-> (update :svg-attrs dissoc :stroke-width)
|
|
(assoc :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 :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))))]
|
|
|
|
(if (d/any-key? shape :stroke-color :stroke-opacity :stroke-width :stroke-cap-start :stroke-cap-end)
|
|
(merge {:stroke-style :svg} shape)
|
|
shape)))
|
|
|
|
(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)))
|
|
(gsh/setup-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)}
|
|
(gsh/setup-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)))
|
|
(gsh/setup-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/make-centered-rect center (:width rect-data) (:height rect-data))
|
|
(update :width max 1)
|
|
(update :height max 1))
|
|
|
|
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)))
|
|
(contains? attrs :ry) (assoc :ry (d/parse-double (:ry attrs))))
|
|
|
|
(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 (: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)]
|
|
(-> {: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 :xlink:href)))))
|
|
|
|
(defn parse-svg-element [frame-id svg-data element-data unames]
|
|
(let [{:keys [tag attrs]} element-data
|
|
attrs (usvg/format-styles attrs)
|
|
element-data (cond-> element-data (map? element-data) (assoc :attrs attrs))
|
|
name (dwc/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 [use-data (get defs href-id)
|
|
|
|
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))
|
|
|
|
)
|
|
shape (when (some? shape)
|
|
(-> shape
|
|
(assoc :svg-defs (select-keys (:defs svg-data) references))
|
|
(setup-fill)
|
|
(setup-stroke)))
|
|
|
|
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 [rchs uchs]] [index data]]
|
|
(let [[shape children] (parse-svg-element frame-id svg-data data unames)]
|
|
(if (some? shape)
|
|
(let [shape-id (:id shape)
|
|
|
|
[rch1 uch1] (dwc/add-shape-changes page-id objects selected shape false)
|
|
|
|
;; Mov-objects won't have undo because we "delete" the object in the undo of the
|
|
;; previous operation
|
|
rch2 [{:type :mov-objects
|
|
:parent-id parent-id
|
|
:frame-id frame-id
|
|
:page-id page-id
|
|
:index index
|
|
:shapes [shape-id]}]
|
|
|
|
;; Careful! the undo changes are concatenated reversed (we undo in reverse order
|
|
changes [(d/concat rchs rch1 rch2) (d/concat uch1 uchs)]
|
|
unames (conj unames (:name 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)))
|
|
|
|
;; Cannot create the data from current tags
|
|
[unames [rchs uchs]])))
|
|
|
|
(declare create-svg-shapes)
|
|
|
|
(defn svg-uploaded
|
|
[svg-data file-id position]
|
|
(ptk/reify ::svg-uploaded
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
;; Once the SVG is uploaded, we need to extract all the bitmap
|
|
;; images and upload them separately, then proceed to create
|
|
;; all shapes.
|
|
(->> (rx/from (usvg/collect-images svg-data))
|
|
(rx/map (fn [uri]
|
|
(d/merge
|
|
{:file-id file-id
|
|
:is-local true
|
|
:url uri}
|
|
|
|
(if (str/starts-with? uri "data:")
|
|
{:name "image"
|
|
:content (uu/data-uri->blob uri)}
|
|
{:name (uu/uri-name uri)}))))
|
|
(rx/mapcat (fn [uri-data]
|
|
(->> (rp/mutation! (if (contains? uri-data :content)
|
|
:upload-file-media-object
|
|
:create-file-media-object-from-url) uri-data)
|
|
(rx/map #(vector (:url uri-data) %)))))
|
|
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
|
|
(rx/map #(create-svg-shapes (assoc svg-data :image-data %) position))))))
|
|
|
|
(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 (cp/frame-id-by-position 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 (dwc/retrieve-used-names objects)
|
|
|
|
svg-name (->> (str/replace (:name svg-data) ".svg" "")
|
|
(dwc/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)
|
|
|
|
;; Creates the root shape
|
|
changes (dwc/add-shape-changes page-id objects selected root-shape false)
|
|
|
|
root-attrs (-> (:attrs svg-data)
|
|
(usvg/format-styles))
|
|
|
|
;; Reduces the children to create the changes to add the children shapes
|
|
[_ [rchanges uchanges]]
|
|
(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 %)))))
|
|
|
|
reg-objects-action {:type :reg-objects
|
|
:page-id page-id
|
|
:shapes (->> rchanges (filter #(= :add-obj (:type %))) (map :id) reverse vec)}
|
|
|
|
rchanges (conj rchanges reg-objects-action)]
|
|
|
|
(rx/of (dch/commit-changes {:redo-changes rchanges
|
|
:undo-changes uchanges
|
|
:origin it})
|
|
(dwc/select-shapes (d/ordered-set root-id))))
|
|
|
|
(catch :default e
|
|
(.error js/console "Error SVG" e)
|
|
(rx/throw {:type :svg-parser
|
|
:data e}))))))
|