Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-05 19:41:27 -05:00
Code Issues Activity

Merge pull request from penpot/feat/export-import

Browse source 
Feature / export import
This commit is contained in:
Andrés Moya 2021-06-11 15:55:47 +02:00 • committed by GitHub
commit 0c49ed1fec
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
20 changed files with 1107 additions and 321 deletions

33
backend/src/app/rpc/mutations/files.clj
View file

@ -11,6 +11,7 @@
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc.permissions :as perms]
[app.rpc.queries.files :as files]
@ -18,6 +19,7 @@
[app.util.blob :as blob]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
;; --- Helpers & Specs
@ -43,6 +45,7 @@
(proj/check-edition-permissions! conn profile-id project-id)
(create-file conn params)))
(defn create-file-role
[conn {:keys [file-id profile-id role]}]
(let [params {:file-id file-id
@ -51,8 +54,9 @@
(db/insert! conn :file-profile-rel))))
(defn create-file
[conn {:keys [id name project-id is-shared data]
:or {is-shared false}
[conn {:keys [id name project-id is-shared data deleted-at]
:or {is-shared false
deleted-at nil}
:as params}]
(let [id (or id (:id data) (uuid/next))
data (or data (cp/make-file-data id))
@ -61,7 +65,8 @@
:project-id project-id
:name name
:is-shared is-shared
:data (blob/encode data)})]
:data (blob/encode data)
:deleted-at deleted-at})]
(->> (assoc params :file-id id :role :owner)
(create-file-role conn))
(assoc file :data data)))
@ -118,6 +123,7 @@
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(mark-file-deleted conn params)))
(defn mark-file-deleted
@ -381,3 +387,24 @@
[conn project-id]
(:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
;; TEMPORARY FILE CREATION
(s/def ::create-temp-file ::create-file)
(sv/defmethod ::create-temp-file
[{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
(db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id project-id)
(create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
(s/def ::persist-temp-file
(s/keys :req-un [::id ::profile-id]))
(sv/defmethod ::persist-temp-file
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(db/update! conn :file
{:deleted-at nil}
{:id id})))

48
common/src/app/common/data.cljc
View file

@ -503,3 +503,51 @@
(->> keys
(reduce diff-attr {}))))
(defn- extract-numeric-suffix
[basename]
(if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (parse-integer p2))]
[basename 1]))
(defn unique-name
"A unique name generator"
([basename used]
(unique-name basename used false))
([basename used prefix-first?]
(assert (string? basename))
(assert (set? used))
(let [[prefix initial] (extract-numeric-suffix basename)]
(if (and (not prefix-first?)
(not (contains? used basename)))
basename
(loop [counter initial]
(let [candidate (if (and (= 1 counter) prefix-first?)
(str prefix)
(str prefix "-" counter))]
(if (contains? used candidate)
(recur (inc counter))
candidate)))))))
(defn deep-mapm
"Applies a map function to an associative map and recurses over its children
when it's a vector or a map"
[mfn m]
(let [do-map
(fn [[k v]]
(cond
(or (vector? v) (map? v))
[k (deep-mapm mfn v)]
:else
(mfn [k v])))]
(cond
(map? m)
(into {} (map do-map) m)
(vector? m)
(into [] (map (partial deep-mapm mfn)) m)
:else
m)))

104
common/src/app/common/file_builder.cljc
View file

@ -7,13 +7,14 @@
(ns app.common.file-builder
"A version parsing helper."
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes :as ch]
[app.common.pages.init :as init]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.spec :as us]
[app.common.uuid :as uuid]))
[app.common.uuid :as uuid]
[cuerdas.core :as str]))
(def root-frame uuid/zero)
@ -24,7 +25,7 @@
(when verify-on-commit?
(us/assert ::spec/change change))
(-> file
(update :changes conj change)
(update :changes (fnil conj []) change)
(update :data ch/process-changes [change] verify-on-commit?)))
(defn- lookup-objects
@ -51,6 +52,27 @@
:parent-id parent-id
:obj obj}))))
(defn generate-name
[type data]
(if (= type :svg-raw)
(let [tag (get-in data [:content :tag])]
(str "svg-" (cond (string? tag) tag
(keyword? tag) (d/name tag)
(nil? tag) "node"
:else (str tag))))
(str/capital (d/name type))))
(defn check-name
"Given a tag returns its layer name"
[data file type]
(cond-> data
(nil? (:name data))
(assoc :name (generate-name type data))
:always
(update :name d/unique-name (:unames file))))
;; PUBLIC API
(defn create-file
@ -82,14 +104,31 @@
(assoc :current-frame-id root-frame)
;; Current parent stack we'll be nesting
(assoc :parent-stack [root-frame]))))
(assoc :parent-stack [root-frame])
;; Last object id added
(assoc :last-id nil)
;; Current used names
(assoc :unames #{}))))
(defn close-page [file]
(-> file
(dissoc :current-page-id)
(dissoc :parent-stack)
(dissoc :last-id)
(dissoc :unames)))
(defn add-artboard [file data]
(let [obj (-> (init/make-minimal-shape :frame)
(merge data))]
(merge data)
(check-name file :frame)
(d/without-nils))]
(-> file
(commit-shape obj)
(assoc :current-frame-id (:id obj))
(assoc :last-id (:id obj))
(update :unames conj (:name obj))
(update :parent-stack conj (:id obj)))))
(defn close-artboard [file]
@ -102,9 +141,13 @@
selrect init/empty-selrect
name (:name data)
obj (-> (init/make-minimal-group frame-id selrect name)
(merge data))]
(merge data)
(check-name file :group)
(d/without-nils))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
(update :unames conj (:name obj))
(update :parent-stack conj (:id obj)))))
(defn close-group [file]
@ -115,13 +158,14 @@
points (gsh/rect->points selrect)]
(-> file
(commit-change
{:type :mod-obj
:page-id (:current-page-id file)
:id group-id
:operations
[{:type :set :attr :selrect :val selrect}
{:type :set :attr :points :val points}]})
(cond-> (not (empty? shapes))
(commit-change
{:type :mod-obj
:page-id (:current-page-id file)
:id group-id
:operations
[{:type :set :attr :selrect :val selrect}
{:type :set :attr :points :val points}]}))
(update :parent-stack pop))))
(defn create-shape [file type data]
@ -130,9 +174,14 @@
(lookup-shape file frame-id))
obj (-> (init/make-minimal-shape type)
(merge data)
(cond-> frame
(gsh/translate-from-frame frame)))]
(commit-shape file obj)))
(check-name file :type)
(d/without-nils))
obj (cond-> obj
frame (gsh/translate-from-frame frame))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
(update :unames conj (:name obj)))))
(defn create-rect [file data]
(create-shape file :rect data))
@ -149,10 +198,27 @@
(defn create-image [file data]
(create-shape file :image data))
(defn close-page [file]
(declare close-svg-raw)
(defn create-svg-raw [file data]
(let [file (as-> file $
(create-shape $ :svg-raw data)
(update $ :parent-stack conj (:last-id $)))
create-child
(fn [file child]
(-> file
(create-svg-raw (assoc data :content child))
(close-svg-raw)))]
;; First :content is the the shape attribute, the other content is the
;; XML children
(reduce create-child file (get-in data [:content :content]))))
(defn close-svg-raw [file]
(-> file
(dissoc :current-page-id)
(dissoc :parent-stack)))
(update :parent-stack pop)))
(defn generate-changes
[file]

3
common/src/app/common/geom/shapes/path.cljc
View file

@ -156,7 +156,8 @@
(mapv #(update % :params transform-params) content)))
(defn transform-content [content transform]
(defn transform-content
[content transform]
(let [set-tr (fn [params px py]
(let [tr-point (-> (gpt/point (get params px) (get params py))
(gpt/transform transform))]

2
frontend/deps.edn
View file

@ -6,7 +6,7 @@
binaryage/devtools {:mvn/version "RELEASE"}
metosin/reitit-core {:mvn/version "0.5.13"}
funcool/beicon {:mvn/version "2021.06.02-0"}
funcool/beicon {:mvn/version "2021.06.03-0"}
funcool/okulary {:mvn/version "2020.04.14-0"}
funcool/potok {:mvn/version "2021.06.07-0"}
funcool/rumext {:mvn/version "2021.05.12-1"}

12
frontend/src/app/main/exports.cljs
View file

@ -85,9 +85,15 @@
(mf/fnc svg-raw-wrapper
[{:keys [shape frame] :as props}]
(let [childs (mapv #(get objects %) (:shapes shape))]
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}]))))
(if (and (contains? shape :svg-attrs) (map? (:content shape)))
[:> shape-container {:shape shape}
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}]]
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}])))))
(defn shape-wrapper-factory
[objects]

43
frontend/src/app/main/ui/shapes/attrs.cljs
View file

@ -141,23 +141,28 @@
styles (-> svg-attrs (:style {}) (clj->js))]
[attrs styles]))
(defn add-style-attrs
[props shape]
(let [render-id (mf/use-ctx muc/render-ctx)
svg-defs (:svg-defs shape {})
svg-attrs (:svg-attrs shape {})
[svg-attrs svg-styles] (mf/use-memo
(mf/deps render-id svg-defs svg-attrs)
#(extract-svg-attrs render-id svg-defs svg-attrs))
styles (-> (obj/get props "style" (obj/new))
(obj/merge! svg-styles)
(add-fill shape render-id)
(add-stroke shape render-id)
(add-layer-props shape))]
(-> props
(obj/merge! svg-attrs)
(add-border-radius shape)
(obj/set! "style" styles))))
(defn extract-style-attrs
([shape]
(let [render-id (mf/use-ctx muc/render-ctx)
svg-defs (:svg-defs shape {})
svg-attrs (:svg-attrs shape {})
[svg-attrs svg-styles] (mf/use-memo
(mf/deps render-id svg-defs svg-attrs)
#(extract-svg-attrs render-id svg-defs svg-attrs))
styles (-> (obj/new)
(obj/merge! svg-styles)
(add-fill shape render-id)
(add-stroke shape render-id)
(add-layer-props shape))]
(-> (obj/new)
(obj/merge! svg-attrs)
(add-border-radius shape)
(obj/set! "style" styles)))))
[shape]
(-> (obj/new)
(add-style-attrs shape)))

22
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View file

@ -30,7 +30,7 @@
(let [clip-id (str "inner-stroke-" render-id)
shape-id (str "stroke-shape-" render-id)]
[:> "clipPath" #js {:id clip-id}
[:use {:href (str "#" shape-id)}]]))
[:use {:xlinkHref (str "#" shape-id)}]]))
(mf/defc outer-stroke-mask
[{:keys [shape render-id]}]
@ -38,10 +38,10 @@
shape-id (str "stroke-shape-" render-id)
stroke-width (:stroke-width shape 0)]
[:mask {:id stroke-mask-id}
[:use {:href (str "#" shape-id)
[:use {:xlinkHref (str "#" shape-id)
:style #js {:fill "none" :stroke "white" :strokeWidth (* stroke-width 2)}}]
[:use {:href (str "#" shape-id)
[:use {:xlinkHref (str "#" shape-id)
:style #js {:fill "black"}}]]))
(mf/defc stroke-defs
@ -84,13 +84,13 @@
(str/join ";"))]
[:g.outer-stroke-shape
[:symbol
[:defs
[:> elem-name (-> (obj/clone base-props)
(obj/set! "id" shape-id)
(obj/set! "data-style" style-str)
(obj/without ["style"]))]]
[:use {:href (str "#" shape-id)
[:use {:xlinkHref (str "#" shape-id)
:mask (str "url(#" stroke-mask-id ")")
:style (-> (obj/get base-props "style")
(obj/clone)
@ -98,7 +98,7 @@
(obj/without ["fill" "fillOpacity"])
(obj/set! "fill" "none"))}]
[:use {:href (str "#" shape-id)
[:use {:xlinkHref (str "#" shape-id)
:style (-> (obj/get base-props "style")
(obj/clone)
(obj/without ["stroke" "strokeWidth" "strokeOpacity" "strokeStyle" "strokeDasharray"]))}]]))
@ -121,14 +121,18 @@
clip-id (str "inner-stroke-" render-id)
shape-id (str "stroke-shape-" render-id)
clip-path (str "url('#" clip-id "')")
shape-props (-> base-props
(add-props {:id shape-id
:transform nil
:clipPath (str "url('#" clip-id "')")})
:transform nil})
(add-style {:strokeWidth (* stroke-width 2)}))]
[:g.inner-stroke-shape {:transform transform}
[:> elem-name shape-props]]))
[:defs
[:> elem-name shape-props]]
[:use {:xlinkHref (str "#" shape-id)
:clipPath clip-path}]]))
; The SVG standard does not implement yet the 'stroke-alignment'

139
frontend/src/app/main/ui/shapes/export.cljs Normal file
View file

@ -0,0 +1,139 @@
;; 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.ui.shapes.export
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.shapes :as gsh]
[app.util.json :as json]
[app.util.object :as obj]
[app.util.svg :as usvg]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(mf/defc render-xml
[{{:keys [tag attrs content] :as node} :xml}]
(cond
(map? node)
[:> (d/name tag) (clj->js (usvg/clean-attrs attrs))
(for [child content]
[:& render-xml {:xml child}])]
(string? node)
node
:else
nil))
(defn bool->str [val]
(when (some? val) (str val)))
(defn add-data
"Adds as metadata properties that we cannot deduce from the exported SVG"
[props shape]
(letfn [(add!
([props attr]
(add! props attr str))
([props attr trfn]
(let [val (get shape attr)
val (if (keyword? val) (d/name val) val)
ns-attr (str "penpot:" (-> attr d/name))]
(cond-> props
(some? val)
(obj/set! ns-attr (trfn val))))))]
(let [frame? (= :frame (:type shape))
group? (= :group (:type shape))
rect? (= :rect (:type shape))
text? (= :text (:type shape))
mask? (and group? (:masked-group? shape))
center (gsh/center-shape shape)]
(-> props
(add! :name)
(add! :blocked)
(add! :hidden)
(add! :type)
(add! :stroke-style)
(add! :stroke-alignment)
(add! :transform)
(add! :transform-inverse)
(add! :flip-x)
(add! :flip-y)
(add! :proportion)
(add! :proportion-lock)
(add! :rotation)
(obj/set! "penpot:center-x" (-> center :x str))
(obj/set! "penpot:center-y" (-> center :y str))
(cond-> (and rect? (some? (:r1 shape)))
(-> (add! :r1)
(add! :r2)
(add! :r3)
(add! :r4)))
(cond-> text?
(-> (add! :grow-type)
(add! :content json/encode)))
(cond-> mask?
(obj/set! "penpot:masked-group" "true"))))))
(mf/defc export-data
[{:keys [shape]}]
(let [props (-> (obj/new)
(add-data shape))]
[:> "penpot:shape" props
(for [{:keys [style hidden color offset-x offset-y blur spread]} (:shadow shape)]
[:> "penpot:shadow" #js {:penpot:shadow-type (d/name style)
:penpot:hidden (str hidden)
:penpot:color (str (:color color))
:penpot:opacity (str (:opacity color))
:penpot:offset-x (str offset-x)
:penpot:offset-y (str offset-y)
:penpot:blur (str blur)
:penpot:spread (str spread)}])
(when (some? (:blur shape))
(let [{:keys [type hidden value]} (:blur shape)]
[:> "penpot:blur" #js {:penpot:blur-type (d/name type)
:penpot:hidden (str hidden)
:penpot:value (str value)}]))
(for [{:keys [scale suffix type]} (:exports shape)]
[:> "penpot:export" #js {:penpot:type (d/name type)
:penpot:suffix suffix
:penpot:scale (str scale)}])
(when (contains? shape :svg-attrs)
(let [svg-transform (get shape :svg-transform)
svg-attrs (->> shape :svg-attrs keys (mapv d/name) (str/join ",") )
svg-defs (->> shape :svg-defs keys (mapv d/name) (str/join ","))]
[:> "penpot:svg-import" #js {:penpot:svg-attrs (when-not (empty? svg-attrs) svg-attrs)
:penpot:svg-defs (when-not (empty? svg-defs) svg-defs)
:penpot:svg-transform (when svg-transform (str svg-transform))
:penpot:svg-viewbox-x (get-in shape [:svg-viewbox :x])
:penpot:svg-viewbox-y (get-in shape [:svg-viewbox :y])
:penpot:svg-viewbox-width (get-in shape [:svg-viewbox :width])
:penpot:svg-viewbox-height (get-in shape [:svg-viewbox :height])}
(for [[def-id def-xml] (:svg-defs shape)]
[:> "penpot:svg-def" #js {:def-id def-id}
[:& render-xml {:xml def-xml}]])]))
(when (= (:type shape) :svg-raw)
(let [props (-> (obj/new)
(obj/set! "penpot:x" (:x shape))
(obj/set! "penpot:y" (:y shape))
(obj/set! "penpot:width" (:width shape))
(obj/set! "penpot:height" (:height shape))
(obj/set! "penpot:tag" (-> (get-in shape [:content :tag]) d/name))
(obj/merge! (-> (get-in shape [:content :attrs])
(clj->js))))]
[:> "penpot:svg-content" props
(for [leaf (->> shape :content :content (filter string?))]
[:> "penpot:svg-child" {} leaf])]))]))

41
frontend/src/app/main/ui/shapes/gradients.cljs
View file

@ -18,18 +18,29 @@
(mf/defc linear-gradient [{:keys [id gradient shape]}]
(let [{:keys [x y width height]} (:selrect shape)
transform (when (= :path (:type shape)) (gsh/transform-matrix shape nil (gpt/point 0.5 0.5)))]
[:linearGradient {:id id
:x1 (:start-x gradient)
:y1 (:start-y gradient)
:x2 (:end-x gradient)
:y2 (:end-y gradient)
:gradientTransform transform}
[:> :linearGradient #js {:id id
:x1 (:start-x gradient)
:y1 (:start-y gradient)
:x2 (:end-x gradient)
:y2 (:end-y gradient)
:gradientTransform transform
:penpot:gradient "true"}
(for [{:keys [offset color opacity]} (:stops gradient)]
[:stop {:key (str id "-stop-" offset)
:offset (or offset 0)
:stop-color color
:stop-opacity opacity}])]))
(defn add-metadata [props gradient]
(-> props
(obj/set! "penpot:gradient" "true")
(obj/set! "penpot:start-x" (:start-x gradient))
(obj/set! "penpot:start-x" (:start-x gradient))
(obj/set! "penpot:start-y" (:start-y gradient))
(obj/set! "penpot:end-x" (:end-x gradient))
(obj/set! "penpot:end-y" (:end-y gradient))
(obj/set! "penpot:width" (:width gradient))))
(mf/defc radial-gradient [{:keys [id gradient shape]}]
(let [{:keys [x y width height]} (:selrect shape)
center (gsh/center-shape shape)
@ -59,13 +70,17 @@
transform (gmt/multiply transform
(gmt/translate-matrix translate-vec)
(gmt/rotate-matrix angle)
(gmt/scale-matrix scale-vec))]
[:radialGradient {:id id
:cx 0
:cy 0
:r 1
:gradientUnits "userSpaceOnUse"
:gradientTransform transform}
(gmt/scale-matrix scale-vec))
base-props #js {:id id
:cx 0
:cy 0
:r 1
:gradientUnits "userSpaceOnUse"
:gradientTransform transform}
props (-> base-props (add-metadata gradient))]
[:> :radialGradient props
(for [{:keys [offset color opacity]} (:stops gradient)]
[:stop {:key (str id "-stop-" offset)
:offset (or offset 0)

38
frontend/src/app/main/ui/shapes/group.cljs
View file

@ -20,33 +20,29 @@
(let [frame (unchecked-get props "frame")
shape (unchecked-get props "shape")
childs (unchecked-get props "childs")
expand-mask (unchecked-get props "expand-mask")
pointer-events (unchecked-get props "pointer-events")
{:keys [id x y width height]} shape
{:keys [id x y width height masked-group?]} shape
show-mask? (and (:masked-group? shape) (not expand-mask))
mask (when show-mask? (first childs))
childs (if show-mask? (rest childs) childs)
[mask childs] (if masked-group?
[(first childs) (rest childs)]
[nil childs])
mask-props (when (and mask (not expand-mask))
#js {:clipPath (clip-str mask)
:mask (mask-str mask)})
mask-wrapper (if (and mask (not expand-mask))
"g"
mf/Fragment)
[mask-wrapper mask-props]
(if masked-group?
["g" (-> (obj/new)
(obj/set! "clipPath" (clip-str mask))
(obj/set! "mask" (mask-str mask)))]
[mf/Fragment nil])]
props (-> (attrs/extract-style-attrs shape))]
[:> mask-wrapper mask-props
(when masked-group?
[:> render-mask #js {:frame frame :mask mask}])
[:> :g (attrs/extract-style-attrs shape)
[:> mask-wrapper mask-props
(when mask
[:> render-mask #js {:frame frame :mask mask}])
(for [item childs]
[:& shape-wrapper {:frame frame
:shape item
:key (:id item)}])]]))))
(for [item childs]
[:& shape-wrapper {:frame frame
:shape item
:key (:id item)}])]))))

59
frontend/src/app/main/ui/shapes/shape.cljs
View file

@ -8,9 +8,10 @@
(:require
[app.common.data :as d]
[app.common.uuid :as uuid]
[app.common.geom.matrix :as gmt]
[app.main.ui.context :as muc]
[app.main.ui.shapes.attrs :as attrs]
[app.main.ui.shapes.custom-stroke :as cs]
[app.main.ui.shapes.export :as ed]
[app.main.ui.shapes.fill-image :as fim]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.gradients :as grad]
@ -18,36 +19,6 @@
[app.util.object :as obj]
[rumext.alpha :as mf]))
(defn add-metadata
"Adds as metadata properties that we cannot deduce from the exported SVG"
[props shape]
(let [add!
(fn [props attr val]
(let [ns-attr (str "penpot:" (-> attr d/name))]
(-> props
(obj/set! ns-attr val))))
frame? (= :frame (:type shape))]
(-> props
(add! :name (-> shape :name))
(add! :blocked (-> shape (:blocked false) str))
(add! :hidden (-> shape (:hidden false) str))
(add! :type (-> shape :type d/name))
(add! :stroke-style (-> shape (:stroke-style :none) d/name))
(add! :stroke-alignment (-> shape (:stroke-alignment :center) d/name))
(add! :transform (-> shape (:transform (gmt/matrix)) str))
(add! :transform-inverse (-> shape (:transform-inverse (gmt/matrix)) str))
(cond-> (some? (:r1 shape))
(-> (add! :r1 (-> shape (:r1 0) str))
(add! :r2 (-> shape (:r2 0) str))
(add! :r3 (-> shape (:r3 0) str))
(add! :r4 (-> shape (:r4 0) str))))
(cond-> frame?
(obj/set! "xmlns:penpot" "https://penpot.app/xmlns")))))
(mf/defc shape-container
{::mf/forward-ref true
::mf/wrap-props false}
@ -65,6 +36,7 @@
{:keys [x y width height type]} shape
frame? (= :frame type)
group? (= :group type)
wrapper-props
(-> (obj/clone props)
@ -72,22 +44,29 @@
(obj/set! "ref" ref)
(obj/set! "id" (str "shape-" (:id shape)))
(obj/set! "filter" (filters/filter-str filter-id shape))
(obj/set! "style" styles)
(obj/set! "style" styles))
(cond-> frame?
(-> (obj/set! "x" x)
(obj/set! "y" y)
(obj/set! "width" width)
(obj/set! "height" height)
(obj/set! "xmlnsXlink" "http://www.w3.org/1999/xlink")
(obj/set! "xmlns" "http://www.w3.org/2000/svg")))
wrapper-props
(cond-> wrapper-props
frame?
(-> (obj/set! "x" x)
(obj/set! "y" y)
(obj/set! "width" width)
(obj/set! "height" height)
(obj/set! "xmlnsXlink" "http://www.w3.org/1999/xlink")
(obj/set! "xmlns" "http://www.w3.org/2000/svg")
(obj/set! "xmlns:penpot" "https://penpot.app/xmlns")))
(add-metadata shape))
wrapper-props
(cond-> wrapper-props
group?
(attrs/add-style-attrs shape))
wrapper-tag (if frame? "svg" "g")]
[:& (mf/provider muc/render-ctx) {:value render-id}
[:> wrapper-tag wrapper-props
[:& ed/export-data {:shape shape}]
[:defs
[:& defs/svg-defs {:shape shape :render-id render-id}]
[:& filters/filters {:shape shape :filter-id filter-id}]

23
frontend/src/app/main/ui/workspace/shapes.cljs
View file

@ -83,20 +83,19 @@
(when (and shape (not (:hidden shape)))
[:*
(if-not svg-element?
[:g.shape-wrapper
(case (:type shape)
:path [:> path/path-wrapper opts]
:text [:> text/text-wrapper opts]
:group [:> group-wrapper opts]
:rect [:> rect-wrapper opts]
:image [:> image-wrapper opts]
:circle [:> circle-wrapper opts]
:svg-raw [:> svg-raw-wrapper opts]
(case (:type shape)
:path [:> path/path-wrapper opts]
:text [:> text/text-wrapper opts]
:group [:> group-wrapper opts]
:rect [:> rect-wrapper opts]
:image [:> image-wrapper opts]
:circle [:> circle-wrapper opts]
:svg-raw [:> svg-raw-wrapper opts]
;; Only used when drawing a new frame.
:frame [:> frame-wrapper {:shape shape}]
;; Only used when drawing a new frame.
:frame [:> frame-wrapper {:shape shape}]
nil)]
nil)
;; Don't wrap svg elements inside a <g> otherwise some can break
[:> svg-raw-wrapper opts])

9
frontend/src/app/main/ui/workspace/shapes/group.cljs
View file

@ -42,9 +42,8 @@
childs (mf/deref childs-ref)]
[:> shape-container {:shape shape}
[:g.group-shape
[:& group-shape
{:frame frame
:shape shape
:childs childs}]]]))))
[:& group-shape
{:frame frame
:shape shape
:childs childs}]]))))

16
frontend/src/app/main/ui/workspace/shapes/svg_raw.cljs
View file

@ -35,23 +35,13 @@
def-ctx? (mf/use-ctx muc/def-ctx)]
(cond
(and (svg-raw/graphic-element? tag) (not def-ctx?))
[:> shape-container { :shape shape }
[:& svg-raw-shape
{:frame frame
:shape shape
:childs childs}]]
;; We cannot wrap inside groups the shapes that go inside the defs tag
;; we use the context so we know when we should not render the container
(= tag :defs)
[:& (mf/provider muc/def-ctx) {:value true}
(if (or (= (get-in shape [:content :tag]) :svg)
(and (contains? shape :svg-attrs) (map? (:content shape))))
[:> shape-container {:shape shape}
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}]]
:else
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}])))))

515
frontend/src/app/util/import/parser.cljc
View file

@ -9,8 +9,12 @@
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.shapes :as gsh]
[cuerdas.core :as str]
[app.util.path.parser :as upp]))
[app.common.geom.point :as gpt]
[app.common.uuid :as uuid]
[app.util.color :as uc]
[app.util.json :as json]
[app.util.path.parser :as upp]
[cuerdas.core :as str]))
(defn valid?
[root]
@ -26,24 +30,38 @@
(and (vector? node)
(= ::close (first node))))
(defn get-data
([node]
(->> node :content (d/seek #(= :penpot:shape (:tag %)))))
([node tag]
(->> (get-data node)
:content
(d/seek #(= tag (:tag %))))))
(defn get-type
[node]
(if (close? node)
(second node)
(-> (get-in node [:attrs :penpot:type])
(keyword))))
(let [data (get-data node)]
(-> (get-in data [:attrs :penpot:type])
(keyword)))))
(defn shape?
[node]
(or (close? node)
(contains? (:attrs node) :penpot:type)))
(some? (get-data node))))
(defn get-attr
(defn str->bool
[val]
(when (some? val) (= val "true")))
(defn get-meta
([m att]
(get-attr m att identity))
(get-meta m att identity))
([m att val-fn]
(let [ns-att (->> att d/name (str "penpot:") keyword)
val (get-in m [:attrs ns-att])]
val (or (get-in m [:attrs ns-att])
(get-in (get-data m) [:attrs ns-att]))]
(when val (val-fn val)))))
(defn get-children
@ -57,9 +75,6 @@
[content]
(->> content (tree-seq branch? get-children)))
(defn get-transform
[type node])
(defn parse-style
"Transform style list into a map"
[style-str]
@ -78,33 +93,43 @@
(reduce-kv
(fn [m k v]
(if (#{:style :data-style} k)
(assoc m :style (parse-style v))
(merge m (parse-style v))
(assoc m k v)))
m
attrs))
(defn get-data-node
[node]
(let [data-tags #{:ellipse :rect :path}]
(->> node
(node-seq)
(filter #(contains? data-tags (:tag %)))
(map #(:attrs %))
(reduce add-attrs {}))))
(def search-data-node? #{:rect :image :path :text :circle})
(defn get-svg-data
[type node]
(let [node-attrs (add-attrs {} (:attrs node))]
(cond
(search-data-node? type)
(let [data-tags #{:ellipse :rect :path :text :foreignObject :image}]
(->> node
(node-seq)
(filter #(contains? data-tags (:tag %)))
(map #(:attrs %))
(reduce add-attrs node-attrs)))
(= type :svg-raw)
(->> node :content last)
:else
node-attrs)))
(def has-position? #{:frame :rect :image :text})
(defn parse-position
[props data]
(let [values (->> (select-keys data [:x :y :width :height])
[props svg-data]
(let [values (->> (select-keys svg-data [:x :y :width :height])
(d/mapm (fn [_ val] (d/parse-double val))))]
(d/merge props values)))
(defn parse-circle
[props data]
(let [values (->> (select-keys data [:cx :cy :rx :ry])
[props svg-data]
(let [values (->> (select-keys svg-data [:cx :cy :rx :ry])
(d/mapm (fn [_ val] (d/parse-double val))))]
{:x (- (:cx values) (:rx values))
@ -113,52 +138,426 @@
:height (* (:ry values) 2)}))
(defn parse-path
[props data]
(let [content (upp/parse-path (:d data))
selrect (gsh/content->selrect content)
points (gsh/rect->points selrect)]
[props center svg-data]
(let [transform-inverse (:transform-inverse props (gmt/matrix))
transform (:transform props (gmt/matrix))
content (upp/parse-path (:d svg-data))
content-tr (gsh/transform-content
content
(gmt/transform-in center transform-inverse))
selrect (gsh/content->selrect content-tr)
points (-> (gsh/rect->points selrect)
(gsh/transform-points center transform))]
(-> props
(assoc :content content)
(assoc :selrect selrect)
(assoc :points points))))
(defn extract-data
[type node]
(let [data (if (search-data-node? type)
(get-data-node node)
(:attrs node))]
(cond-> {}
(defn setup-selrect [props]
(let [data (select-keys props [:x :y :width :height])
transform (:transform props (gmt/matrix))
selrect (gsh/rect->selrect data)
points (gsh/rect->points data)
center (gsh/center-rect data)]
(assoc props
:selrect selrect
:points (gsh/transform-points points center transform))))
(def url-regex #"url\(#([^\)]*)\)")
(defn seek-node
[id coll]
(->> coll (d/seek #(= id (-> % :attrs :id)))))
(defn parse-stops
[gradient-node]
(->> gradient-node
(node-seq)
(filter #(= :stop (:tag %)))
(mapv (fn [{{:keys [offset stop-color stop-opacity]} :attrs}]
{:color stop-color
:opacity (d/parse-double stop-opacity)
:offset (d/parse-double offset)}))))
(defn parse-gradient
[node ref-url]
(let [[_ url] (re-find url-regex ref-url)
gradient-node (->> node (node-seq) (seek-node url))
stops (parse-stops gradient-node)]
(when (contains? (:attrs gradient-node) :penpot:gradient)
(cond-> {:stops stops}
(= :linearGradient (:tag gradient-node))
(assoc :type :linear
:start-x (-> gradient-node :attrs :x1 d/parse-double)
:start-y (-> gradient-node :attrs :y1 d/parse-double)
:end-x (-> gradient-node :attrs :x2 d/parse-double)
:end-y (-> gradient-node :attrs :y2 d/parse-double)
:width 1)
(= :radialGradient (:tag gradient-node))
(assoc :type :radial
:start-x (get-meta gradient-node :start-x d/parse-double)
:start-y (get-meta gradient-node :start-y d/parse-double)
:end-x (get-meta gradient-node :end-x d/parse-double)
:end-y (get-meta gradient-node :end-y d/parse-double)
:width (get-meta gradient-node :width d/parse-double))))))
(defn add-svg-position [props node]
(let [svg-content (get-data node :penpot:svg-content)]
(cond-> props
(contains? (:attrs svg-content) :penpot:x)
(assoc :x (-> svg-content :attrs :penpot:x d/parse-double))
(contains? (:attrs svg-content) :penpot:y)
(assoc :y (-> svg-content :attrs :penpot:y d/parse-double))
(contains? (:attrs svg-content) :penpot:width)
(assoc :width (-> svg-content :attrs :penpot:width d/parse-double))
(contains? (:attrs svg-content) :penpot:height)
(assoc :height (-> svg-content :attrs :penpot:height d/parse-double)))))
(defn add-common-data
[props node]
(let [name (get-meta node :name)
blocked (get-meta node :blocked str->bool)
hidden (get-meta node :hidden str->bool)
transform (get-meta node :transform gmt/str->matrix)
transform-inverse (get-meta node :transform-inverse gmt/str->matrix)
flip-x (get-meta node :flip-x str->bool)
flip-y (get-meta node :flip-y str->bool)
proportion (get-meta node :proportion d/parse-double)
proportion-lock (get-meta node :proportion-lock str->bool)
rotation (get-meta node :rotation d/parse-double)]
(-> props
(assoc :name name)
(assoc :blocked blocked)
(assoc :hidden hidden)
(assoc :transform transform)
(assoc :transform-inverse transform-inverse)
(assoc :flip-x flip-x)
(assoc :flip-y flip-y)
(assoc :proportion proportion)
(assoc :proportion-lock proportion-lock)
(assoc :rotation rotation))))
(defn add-position
[props type node svg-data]
(let [center-x (get-meta node :center-x d/parse-double)
center-y (get-meta node :center-y d/parse-double)
center (gpt/point center-x center-y)]
(cond-> props
(has-position? type)
(-> (parse-position data)
(gsh/setup-selrect))
(parse-position svg-data)
(= type :svg-raw)
(add-svg-position node)
(= type :circle)
(-> (parse-circle data)
(gsh/setup-selrect))
(parse-circle svg-data)
(= type :path)
(parse-path data))))
(parse-path center svg-data)
(defn str->bool
[val]
(= val "true"))
(or (has-position? type) (= type :svg-raw) (= type :circle))
(setup-selrect))))
(defn add-fill
[props node svg-data]
(let [fill (:fill svg-data)
gradient (when (str/starts-with? fill "url")
(parse-gradient node fill))]
(cond-> props
:always
(assoc :fill-color nil
:fill-opacity nil)
(some? gradient)
(assoc :fill-color-gradient gradient
:fill-color nil
:fill-opacity nil)
(uc/hex? fill)
(assoc :fill-color fill
:fill-opacity (-> svg-data (:fill-opacity "1") d/parse-double)))))
(defn add-stroke
[props node svg-data]
(let [stroke-style (get-meta node :stroke-style keyword)
stroke-alignment (get-meta node :stroke-alignment keyword)
stroke (:stroke svg-data)
gradient (when (str/starts-with? stroke "url")
(parse-gradient node stroke))]
(cond-> props
:always
(assoc :stroke-alignment stroke-alignment
:stroke-style stroke-style
:stroke-color (-> svg-data :stroke)
:stroke-opacity (-> svg-data :stroke-opacity d/parse-double)
:stroke-width (-> svg-data :stroke-width d/parse-double))
(some? gradient)
(assoc :stroke-color-gradient gradient
:stroke-color nil
:stroke-opacity nil)
(= stroke-alignment :inner)
(update :stroke-width / 2))))
(defn add-rect-data
[props node svg-data]
(let [r1 (get-meta node :r1 d/parse-double)
r2 (get-meta node :r2 d/parse-double)
r3 (get-meta node :r3 d/parse-double)
r4 (get-meta node :r4 d/parse-double)
rx (-> (get svg-data :rx) d/parse-double)
ry (-> (get svg-data :ry) d/parse-double)]
(cond-> props
(some? r1)
(assoc :r1 r1 :r2 r2 :r3 r3 :r4 r4
:rx nil :ry nil)
(and (nil? r1) (some? rx))
(assoc :rx rx :ry ry))))
(defn add-image-data
[props node]
(-> props
(assoc-in [:metadata :id] (get-meta node :media-id))
(assoc-in [:metadata :width] (get-meta node :media-width))
(assoc-in [:metadata :height] (get-meta node :media-height))
(assoc-in [:metadata :mtype] (get-meta node :media-mtype))))
(defn add-text-data
[props node]
(-> props
(assoc :grow-type (get-meta node :grow-type keyword))
(assoc :content (get-meta node :content json/decode))))
(defn add-group-data
[props node]
(let [mask? (get-meta node :masked-group str->bool)]
(cond-> props
mask?
(assoc :masked-group? true))))
(defn parse-shadow [node]
{:id (uuid/next)
:style (get-meta node :shadow-type keyword)
:hidden (get-meta node :hidden str->bool)
:color {:color (get-meta node :color)
:opacity (get-meta node :opacity d/parse-double)}
:offset-x (get-meta node :offset-x d/parse-double)
:offset-y (get-meta node :offset-y d/parse-double)
:blur (get-meta node :blur d/parse-double)
:spread (get-meta node :spread d/parse-double)})
(defn parse-blur [node]
{:id (uuid/next)
:type (get-meta node :blur-type keyword)
:hidden (get-meta node :hidden str->bool)
:value (get-meta node :value d/parse-double)})
(defn parse-export [node]
{:type (get-meta node :type keyword)
:suffix (get-meta node :suffix)
:scale (get-meta node :scale d/parse-double)})
(defn extract-from-data
([node tag]
(extract-from-data node tag identity))
([node tag parse-fn]
(let [shape-data (get-data node)]
(->> shape-data
(node-seq)
(filter #(= (:tag %) tag))
(mapv parse-fn)))))
(defn add-shadows
[props node]
(let [shadows (extract-from-data node :penpot:shadow parse-shadow)]
(cond-> props
(not (empty? shadows))
(assoc :shadow shadows))))
(defn add-blur
[props node]
(let [blur (->> (extract-from-data node :penpot:blur parse-blur) (first))]
(cond-> props
(some? blur)
(assoc :blur blur))))
(defn add-exports
[props node]
(let [exports (extract-from-data node :penpot:export parse-export)]
(cond-> props
(not (empty? exports))
(assoc :exports exports))))
(defn add-layer-options
[props svg-data]
(let [blend-mode (get svg-data :mix-blend-mode)
opacity (-> (get svg-data :opacity) d/parse-double)]
(cond-> props
(some? blend-mode)
(assoc :blend-mode (keyword blend-mode))
(some? opacity)
(assoc :opacity opacity))))
(defn remove-prefix [s]
(cond-> s
(string? s)
(str/replace #"\w{8}-\w{4}-\w{4}-\w{4}-\w{12}-" "")))
(defn get-svg-attrs
[svg-data svg-attrs]
(let [assoc-key
(fn [acc prop]
(let [key (keyword prop)]
(if-let [v (or (get svg-data key)
(get-in svg-data [:attrs key]))]
(assoc acc key (remove-prefix v))
acc)))]
(->> (str/split svg-attrs ",")
(reduce assoc-key {}))))
(defn get-svg-defs
[node svg-defs]
(let [svg-import (get-data node :penpot:svg-import)]
(->> svg-import
:content
(filter #(= (:tag %) :penpot:svg-def))
(map #(vector (-> % :attrs :def-id)
(-> % :content first)))
(into {}))))
(defn add-svg-attrs
[props node svg-data]
(let [svg-import (get-data node :penpot:svg-import)]
(if (some? svg-import)
(let [svg-attrs (get-in svg-import [:attrs :penpot:svg-attrs])
svg-defs (get-in svg-import [:attrs :penpot:svg-defs])
svg-transform (get-in svg-import [:attrs :penpot:svg-transform])
viewbox-x (get-in svg-import [:attrs :penpot:svg-viewbox-x])
viewbox-y (get-in svg-import [:attrs :penpot:svg-viewbox-y])
viewbox-width (get-in svg-import [:attrs :penpot:svg-viewbox-width])
viewbox-height (get-in svg-import [:attrs :penpot:svg-viewbox-height])]
(cond-> props
:true
(assoc :svg-attrs (get-svg-attrs svg-data svg-attrs))
(some? viewbox-x)
(assoc :svg-viewbox {:x (d/parse-double viewbox-x)
:y (d/parse-double viewbox-y)
:width (d/parse-double viewbox-width)
:height (d/parse-double viewbox-height)})
(some? svg-transform)
(assoc :svg-transform (gmt/str->matrix svg-transform))
(some? svg-defs)
(assoc :svg-defs (get-svg-defs node svg-defs))))
props)))
(defn without-penpot-prefix
[m]
(let [no-penpot-prefix?
(fn [[k v]]
(not (str/starts-with? (d/name k) "penpot:")))]
(into {} (filter no-penpot-prefix?) m)))
(defn camelize [[k v]]
[(-> k d/name str/camel keyword) v])
(defn camelize-keys
[m]
(assert (map? m) (str m))
(into {} (map camelize) m))
(defn fix-style-attr
[m]
(let [fix-style
(fn [[k v]]
(if (= k :style)
[k (-> v parse-style camelize-keys)]
[k v]))]
(d/deep-mapm (comp camelize fix-style) m)))
(defn add-svg-content
[props node]
(let [svg-content (get-data node :penpot:svg-content)
attrs (-> (:attrs svg-content) (without-penpot-prefix))
tag (-> svg-content :attrs :penpot:tag keyword)
node-content
(cond
(= tag :svg)
(->> node :content last :content last :content fix-style-attr)
(= tag :text)
(-> node :content last :content))]
(assoc
props :content
{:attrs attrs
:tag tag
:content node-content})))
(defn get-image-name
[node]
(get-in node [:attrs :penpot:name]))
(defn get-image-data
[node]
(let [svg-data (get-svg-data :image node)]
(:xlink:href svg-data)))
(defn parse-data
[type node]
(when-not (close? node)
(let [name (get-attr node :name)
blocked (get-attr node :blocked str->bool)
hidden (get-attr node :hidden str->bool)
transform (get-attr node :transform gmt/str->matrix)
transform-inverse (get-attr node :transform-inverse gmt/str->matrix)]
(let [svg-data (get-svg-data type node)]
(-> {}
(add-common-data node)
(add-position type node svg-data)
(add-fill node svg-data)
(add-stroke node svg-data)
(add-layer-options svg-data)
(add-shadows node)
(add-blur node)
(add-exports node)
(add-svg-attrs node svg-data)
(-> (extract-data type node)
(assoc :name name)
(assoc :blocked blocked)
(assoc :hidden hidden)
(cond-> (some? transform)
(assoc :transform transform))
(cond-> (some? transform-inverse)
(assoc :transform-inverse transform-inverse))))))
(cond-> (= :svg-raw type)
(add-svg-content node))
(cond-> (= :group type)
(add-group-data node))
(cond-> (= :rect type)
(add-rect-data node svg-data))
(cond-> (= :image type)
(add-image-data node))
(cond-> (= :text type)
(add-text-data node))))))

19
frontend/src/app/util/json.cljs Normal file
View file

@ -0,0 +1,19 @@
;; 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.util.json)
(defn decode
[data]
(-> data
(js/JSON.parse)
(js->clj :keywordize-keys true)))
(defn encode
[data]
(-> data
(clj->js)
(js/JSON.stringify)))

67
frontend/src/app/util/zip.cljs
View file

@ -10,7 +10,8 @@
["jszip" :as zip]
[app.common.data :as d]
[beicon.core :as rx]
[promesa.core :as p]))
[promesa.core :as p]
[app.util.http :as http]))
(defn compress-files
[files]
@ -21,32 +22,44 @@
(->> (.generateAsync zobj #js {:type "blob"})
(rx/from)))))
(defn load-from-url
"Loads the data from a blob url"
[url]
(->> (http/send!
{:uri url
:response-type :blob
:method :get})
(rx/map :body)
(rx/flat-map zip/loadAsync)))
(defn- process-file [entry path]
(cond
(nil? entry)
(p/rejected "No file found")
(.-dir entry)
(p/resolved {:dir path})
:else
(-> (.async entry "text")
(p/then #(hash-map :path path :content %)))))
(defn get-file
"Gets a single file from the zip archive"
[zip path]
(-> (.file zip path)
(process-file path)
(rx/from)))
(defn extract-files
"Creates a stream that will emit values for every file in the zip"
[file]
(rx/create
(fn [subs]
(let [process-entry
(fn [path entry]
(if (.-dir entry)
(rx/push! subs {:dir path})
(p/then
(.async entry "text")
(fn [content]
(rx/push! subs
{:path path
:content content})))))]
[zip]
(let [promises (atom [])
get-file
(fn [path entry]
(let [current (process-file entry path)]
(swap! promises conj current)))]
(.forEach zip get-file)
(p/let [response (js/fetch file)
data (.blob response)
content (zip/loadAsync data)]
(let [promises (atom [])]
(.forEach content
(fn [path entry]
(let [current (process-entry path entry)]
(swap! promises conj current))))
(p/then (p/all @promises)
#(rx/end! subs))))
nil))))
(->> (rx/from (p/all @promises))
(rx/flat-map identity))))

63
frontend/src/app/worker/export.cljs
View file

@ -10,16 +10,39 @@
[app.main.repo :as rp]
[app.util.dom :as dom]
[app.util.zip :as uz]
[app.util.json :as json]
[app.worker.impl :as impl]
[beicon.core :as rx]))
(defn create-manifest
"Creates a manifest entry for the given files"
[team-id files]
(letfn [(format-page [manifest page]
(-> manifest
(assoc (str (:id page))
{:name (:name page)})))
(format-file [manifest file]
(let [name (:name file)
pages (->> (get-in file [:data :pages]) (mapv str))
index (->> (get-in file [:data :pages-index]) (vals)
(reduce format-page {}))]
(-> manifest
(assoc (str (:id file))
{:name name
:pages pages
:pagesIndex index}))))]
(let [manifest {:teamId (str team-id)
:files (->> (vals files) (reduce format-file {}))}]
(json/encode manifest))))
(defn get-page-data
[{file-name :file-name {:keys [id name] :as data} :data}]
[{file-id :file-id {:keys [id name] :as data} :data}]
(->> (r/render-page data)
(rx/map (fn [markup]
{:id id
:name name
:file-name file-name
:file-id file-id
:markup markup}))))
(defn process-pages [file]
@ -27,30 +50,48 @@
pages-index (get-in file [:data :pages-index])]
(->> pages
(map #(hash-map
:file-name (:name file)
:file-id (:id file)
:data (get pages-index %))))))
(defn collect-page
[coll {:keys [id file-name name markup] :as page}]
(conj coll [(str file-name "/" name ".svg") markup]))
[{:keys [id file-id markup] :as page}]
[(str file-id "/" id ".svg") markup])
(defmethod impl/handler :export-file
[{:keys [team-id files] :as message}]
[{:keys [team-id project-id files] :as message}]
(let [render-stream
(->> (rx/from (->> files (mapv :id)))
(let [files-ids (->> files (mapv :id))
files-stream
(->> (rx/from files-ids)
(rx/merge-map #(rp/query :file {:id %}))
(rx/reduce #(assoc %1 (:id %2) %2) {})
(rx/share))
manifest-stream
(->> files-stream
(rx/map #(create-manifest team-id %))
(rx/map #(vector "manifest.json" %)))
render-stream
(->> files-stream
(rx/flat-map vals)
(rx/flat-map process-pages)
(rx/observe-on :async)
(rx/flat-map get-page-data)
(rx/share))]
(rx/share))
pages-stream
(->> render-stream
(rx/map collect-page))]
(rx/merge
(->> render-stream
(rx/map #(hash-map :type :progress
:data (str "Render " (:file-name %) " - " (:name %)))))
(->> render-stream
(rx/reduce collect-page [])
(->> (rx/merge pages-stream
manifest-stream)
(rx/reduce conj [])
(rx/flat-map uz/compress-files)
(rx/map #(hash-map :type :finish
:data (dom/create-uri %)))))))

172
frontend/src/app/worker/import.cljs
View file

@ -11,7 +11,9 @@
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.util.http :as http]
[app.util.import.parser :as cip]
[app.util.json :as json]
[app.util.zip :as uz]
[app.worker.impl :as impl]
[beicon.core :as rx]
@ -21,21 +23,21 @@
;; Upload changes batches size
(def change-batch-size 100)
(defn create-empty-file
(defn create-file
"Create a new file on the back-end"
[project-id file]
(rp/mutation
:create-file
{:id (:id file)
:name (:name file)
:project-id project-id
:data (-> cp/empty-file-data
(assoc :id (:id file)))}))
[project-id name]
(let [file-id (uuid/next)]
(rp/mutation
:create-temp-file
{:id file-id
:name name
:project-id project-id
:data (-> cp/empty-file-data (assoc :id file-id))})))
(defn send-changes
"Creates batches of changes to be sent to the backend"
[file init-revn]
(let [revn (atom init-revn)
[file]
(let [revn (atom (:revn file))
file-id (:id file)
session-id (uuid/next)
changes-batches
@ -43,34 +45,35 @@
(partition change-batch-size change-batch-size nil)
(mapv vec))]
(->> (rx/from changes-batches)
(rx/merge-map
(fn [cur-changes-batch]
(rp/mutation
(rx/concat
(->> (rx/from changes-batches)
(rx/mapcat
#(rp/mutation
:update-file
{:id file-id
:session-id session-id
:revn @revn
:changes cur-changes-batch})))
:changes %}))
(rx/map first)
(rx/tap #(reset! revn (:revn %))))
(rx/tap #(reset! revn (:revn %))))))
(rp/mutation :persist-temp-file {:id (:id file)}))))
(defn persist-file
"Sends to the back-end the imported data"
[project-id file]
(->> (create-empty-file project-id file)
(rx/flat-map #(send-changes file (:revn %)))))
(defn parse-file-name
[dir]
(if (str/ends-with? dir "/")
(subs dir 0 (dec (count dir)))
dir))
(defn parse-page-name
[path]
(let [[file page] (str/split path "/")]
(str/replace page ".svg" "")))
(defn upload-media-files
"Upload a image to the backend and returns its id"
[file-id name data-uri]
(->> (http/send!
{:uri data-uri
:response-type :blob
:method :get})
(rx/map :body)
(rx/map
(fn [blob]
{:name name
:file-id file-id
:content blob
:is-local true}))
(rx/flat-map #(rp/mutation! :upload-file-media-object %))))
(defn add-shape-file
[file node]
@ -87,6 +90,9 @@
:group
(fb/close-group file)
:svg-raw
(fb/close-svg-raw file)
;; default
file)
@ -98,46 +104,80 @@
:path (fb/create-path file data)
:text (fb/create-text file data)
:image (fb/create-image file data)
:svg-raw (fb/create-svg-raw file data)
;; default
file))))
(defn merge-reduce [f seed ob]
(->> (rx/concat
(rx/of seed)
(rx/merge-scan f seed ob))
(rx/last)))
(defn resolve-images
[file-id node]
(if (and (cip/shape? node) (= (cip/get-type node) :image) (not (cip/close? node)))
(let [name (cip/get-image-name node)
data-uri (cip/get-image-data node)]
(->> (upload-media-files file-id name data-uri)
(rx/map
(fn [media]
(-> node
(assoc-in [:attrs :penpot:media-id] (:id media))
(assoc-in [:attrs :penpot:media-width] (:width media))
(assoc-in [:attrs :penpot:media-height] (:height media))
(assoc-in [:attrs :penpot:media-mtype] (:mtype media)))))))
;; If the node is not an image just return the node
(->> (rx/of node)
(rx/observe-on :async))))
(defn import-page
[file {:keys [path content]}]
(let [page-name (parse-page-name path)]
(when (cip/valid? content)
(let [nodes (->> content cip/node-seq)]
(->> nodes
(filter cip/shape?)
(reduce add-shape-file (fb/add-page file page-name))
(fb/close-page))))))
[file [page-name content]]
(if (cip/valid? content)
(let [nodes (->> content cip/node-seq)
file-id (:id file)]
(->> (rx/from nodes)
(rx/filter cip/shape?)
(rx/mapcat (partial resolve-images file-id))
(rx/reduce add-shape-file (fb/add-page file page-name))
(rx/map fb/close-page)))
(rx/empty)))
(defn get-page-path [dir-id id]
(str dir-id "/" id ".svg"))
(defn process-page [file-id zip [page-id page-name]]
(->> (uz/get-file zip (get-page-path (d/name file-id) page-id))
(rx/map (comp tubax/xml->clj :content))
(rx/map #(vector page-name %))))
(defn process-file
[file file-id file-desc zip]
(let [index (:pagesIndex file-desc)
pages (->> (:pages file-desc)
(mapv #(vector % (get-in index [(keyword %) :name]))))]
(->> (rx/from pages)
(rx/flat-map #(process-page file-id zip %))
(merge-reduce import-page file)
(rx/flat-map send-changes)
(rx/ignore))))
(defmethod impl/handler :import-file
[{:keys [project-id files]}]
(let [extract-stream
(->> (rx/from files)
(rx/merge-map uz/extract-files))
(let [zip-str (->> (rx/from files)
(rx/flat-map uz/load-from-url)
(rx/share))]
dir-str
(->> extract-stream
(rx/filter #(contains? % :dir))
(rx/map :dir))
file-str
(->> extract-stream
(rx/filter #(not (contains? % :dir)))
(rx/map #(d/update-when % :content tubax/xml->clj)))]
(->> dir-str
(rx/merge-map
(fn [dir]
(let [file (fb/create-file (parse-file-name dir))]
(rx/concat
(->> file-str
(rx/filter #(str/starts-with? (:path %) dir))
(rx/reduce import-page file)
(rx/flat-map #(persist-file project-id %))
(rx/ignore))
(rx/of (select-keys file [:id :name])))))))))
(->> zip-str
(rx/flat-map #(uz/get-file % "manifest.json"))
(rx/flat-map (comp :files json/decode :content))
(rx/with-latest-from zip-str)
(rx/flat-map
(fn [[[file-id file-desc] zip]]
(->> (create-file project-id (:name file-desc))
(rx/flat-map #(process-file % file-id file-desc zip))
(rx/catch (fn [err]
(.error js/console "ERROR" err (clj->js (.-data err)))))))))))