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

Merge remote-tracking branch 'origin/staging' into develop

Browse source
This commit is contained in:
Alejandro Alonso 2022-04-26 06:17:27 +02:00
commit b3847cafa8
33 changed files with 1128 additions and 936 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
CHANGES.md
View file

@ -52,6 +52,7 @@
- Round the size values on handoff to two decimals [Taiga #3227](https://tree.taiga.io/project/penpot/issue/3227)
- Fix internal error when hoverin over shape [Taiga #3237](https://tree.taiga.io/project/penpot/issue/3237)
- Fix mouse leave in handoff close overlay animation breaks [Taiga #3173](https://tree.taiga.io/project/penpot/issue/3173)
- Fix different behaviour during image drag [Taiga #2279](https://tree.taiga.io/project/penpot/issue/2279)
- Fix hidden file name on import [Taiga #3172](https://tree.taiga.io/project/penpot/issue/3172)
- Fix unneccessary scrollbars at the color list [Taiga #3211](https://tree.taiga.io/project/penpot/issue/3211)
@ -95,6 +96,7 @@
- Fix component name in sidebar widget [Taiga #3144](https://tree.taiga.io/project/penpot/issue/3144)
- Fix resize rotated shape with top&down constraints [Taiga #3167](https://tree.taiga.io/project/penpot/issue/3167)
- Fix multi user not working [Taiga #3195](https://tree.taiga.io/project/penpot/issue/3195)
- Fix guides are not duplicated with the artboard [Taiga #3072](https://tree.taiga.io/project/penpot/issue/3072)
### :arrow_up: Deps updates
### :heart: Community contributions by (Thank you!)

15
common/src/app/common/media.cljc
View file

@ -44,6 +44,21 @@
"image/svg+xml" :svg
nil))
(defn mtype->extension [mtype]
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
(case mtype
"image/apng" ".apng"
"image/avif" ".avif"
"image/gif" ".gif"
"image/jpeg" ".jpg"
"image/png" ".png"
"image/svg+xml" ".svg"
"image/webp" ".webp"
"application/zip" ".zip"
"application/penpot" ".penpot"
"application/pdf" ".pdf"
nil))
(def max-file-size (* 5 1024 1024))
(s/def ::id uuid?)

47
common/src/app/common/pages/changes_builder.cljc
View file

@ -286,37 +286,38 @@
update-shape
(fn [changes id]
(let [old-obj (get objects id)
new-obj (update-fn old-obj)
new-obj (update-fn old-obj)]
(if (= old-obj new-obj)
changes
(let [attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
attrs (or attrs (d/concat-set (keys old-obj) (keys new-obj)))
{rops :rops uops :uops}
(reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
{:rops [] :uops []}
attrs)
{rops :rops uops :uops}
(reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
{:rops [] :uops []}
attrs)
uops (cond-> uops
(seq uops)
(d/preconj {:type :set-touched :touched (:touched old-obj)}))
uops (cond-> uops
(seq uops)
(d/preconj {:type :set-touched :touched (:touched old-obj)}))
change (cond-> {:type :mod-obj
:id id}
change (cond-> {:type :mod-obj
:id id}
(some? page-id)
(assoc :page-id page-id)
(some? page-id)
(assoc :page-id page-id)
(some? component-id)
(assoc :component-id component-id))]
(some? component-id)
(assoc :component-id component-id))]
(cond-> changes
(seq rops)
(update :redo-changes conj (assoc change :operations rops))
(cond-> changes
(seq rops)
(update :redo-changes conj (assoc change :operations rops))
(seq uops)
(update :undo-changes d/preconj (assoc change :operations uops)))))))]
(seq uops)
(update :undo-changes d/preconj (assoc change :operations uops)))))]
(-> (reduce update-shape changes ids)
(apply-changes-local)))))
(-> (reduce update-shape changes ids)
(apply-changes-local)))))
(defn remove-objects
[changes ids]

17
common/src/app/common/pages/helpers.cljc
View file

@ -502,3 +502,20 @@
(reduce process-shape (transient {}))
(persistent!))
persistent!)))
(defn selected-subtree
"Given a set of shapes, returns an objects subtree with the parents
of the selected items up to the root. Useful to calculate a partial z-index"
[objects selected]
(let [selected+parents
(into selected
(mapcat #(get-parent-ids objects %))
selected)
remove-children
(fn [shape]
(update shape :shapes #(filterv selected+parents %)))]
(-> (select-keys objects selected+parents)
(d/update-vals remove-children))))

208
common/src/app/common/spec/color.cljc
View file

@ -6,8 +6,10 @@
(ns app.common.spec.color
(:require
[app.common.spec :as us]
[clojure.spec.alpha :as s]))
[app.common.data :as d]
[app.common.spec :as us]
[app.common.text :as txt]
[clojure.spec.alpha :as s]))
;; TODO: waiting clojure 1.11 to rename this all :internal.stuff to a
;; more consistent name.
@ -46,7 +48,7 @@
:internal.gradient/width
:internal.gradient/stops]))
;;; --- COLORS
;; --- COLORS
(s/def :internal.color/name string?)
(s/def :internal.color/path (s/nilable string?))
@ -54,6 +56,15 @@
(s/def :internal.color/color (s/nilable string?))
(s/def :internal.color/opacity (s/nilable ::us/safe-number))
(s/def :internal.color/gradient (s/nilable ::gradient))
(s/def :internal.color/ref-id uuid?)
(s/def :internal.color/ref-file uuid?)
(s/def ::shape-color
(s/keys :req-un [:us/color
:internal.color/opacity]
:opt-un [:internal.color/gradient
:internal.color/ref-id
:internal.color/ref-file]))
(s/def ::color
(s/keys :opt-un [::id
@ -70,6 +81,197 @@
:internal.color/opacity
:internal.color/gradient]))
;; --- Helpers for color in different parts of a shape
;; fill
(defn fill->shape-color
[fill]
(d/without-nils {:color (:fill-color fill)
:opacity (:fill-opacity fill)
:gradient (:fill-color-gradient fill)
:ref-id (:fill-color-ref-id fill)
:ref-file (:fill-color-ref-file fill)}))
(defn set-fill-color
[shape position color opacity gradient]
(update-in shape [:fills position]
(fn [fill]
(d/without-nils (assoc fill
:fill-color color
:fill-opacity opacity
:fill-color-gradient gradient)))))
(defn detach-fill-color
[shape position]
(-> shape
(d/dissoc-in [:fills position :fill-color-ref-id])
(d/dissoc-in [:fills position :fill-color-ref-file])))
;; stroke
(defn stroke->shape-color
[stroke]
(d/without-nils {:color (:stroke-color stroke)
:opacity (:stroke-opacity stroke)
:gradient (:stroke-color-gradient stroke)
:ref-id (:stroke-color-ref-id stroke)
:ref-file (:stroke-color-ref-file stroke)}))
(defn set-stroke-color
[shape position color opacity gradient]
(update-in shape [:strokes position]
(fn [stroke]
(d/without-nils (assoc stroke
:stroke-color color
:stroke-opacity opacity
:stroke-color-gradient gradient)))))
(defn detach-stroke-color
[shape position]
(-> shape
(d/dissoc-in [:strokes position :stroke-color-ref-id])
(d/dissoc-in [:strokes position :stroke-color-ref-file])))
;; shadow
(defn shadow->shape-color
[shadow]
(d/without-nils {:color (-> shadow :color :color)
:opacity (-> shadow :color :opacity)
:gradient (-> shadow :color :gradient)
:ref-id (-> shadow :color :id)
:ref-file (-> shadow :color :file-id)}))
(defn set-shadow-color
[shape position color opacity gradient]
(update-in shape [:shadow position :color]
(fn [shadow-color]
(d/without-nils (assoc shadow-color
:color color
:opacity opacity
:gradient gradient)))))
(defn detach-shadow-color
[shape position]
(-> shape
(d/dissoc-in [:shadow position :color :id])
(d/dissoc-in [:shadow position :color :file-id])))
;; grid
(defn grid->shape-color
[grid]
(d/without-nils {:color (-> grid :params :color :color)
:opacity (-> grid :params :color :opacity)
:gradient (-> grid :params :color :gradient)
:ref-id (-> grid :params :color :id)
:ref-file (-> grid :params :color :file-id)}))
(defn set-grid-color
[shape position color opacity gradient]
(update-in shape [:grids position :params :color]
(fn [grid-color]
(d/without-nils (assoc grid-color
:color color
:opacity opacity
:gradient gradient)))))
(defn detach-grid-color
[shape position]
(-> shape
(d/dissoc-in [:grids position :params :color :id])
(d/dissoc-in [:grids position :params :color :file-id])))
;; --- Helpers for all colors in a shape
(defn get-text-node-colors
"Get all colors used by a node of a text shape"
[node]
(concat (map fill->shape-color (:fills node))
(map stroke->shape-color (:strokes node))))
(defn get-all-colors
"Get all colors used by a shape, in any section."
[shape]
(concat (map fill->shape-color (:fills shape))
(map stroke->shape-color (:strokes shape))
(map shadow->shape-color (:shadow shape))
(when (= (:type shape) :frame)
(map grid->shape-color (:grids shape)))
(when (= (:type shape) :text)
(reduce (fn [colors node]
(concat colors (get-text-node-colors node)))
()
(txt/node-seq (:content shape))))))
(defn uses-library-colors?
"Check if the shape uses any color in the given library."
[shape library-id]
(let [all-colors (get-all-colors shape)]
(some #(and (some? (:ref-id %))
(= (:ref-file %) library-id))
all-colors)))
(defn sync-shape-colors
"Look for usage of any color of the given library inside the shape,
and, in this case, copy the library color into the shape."
[shape library-id library-colors]
(let [sync-color (fn [shape position shape-color set-fn detach-fn]
(if (= (:ref-file shape-color) library-id)
(let [library-color (get library-colors (:ref-id shape-color))]
(if (some? library-color)
(set-fn shape
position
(:color library-color)
(:opacity library-color)
(:gradient library-color))
(detach-fn shape position)))
shape))
sync-fill (fn [shape [position fill]]
(sync-color shape
position
(fill->shape-color fill)
set-fill-color
detach-fill-color))
sync-stroke (fn [shape [position stroke]]
(sync-color shape
position
(stroke->shape-color stroke)
set-stroke-color
detach-stroke-color))
sync-shadow (fn [shape [position shadow]]
(sync-color shape
position
(shadow->shape-color shadow)
set-shadow-color
detach-shadow-color))
sync-grid (fn [shape [position grid]]
(sync-color shape
position
(grid->shape-color grid)
set-grid-color
detach-grid-color))
sync-text-node (fn [node]
(as-> node $
(reduce sync-fill $ (d/enumerate (:fills $)))
(reduce sync-stroke $ (d/enumerate (:strokes $)))))
sync-text (fn [shape]
(let [content (:content shape)
new-content (txt/transform-nodes sync-text-node content)]
(if (not= content new-content)
(assoc shape :content new-content)
shape)))]
(as-> shape $
(reduce sync-fill $ (d/enumerate (:fills $)))
(reduce sync-stroke $ (d/enumerate (:strokes $)))
(reduce sync-shadow $ (d/enumerate (:shadow $)))
(reduce sync-grid $ (d/enumerate (:grids $)))
(sync-text $))))

18
common/src/app/common/spec/shape.cljc
View file

@ -166,11 +166,11 @@
::blocked
::collapsed
::fills
::fill-color
::fill-opacity
::fill-color-gradient
::fill-color-ref-file
::fill-color-ref-id
::fill-color ;; TODO: remove these attributes
::fill-opacity ;; when backward compatibility
::fill-color-gradient ;; is no longer needed
::fill-color-ref-file ;;
::fill-color-ref-id ;;
::hide-fill-on-export
::font-family
::font-size
@ -196,10 +196,10 @@
::exports
::shapes
::strokes
::stroke-color
::stroke-color-ref-file
::stroke-color-ref-id
::stroke-opacity
::stroke-color ;; TODO: same thing
::stroke-color-ref-file ;;
::stroke-color-ref-i ;;
::stroke-opacity ;;
::stroke-style
::stroke-width
::stroke-alignment

9
frontend/src/app/main/data/media.cljs
View file

@ -17,15 +17,14 @@
;; --- Predicates
(defn ^boolean file?
(defn file?
[o]
(instance? js/File o))
(defn ^boolean blob?
(defn blob?
[o]
(instance? js/Blob o))
;; --- Specs
(s/def ::blob blob?)
@ -36,8 +35,7 @@
;; --- Utility functions
(defn validate-file
;; Check that a file obtained with the file javascript API is valid.
(defn validate-file ;; Check that a file obtained with the file javascript API is valid.
[file]
(when (> (.-size file) cm/max-file-size)
(ex/raise :type :validation
@ -74,4 +72,3 @@
:else
(tr "errors.unexpected-error"))]
(rx/of (dm/error msg))))

60
frontend/src/app/main/data/workspace.cljs
View file

@ -36,20 +36,19 @@
[app.main.data.workspace.layers :as dwly]
[app.main.data.workspace.layout :as layout]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.notifications :as dwn]
[app.main.data.workspace.path :as dwdp]
[app.main.data.workspace.path.shapes-to-path :as dwps]
[app.main.data.workspace.persistence :as dwp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.svg-upload :as svg]
[app.main.data.workspace.thumbnails :as dwth]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.zoom :as dwz]
[app.main.repo :as rp]
[app.main.streams :as ms]
[app.main.worker :as uw]
[app.util.dom :as dom]
[app.util.globals :as ug]
[app.util.http :as http]
@ -163,7 +162,7 @@
(defn finalize-file
[_project-id file-id]
(ptk/reify ::finalize
(ptk/reify ::finalize-file
ptk/UpdateEvent
(update [_ state]
(dissoc state
@ -1193,28 +1192,14 @@
(defn copy-selected
[]
(letfn [;; Sort objects so they have the same relative ordering
;; when pasted later.
(sort-selected-async [state data]
(let [selected (wsh/lookup-selected state)
objects (wsh/lookup-page-objects state)
page-id (:current-page-id state)]
(->> (uw/ask! {:cmd :selection/query-z-index
:page-id page-id
:objects objects
:ids selected})
(rx/map (fn [z-indexes]
(assoc data :selected
(->> (d/zip selected z-indexes)
(sort-by second)
(map first)
(into (d/ordered-set)))))))))
;; We cannot call to a remote procedure in Safari (for the copy) so we need
;; to calculate it here instead of on the worker
(sort-selected-sync [state data]
(letfn [(sort-selected [state data]
(let [selected (wsh/lookup-selected state)
objects (wsh/lookup-page-objects state)
;; Narrow the objects map so it contains only relevant data for
;; selected and its parents
objects (cph/selected-subtree objects selected)
z-index (cp/calculate-z-index objects)
z-values (->> selected
(map #(vector %
@ -1289,18 +1274,13 @@
:file-id (:current-file-id state)
:selected selected
:objects {}
:images #{}}
:images #{}}]
sort-results
(fn [obs]
;; Safari doesn't allow asynchronous sorting on the copy
(if (cfg/check-browser? :safari)
(rx/map (partial sort-selected-sync state) obs)
(rx/mapcat (partial sort-selected-async state) obs)))]
(->> (rx/from (seq (vals pdata)))
(rx/merge-map (partial prepare-object objects selected))
(rx/reduce collect-data initial)
(sort-results)
(rx/map (partial sort-selected state))
(rx/map t/encode-str)
(rx/map wapi/write-to-clipboard)
(rx/catch on-copy-error)
@ -1606,6 +1586,7 @@
(dwc/add-shape shape)
(dwu/commit-undo-transaction))))))
;; TODO: why not implement it in terms of upload-media-workspace?
(defn- paste-svg
[text]
(us/assert string? text)
@ -1614,8 +1595,8 @@
(watch [_ state _]
(let [position (deref ms/mouse-position)
file-id (:current-file-id state)]
(->> (dwp/parse-svg ["svg" text])
(rx/map #(svg/svg-uploaded % file-id position)))))))
(->> (dwm/svg->clj ["svg" text])
(rx/map #(dwm/svg-uploaded % file-id position)))))))
(defn- paste-image
[image]
@ -1626,7 +1607,7 @@
params {:file-id file-id
:blobs [image]
:position @ms/mouse-position}]
(rx/of (dwp/upload-media-workspace params))))))
(rx/of (dwm/upload-media-workspace params))))))
(defn toggle-distances-display [value]
(ptk/reify ::toggle-distances-display
@ -1708,17 +1689,6 @@
(dm/export dwt/flip-vertical-selected)
(dm/export dwly/set-opacity)
;; Persistence
(dm/export dwp/set-file-shared)
(dm/export dwp/fetch-shared-files)
(dm/export dwp/link-file-to-library)
(dm/export dwp/unlink-file-from-library)
(dm/export dwp/upload-media-asset)
(dm/export dwp/upload-media-workspace)
(dm/export dwp/clone-media-object)
(dm/export dwc/image-uploaded)
;; Common
(dm/export dwc/add-shape)
(dm/export dwc/clear-edition-mode)

52
frontend/src/app/main/data/workspace/changes.cljs
View file

@ -6,11 +6,13 @@
(ns app.main.data.workspace.changes
(:require
[app.common.data :as d]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.uuid :as uuid]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.store :as st]
@ -59,14 +61,52 @@
(let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
(rx/of (commit-changes changes)))))))))
(defn send-update-indices
[]
(ptk/reify ::send-update-indices
ptk/WatchEvent
(watch [_ _ _]
(->> (rx/of
(fn [state]
(-> state
(dissoc ::update-indices-debounce)
(dissoc ::update-changes))))
(rx/observe-on :async)))
ptk/EffectEvent
(effect [_ state _]
(doseq [[page-id changes] (::update-changes state)]
(uw/ask! {:cmd :update-page-indices
:page-id page-id
:changes changes})))))
;; Update indices will debounce operations so we don't have to update
;; the index several times (which is an expensive operation)
(defn update-indices
[page-id changes]
(ptk/reify ::update-indices
ptk/EffectEvent
(effect [_ _ _]
(uw/ask! {:cmd :update-page-indices
:page-id page-id
:changes changes}))))
(let [start (uuid/next)]
(ptk/reify ::update-indices
ptk/UpdateEvent
(update [_ state]
(if (nil? (::update-indices-debounce state))
(assoc state ::update-indices-debounce start)
(update-in state [::update-changes page-id] (fnil d/concat-vec []) changes)))
ptk/WatchEvent
(watch [_ state stream]
(if (= (::update-indices-debounce state) start)
(let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
(rx/merge
(->> stream
(rx/filter (ptk/type? ::update-indices))
(rx/debounce 50)
(rx/take 1)
(rx/map #(send-update-indices))
(rx/take-until stopper))
(rx/of (update-indices page-id changes))))
(rx/empty))))))
(defn commit-changes
[{:keys [redo-changes undo-changes

25
frontend/src/app/main/data/workspace/common.cljs
View file

@ -393,6 +393,11 @@
interactions)))
(vals objects))
;; If any of the deleted shapes is a frame with guides
guides (into {} (map (juxt :id identity) (->> (get-in page [:options :guides])
(vals)
(filter #(not (contains? ids (:frame-id %)))))))
starting-flows
(filter (fn [flow]
;; If any of the deleted is a frame that starts a flow,
@ -432,6 +437,7 @@
changes (-> (pcb/empty-changes it page-id)
(pcb/with-page page)
(pcb/with-objects objects)
(pcb/set-page-option :guides guides)
(pcb/remove-objects all-children)
(pcb/remove-objects ids)
(pcb/remove-objects empty-parents)
@ -482,22 +488,3 @@
(assoc :frame-id frame-id)
(cp/setup-rect-selrect))]
(rx/of (add-shape shape))))))
(defn image-uploaded
[image {:keys [x y]}]
(ptk/reify ::image-uploaded
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [name width height id mtype]} image
shape {:name name
:width width
:height height
:x (- x (/ width 2))
:y (- y (/ height 2))
:metadata {:width width
:height height
:mtype mtype
:id id}}]
(rx/of (create-and-add-shape :image x y shape))))))

71
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -18,6 +18,7 @@
[app.common.spec.file :as spec.file]
[app.common.spec.typography :as spec.typography]
[app.common.uuid :as uuid]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
@ -31,6 +32,7 @@
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
@ -327,7 +329,7 @@
(-> component
(assoc :path path)
(assoc :name name)
(update :objects
(update :objects
;; Give the same name to the root shape
#(assoc-in % [id :name] name)))))
@ -710,3 +712,70 @@
:callback do-dismiss}]
:sync-dialog))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Backend interactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn set-file-shared
[id is-shared]
{:pre [(uuid? id) (boolean? is-shared)]}
(ptk/reify ::set-file-shared
IDeref
(-deref [_]
{::ev/origin "workspace" :id id :shared is-shared})
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-file :is-shared] is-shared))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
(defn- shared-files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
(let [state (dissoc state :files)]
(assoc state :workspace-shared-files files)))))
(defn fetch-shared-files
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched)))))
;; --- Link and unlink Files
(defn link-file-to-library
[file-id library-id]
(ptk/reify ::attach-library
ptk/WatchEvent
(watch [_ _ _]
(let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :link-file-to-library params)
(rx/mapcat #(rp/query :file {:id library-id}))
(rx/map #(partial fetched %)))))))
(defn unlink-file-from-library
[file-id library-id]
(ptk/reify ::detach-library
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:workspace-libraries library-id]))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :unlink-file-from-library params)
(rx/ignore))))))

205
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -14,6 +14,7 @@
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.color :as color]
[app.common.text :as txt]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.groups :as dwg]
@ -24,18 +25,10 @@
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn)
(defonce color-sync-attrs
[[:fill-color-ref-id :fill-color-ref-file :color :fill-color]
[:fill-color-ref-id :fill-color-ref-file :gradient :fill-color-gradient]
[:fill-color-ref-id :fill-color-ref-file :opacity :fill-opacity]
[:stroke-color-ref-id :stroke-color-ref-file :color :stroke-color]
[:stroke-color-ref-id :stroke-color-ref-file :gradient :stroke-color-gradient]
[:stroke-color-ref-id :stroke-color-ref-file :opacity :stroke-opacity]])
(declare generate-sync-container)
(declare generate-sync-shape)
(declare has-asset-reference-fn)
(declare generate-sync-text-shape)
(declare uses-assets?)
(declare get-assets)
(declare generate-sync-shape-direct)
@ -60,7 +53,7 @@
"<local>"
(str "<" (get-in state [:workspace-libraries file-id :name]) ">")))
;; ---- Create a new component ----
;; ---- Components and instances creation ----
(defn make-component-shape
"Clone the shape and all children. Generate new ids and detach
@ -278,9 +271,8 @@
(log/debug :msg "Sync page in local file" :page-id (:id container))
(log/debug :msg "Sync component in local library" :component-id (:id container)))
(let [has-asset-reference? (has-asset-reference-fn asset-type library-id (cph/page? container))
linked-shapes (->> (vals (:objects container))
(filter has-asset-reference?))]
(let [linked-shapes (->> (vals (:objects container))
(filter #(uses-assets? asset-type % library-id (cph/page? container))))]
(loop [shapes (seq linked-shapes)
changes (-> (pcb/empty-changes it)
(pcb/with-container container)
@ -295,49 +287,34 @@
shape))
changes))))
(defn- has-asset-reference-fn
"Gets a function that checks if a shape uses some asset of the given type
in the given library."
[asset-type library-id page?]
(case asset-type
:components
(fn [shape] (and (:component-id shape)
(or (:component-root? shape) (not page?))
(= (:component-file shape) library-id)))
(defmulti uses-assets?
"Checks if a shape uses some asset of the given type in the given library."
(fn [asset-type _ _ _] asset-type))
:colors
(fn [shape]
(if (= (:type shape) :text)
(->> shape
:content
;; Check if any node in the content has a reference for the library
(txt/node-seq
#(or (and (some? (:stroke-color-ref-id %))
(= library-id (:stroke-color-ref-file %)))
(and (some? (:fill-color-ref-id %))
(= library-id (:fill-color-ref-file %))))))
(some
#(let [attr (name %)
attr-ref-id (keyword (str attr "-ref-id"))
attr-ref-file (keyword (str attr "-ref-file"))]
(and (get shape attr-ref-id)
(= library-id (get shape attr-ref-file))))
(map #(nth % 3) color-sync-attrs))))
(defmethod uses-assets? :components
[_ shape library-id page?]
(and (some? (:component-id shape))
(= (:component-file shape) library-id)
(or (:component-root? shape) (not page?)))) ; avoid nested components inside pages
:typographies
(fn [shape]
(and (= (:type shape) :text)
(->> shape
:content
;; Check if any node in the content has a reference for the library
(txt/node-seq
#(and (some? (:typography-ref-id %))
(= library-id (:typography-ref-file %)))))))))
(defmethod uses-assets? :colors
[_ shape library-id _]
(color/uses-library-colors? shape library-id))
(defmethod uses-assets? :typographies
[_ shape library-id _]
(and (= (:type shape) :text)
(->> shape
:content
;; Check if any node in the content has a reference for the library
(txt/node-seq
#(and (some? (:typography-ref-id %))
(= (:typography-ref-file %) library-id))))))
(defmulti generate-sync-shape
"Generate changes to synchronize one shape with all assets of the given type
"Generate changes to synchronize one shape from all assets of the given type
that is using, in the given library."
(fn [type _changes _library-id _state _container _shape] type))
(fn [asset-type _changes _library-id _state _container _shape] asset-type))
(defmethod generate-sync-shape :components
[_ changes _library-id state container shape]
@ -345,6 +322,37 @@
libraries (wsh/get-libraries state)]
(generate-sync-shape-direct changes libraries container shape-id false)))
(defmethod generate-sync-shape :colors
[_ changes library-id state _ shape]
(log/debug :msg "Sync colors of shape" :shape (:name shape))
;; Synchronize a shape that uses some colors of the library. The value of the
;; color in the library is copied to the shape.
(let [library-colors (get-assets library-id :colors state)]
(pcb/update-shapes changes
[(:id shape)]
#(color/sync-shape-colors % library-id library-colors))))
(defmethod generate-sync-shape :typographies
[_ changes library-id state container shape]
(log/debug :msg "Sync typographies of shape" :shape (:name shape))
;; Synchronize a shape that uses some typographies of the library. The attributes
;; of the typography are copied to the shape."
(let [typographies (get-assets library-id :typographies state)
update-node (fn [node]
(if-let [typography (get typographies (:typography-ref-id node))]
(merge node (dissoc typography :name :id))
(dissoc node :typography-ref-id
:typography-ref-file)))]
(generate-sync-text-shape changes shape container update-node)))
(defn- get-assets
[library-id asset-type state]
(if (= library-id (:current-file-id state))
(get-in state [:workspace-data asset-type])
(get-in state [:workspace-libraries library-id :data asset-type])))
(defn- generate-sync-text-shape
[changes shape container update-node]
(let [old-content (:content shape)
@ -368,99 +376,6 @@
changes
changes')))
(defmethod generate-sync-shape :colors
[_ changes library-id state container shape]
(log/debug :msg "Sync colors of shape" :shape (:name shape))
;; Synchronize a shape that uses some colors of the library. The value of the
;; color in the library is copied to the shape.
(let [colors (get-assets library-id :colors state)]
(if (= :text (:type shape))
(let [update-node (fn [node]
(if-let [color (get colors (:fill-color-ref-id node))]
(assoc node
:fill-color (:color color)
:fill-opacity (:opacity color)
:fill-color-gradient (:gradient color))
(assoc node
:fill-color-ref-id nil
:fill-color-ref-file nil)))]
(generate-sync-text-shape changes shape container update-node))
(loop [attrs (seq color-sync-attrs)
roperations []
uoperations []]
(let [[attr-ref-id attr-ref-file color-attr attr] (first attrs)]
(if (nil? attr)
(if (empty? roperations)
changes
(-> changes
(update :redo-changes (make-change
container
{:type :mod-obj
:id (:id shape)
:operations roperations}))
(update :undo-changes (make-change
container
{:type :mod-obj
:id (:id shape)
:operations uoperations}))))
(if-not (contains? shape attr-ref-id)
(recur (next attrs)
roperations
uoperations)
(let [color (get colors (get shape attr-ref-id))
roperations' (if color
[{:type :set
:attr attr
:val (color-attr color)
:ignore-touched true}]
;; If the referenced color does no longer exist in the library,
;; we must unlink the color in the shape
[{:type :set
:attr attr-ref-id
:val nil
:ignore-touched true}
{:type :set
:attr attr-ref-file
:val nil
:ignore-touched true}])
uoperations' (if color
[{:type :set
:attr attr
:val (get shape attr)
:ignore-touched true}]
[{:type :set
:attr attr-ref-id
:val (get shape attr-ref-id)
:ignore-touched true}
{:type :set
:attr attr-ref-file
:val (get shape attr-ref-file)
:ignore-touched true}])]
(recur (next attrs)
(into roperations roperations')
(into uoperations uoperations'))))))))))
(defmethod generate-sync-shape :typographies
[_ changes library-id state container shape]
(log/debug :msg "Sync typographies of shape" :shape (:name shape))
;; Synchronize a shape that uses some typographies of the library. The attributes
;; of the typography are copied to the shape."
(let [typographies (get-assets library-id :typographies state)
update-node (fn [node]
(if-let [typography (get typographies (:typography-ref-id node))]
(merge node (dissoc typography :name :id))
(dissoc node :typography-ref-id
:typography-ref-file)))]
(generate-sync-text-shape changes shape container update-node)))
(defn- get-assets
[library-id asset-type state]
(if (= library-id (:current-file-id state))
(get-in state [:workspace-data asset-type])
(get-in state [:workspace-libraries library-id :data asset-type])))
;; ---- Component synchronization helpers ----

286
frontend/src/app/main/data/workspace/media.cljs Normal file
View file

@ -0,0 +1,286 @@
;; 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.media
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.main.data.media :as dmm]
[app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.svg-upload :as svg]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.i18n :refer [tr]]
[app.util.svg :as usvg]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]
[tubax.core :as tubax]))
(defn svg->clj
[[name text]]
(try
(->> (rx/of (-> (tubax/xml->clj text)
(assoc :name name))))
(catch :default _err
(rx/throw {:type :svg-parser}))))
(defn extract-name [url]
(let [query-idx (str/last-index-of url "?")
url (if (> query-idx 0) (subs url 0 query-idx) url)
filename (->> (str/split url "/") (last))
ext-idx (str/last-index-of filename ".")]
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn data-uri->blob
[data-uri]
(let [[mtype b64-data] (str/split data-uri ";base64,")
mtype (subs mtype (inc (str/index-of mtype ":")))
decoded (.atob js/window b64-data)
size (.-length ^js decoded)
content (js/Uint8Array. size)]
(doseq [i (range 0 size)]
(aset content i (.charCodeAt decoded i)))
(wapi/create-blob content mtype)))
;; TODO: rename to bitmap-image-uploaded
(defn image-uploaded
[image {:keys [x y]}]
(ptk/reify ::image-uploaded
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [name width height id mtype]} image
shape {:name name
:width width
:height height
:x (- x (/ width 2))
:y (- y (/ height 2))
:metadata {:width width
:height height
:mtype mtype
:id id}}]
(rx/of (dwc/create-and-add-shape :image x y shape))))))
(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]
(merge
{:file-id file-id
:is-local true}
(if (str/starts-with? uri "data:")
{:name "image"
:content (data-uri->blob uri)}
{:name (extract-name uri)
:url 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)
;; When the image uploaded fail we skip the shape
;; returning `nil` will afterward not create the shape.
(rx/catch #(rx/of nil))
(rx/map #(vector (:url uri-data) %)))))
(rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
(rx/map #(svg/create-svg-shapes (assoc svg-data :image-data %) position))))))
(defn- process-uris
[{:keys [file-id local? name uris mtype on-image on-svg]}]
(letfn [(svg-url? [url]
(or (and mtype (= mtype "image/svg+xml"))
(str/ends-with? url ".svg")))
(prepare [uri]
{:file-id file-id
:is-local local?
:name (or name (extract-name uri))
:url uri})
(fetch-svg [name uri]
(->> (http/send! {:method :get :uri uri :mode :no-cors})
(rx/map #(vector
(or name (extract-name uri))
(:body %)))))]
(rx/merge
(->> (rx/from uris)
(rx/filter (comp not svg-url?))
(rx/map prepare)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
(rx/do on-image))
(->> (rx/from uris)
(rx/filter svg-url?)
(rx/merge-map (partial fetch-svg name))
(rx/merge-map svg->clj)
(rx/do on-svg)))))
(defn- process-blobs
[{:keys [file-id local? name blobs force-media on-image on-svg]}]
(letfn [(svg-blob? [blob]
(and (not force-media)
(= (.-type blob) "image/svg+xml")))
(prepare-blob [blob]
(let [name (or name (if (dmm/file? blob) (.-name blob) "blob"))]
{:file-id file-id
:name name
:is-local local?
:content blob}))
(extract-content [blob]
(let [name (or name (.-name blob))]
(-> (.text ^js blob)
(p/then #(vector name %)))))]
(rx/merge
(->> (rx/from blobs)
(rx/map dmm/validate-file)
(rx/filter (comp not svg-blob?))
(rx/map prepare-blob)
(rx/mapcat #(rp/mutation! :upload-file-media-object %))
(rx/do on-image))
(->> (rx/from blobs)
(rx/map dmm/validate-file)
(rx/filter svg-blob?)
(rx/merge-map extract-content)
(rx/merge-map svg->clj)
(rx/do on-svg)))))
(s/def ::local? ::us/boolean)
(s/def ::blobs ::dmm/blobs)
(s/def ::name ::us/string)
(s/def ::uris (s/coll-of ::us/string))
(s/def ::mtype ::us/string)
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(us/assert ::process-media-objects params)
(letfn [(handle-error [error]
(if (ex/ex-info? error)
(handle-error (ex-data error))
(cond
(= (:code error) :invalid-svg-file)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :unable-to-access-to-url)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-too-large)
(rx/of (dm/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(= (:code error) :unable-to-optimize)
(rx/of (dm/error (:hint error)))
(fn? on-error)
(on-error error)
:else
(rx/throw error))))]
(ptk/reify ::process-media-objects
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
;; Media objects is a list of URL's pointing to the path
(process-uris params)
;; Media objects are blob of data to be upload
(process-blobs params))
;; Every stream has its own sideeffect. We need to ignore the result
(rx/ignore)
(rx/catch handle-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
(defn upload-media-asset
[params]
(let [params (assoc params
:force-media true
:local? false
:on-image #(st/emit! (dwl/add-media %)))]
(process-media-objects params)))
;; TODO: it is really need handle SVG here, looks like it already
;; handled separatelly
(defn upload-media-workspace
[{:keys [position file-id] :as params}]
(let [params (assoc params
:local? true
:on-image #(st/emit! (image-uploaded % position))
:on-svg #(st/emit! (svg-uploaded % file-id position)))]
(process-media-objects params)))
;; --- Upload File Media objects
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::object-id]))
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error identity}} (meta params)
params {:is-local true
:file-id file-id
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (rp/mutation! :clone-file-media-object params)
(rx/do on-success)
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))

448
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -6,37 +6,28 @@
(ns app.main.data.workspace.persistence
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.spec.file :as spec.file]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.config :as cf]
[app.main.data.dashboard :as dd]
[app.main.data.events :as ev]
[app.main.data.fonts :as df]
[app.main.data.media :as di]
[app.main.data.messages :as dm]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.svg-upload :as svg]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.uri :as uu]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]
[tubax.core :as tubax]))
[okulary.core :as l]
[potok.core :as ptk]))
(log/set-level! :info)
(declare persist-changes)
(declare persist-synchronous-changes)
@ -48,18 +39,17 @@
(defn initialize-file-persistence
[file-id]
(ptk/reify ::initialize-persistence
ptk/EffectEvent
(effect [_ _ stream]
ptk/WatchEvent
(watch [_ _ stream]
(log/debug :hint "initialize persistence")
(let [stoper (rx/filter #(= ::finalize %) stream)
forcer (rx/filter #(= ::force-persist %) stream)
notifier (->> stream
(rx/filter dch/commit-changes?)
(rx/debounce 2000)
(rx/merge stoper forcer))
commits (l/atom [])
local-file?
#(as-> (:file-id %) event-file-id
(or (nil? event-file-id)
(= event-file-id file-id)))
library-file?
#(as-> (:file-id %) event-file-id
(and (some? event-file-id)
@ -80,93 +70,89 @@
;; Disable reload stoper
(swap! st/ongoing-tasks disj :workspace-change)
(st/emit! (update-persistence-status {:status :saved})))]
(->> (rx/merge
(->> stream
(rx/filter dch/commit-changes?)
(rx/map deref)
(rx/filter local-file?)
(rx/tap on-dirty)
(rx/buffer-until notifier)
(rx/filter (complement empty?))
(rx/map (fn [buf]
(->> (into [] (comp (map #(assoc % :id (uuid/next)))
(map #(assoc % :file-id file-id)))
buf)
(persist-changes file-id))))
(rx/tap on-saving)
(rx/take-until (rx/delay 100 stoper)))
(->> stream
(rx/filter dch/commit-changes?)
(rx/map deref)
(rx/filter library-file?)
(rx/filter (complement #(empty? (:changes %))))
(rx/map persist-synchronous-changes)
(rx/take-until (rx/delay 100 stoper)))
(->> stream
(rx/filter (ptk/type? ::changes-persisted))
(rx/tap on-saved)
(rx/ignore)
(rx/take-until stoper)))
(rx/subs #(st/emit! %)
(constantly nil)
(fn []
(on-saved))))))))
(rx/merge
(->> stream
(rx/filter dch/commit-changes?)
(rx/map deref)
(rx/filter local-file?)
(rx/tap on-dirty)
(rx/filter (complement empty?))
(rx/map (fn [commit]
(-> commit
(assoc :id (uuid/next))
(assoc :file-id file-id))))
(rx/observe-on :async)
(rx/tap #(swap! commits conj %))
(rx/take-until (rx/delay 100 stoper))
(rx/finalize (fn []
(log/debug :hint "finalize persistence: changes watcher"))))
(->> (rx/from-atom commits)
(rx/filter (complement empty?))
(rx/sample-when (rx/merge
(rx/interval 5000)
(rx/filter #(= ::force-persist %) stream)
(->> (rx/from-atom commits)
(rx/filter (complement empty?))
(rx/debounce 2000))))
(rx/tap #(reset! commits []))
(rx/tap on-saving)
(rx/mapcat (fn [changes]
;; NOTE: this is needed for don't start the
;; next persistence before this one is
;; finished.
(rx/merge
(rx/of (persist-changes file-id changes))
(->> stream
(rx/filter (ptk/type? ::changes-persisted))
(rx/take 1)
(rx/tap on-saved)
(rx/ignore)))))
(rx/take-until (rx/delay 100 stoper))
(rx/finalize (fn []
(log/debug :hint "finalize persistence: save loop"))))
;; Synchronous changes
(->> stream
(rx/filter dch/commit-changes?)
(rx/map deref)
(rx/filter library-file?)
(rx/filter (complement #(empty? (:changes %))))
(rx/map persist-synchronous-changes)
(rx/take-until (rx/delay 100 stoper))
(rx/finalize (fn []
(log/debug :hint "finalize persistence: synchronous save loop"))))
)))))
(defn persist-changes
[file-id changes]
(log/debug :hint "persist changes" :changes (count changes))
(us/verify ::us/uuid file-id)
(ptk/reify ::persist-changes
ptk/UpdateEvent
(update [_ state]
(let [into* (fnil into [])]
(update-in state [:workspace-persistence :queue] into* changes)))
ptk/WatchEvent
(watch [_ state _]
(let [sid (:session-id state)
file (get state :workspace-file)
queue (get-in state [:workspace-persistence :queue] [])
params {:id (:id file)
:revn (:revn file)
:session-id sid
:changes-with-metadata (into [] queue)}
ids (into #{} (map :id) queue)
update-persistence-queue
(fn [state]
(update-in state [:workspace-persistence :queue]
(fn [items] (into [] (remove #(ids (:id %))) items))))
handle-response
(fn [lagged]
(let [lagged (cond->> lagged
(= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes [])))]
(rx/concat
(rx/of update-persistence-queue)
(->> (rx/of lagged)
(rx/mapcat seq)
(rx/map #(shapes-changes-persisted file-id %))))))
on-error
(fn [{:keys [type] :as error}]
(if (or (= :bad-gateway type)
(= :service-unavailable type))
(rx/of (update-persistence-status {:status :error :reason type}))
(rx/concat
(rx/of update-persistence-queue)
(rx/of (update-persistence-status {:status :error :reason type}))
(rx/of (dws/deselect-all))
(->> (rx/of nil)
(rx/delay 200)
(rx/mapcat #(rx/throw error))))))]
:changes-with-metadata (into [] changes)}]
(when (= file-id (:id params))
(->> (rp/mutation :update-file params)
(rx/mapcat handle-response)
(rx/catch on-error)))))))
(rx/mapcat (fn [lagged]
(log/debug :hint "changes persisted" :lagged (count lagged))
(let [lagged (cond->> lagged
(= #{sid} (into #{} (map :session-id) lagged))
(map #(assoc % :changes [])))]
(->> (rx/of lagged)
(rx/mapcat seq)
(rx/map #(shapes-changes-persisted file-id %))))))
(rx/catch (fn [cause]
(rx/concat
(rx/of (rt/assign-exception cause))
(rx/throw cause))))))))))
(defn persist-synchronous-changes
[{:keys [file-id changes]}]
@ -274,271 +260,6 @@
(rx/of (ptk/data-event ::bundle-fetched bundle)
(df/load-team-fonts (:team-id project)))))))))
;; --- Set File shared
(defn set-file-shared
[id is-shared]
{:pre [(uuid? id) (boolean? is-shared)]}
(ptk/reify ::set-file-shared
IDeref
(-deref [_]
{::ev/origin "workspace" :id id :shared is-shared})
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-file :is-shared] is-shared))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
;; --- Fetch Shared Files
(declare shared-files-fetched)
(defn fetch-shared-files
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched)))))
(defn shared-files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
(let [state (dissoc state :files)]
(assoc state :workspace-shared-files files)))))
;; --- Link and unlink Files
(defn link-file-to-library
[file-id library-id]
(ptk/reify ::attach-library
ptk/WatchEvent
(watch [_ _ _]
(let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :link-file-to-library params)
(rx/mapcat #(rp/query :file {:id library-id}))
(rx/map #(partial fetched %)))))))
(defn unlink-file-from-library
[file-id library-id]
(ptk/reify ::detach-library
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:workspace-libraries library-id]))
ptk/WatchEvent
(watch [_ _ _]
(let [params {:file-id file-id
:library-id library-id}]
(->> (rp/mutation :unlink-file-from-library params)
(rx/ignore))))))
;; --- Upload File Media objects
(defn parse-svg
[[name text]]
(try
(->> (rx/of (-> (tubax/xml->clj text)
(assoc :name name))))
(catch :default _err
(rx/throw {:type :svg-parser}))))
(defn fetch-svg [name uri]
(->> (http/send! {:method :get :uri uri :mode :no-cors})
(rx/map #(vector
(or name (uu/uri-name uri))
(:body %)))))
(defn- handle-upload-error
"Generic error handler for all upload methods."
[on-error stream]
(letfn [(on-error* [error]
(if (ex/ex-info? error)
(on-error* (ex-data error))
(cond
(= (:code error) :invalid-svg-file)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :unable-to-access-to-url)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-too-large)
(rx/of (dm/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(= (:code error) :unable-to-optimize)
(rx/of (dm/error (:hint error)))
(fn? on-error)
(on-error error)
:else
(rx/throw error))))]
(rx/catch on-error* stream)))
(defn- process-uris
[{:keys [file-id local? name uris mtype on-image on-svg]}]
(letfn [(svg-url? [url]
(or (and mtype (= mtype "image/svg+xml"))
(str/ends-with? url ".svg")))
(prepare [uri]
{:file-id file-id
:is-local local?
:name (or name (uu/uri-name uri))
:url uri})]
(rx/merge
(->> (rx/from uris)
(rx/filter (comp not svg-url?))
(rx/map prepare)
(rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
(rx/do on-image))
(->> (rx/from uris)
(rx/filter svg-url?)
(rx/merge-map (partial fetch-svg name))
(rx/merge-map parse-svg)
(rx/do on-svg)))))
(defn- process-blobs
[{:keys [file-id local? name blobs force-media on-image on-svg]}]
(letfn [(svg-blob? [blob]
(and (not force-media)
(= (.-type blob) "image/svg+xml")))
(prepare-blob [blob]
(let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
{:file-id file-id
:name name
:is-local local?
:content blob}))
(extract-content [blob]
(let [name (or name (.-name blob))]
(-> (.text ^js blob)
(p/then #(vector name %)))))]
(rx/merge
(->> (rx/from blobs)
(rx/map di/validate-file)
(rx/filter (comp not svg-blob?))
(rx/map prepare-blob)
(rx/mapcat #(rp/mutation! :upload-file-media-object %))
(rx/do on-image))
(->> (rx/from blobs)
(rx/map di/validate-file)
(rx/filter svg-blob?)
(rx/merge-map extract-content)
(rx/merge-map parse-svg)
(rx/do on-svg)))))
(s/def ::local? ::us/boolean)
(s/def ::blobs ::di/blobs)
(s/def ::name ::us/string)
(s/def ::uris (s/coll-of ::us/string))
(s/def ::mtype ::us/string)
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(us/assert ::process-media-objects params)
(ptk/reify ::process-media-objects
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
;; Media objects is a list of URL's pointing to the path
(process-uris params)
;; Media objects are blob of data to be upload
(process-blobs params))
;; Every stream has its own sideeffect. We need to ignore the result
(rx/ignore)
(handle-upload-error on-error)
(rx/finalize (st/emitf (dm/hide-tag :media-loading))))))))
(defn upload-media-asset
[params]
(let [params (assoc params
:force-media true
:local? false
:on-image #(st/emit! (dwl/add-media %)))]
(process-media-objects params)))
(defn upload-media-workspace
[{:keys [position file-id] :as params}]
(let [params (assoc params
:local? true
:on-image #(st/emit! (dwc/image-uploaded % position))
:on-svg #(st/emit! (svg/svg-uploaded % file-id position)))]
(process-media-objects params)))
;; --- Upload File Media objects
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::object-id]))
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error identity}} (meta params)
params {:is-local true
:file-id file-id
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (rp/mutation! :clone-file-media-object params)
(rx/do on-success)
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
;; --- Helpers
@ -549,7 +270,6 @@
(update-in [:workspace-file :pages] #(filterv (partial not= id) %))
(update :workspace-pages dissoc id)))
(defn preload-data-uris
"Preloads the image data so it's ready when necesary"
[]
@ -560,10 +280,10 @@
(fn [{:keys [metadata fill-image]}]
(cond
(some? metadata)
[(cfg/resolve-file-media metadata)]
[(cf/resolve-file-media metadata)]
(some? fill-image)
[(cfg/resolve-file-media fill-image)]))
[(cf/resolve-file-media fill-image)]))
uris (into #{}
(comp (mapcat extract-urls)

59
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -274,6 +274,7 @@
(declare prepare-duplicate-frame-change)
(declare prepare-duplicate-shape-change)
(declare prepare-duplicate-flows)
(declare prepare-duplicate-guides)
(defn prepare-duplicate-changes
"Prepare objects to duplicate: generate new id, give them unique names,
@ -302,7 +303,9 @@
delta)
init-changes))]
(prepare-duplicate-flows changes shapes page ids-map)))
(-> changes
(prepare-duplicate-flows shapes page ids-map)
(prepare-duplicate-guides shapes page ids-map delta))))
(defn- prepare-duplicate-change
[changes objects page unames update-unames! ids-map shape delta]
@ -362,20 +365,20 @@
changes (-> (pcb/add-object changes new-obj {:ignore-touched true})
(pcb/amend-last-change #(assoc % :old-id (:id obj))))]
(reduce (fn [changes child]
(prepare-duplicate-shape-change changes
objects
page
unames
update-unames!
ids-map
child
delta
frame-id
new-id))
changes
(map (d/getf objects) (:shapes obj))))
changes))
(reduce (fn [changes child]
(prepare-duplicate-shape-change changes
objects
page
unames
update-unames!
ids-map
child
delta
frame-id
new-id))
changes
(map (d/getf objects) (:shapes obj))))
changes))
(defn- prepare-duplicate-flows
[changes shapes page ids-map]
@ -399,6 +402,32 @@
(pcb/update-page-option changes :flows update-flows))
changes)))
(defn- prepare-duplicate-guides
[changes shapes page ids-map delta]
(let [guides (get-in page [:options :guides])
frames (->> shapes
(filter #(= (:type %) :frame)))
new-guides (reduce
(fn [g frame]
(let [new-id (ids-map (:id frame))
new-frame (-> frame
(geom/move delta))
new-guides (->> guides
(vals)
(filter #(= (:frame-id %) (:id frame)))
(map #(-> %
(assoc :id (uuid/next))
(assoc :frame-id new-id)
(assoc :position (if (= (:axis %) :x)
(+ (:position %) (- (:x new-frame) (:x frame)))
(+ (:position %) (- (:y new-frame) (:y frame))))))))]
(conj g
(into {} (map (juxt :id identity) new-guides)))))
guides
frames)]
(-> (pcb/with-page changes page)
(pcb/set-page-option :guides new-guides))))
(defn duplicate-changes-update-indices
"Updates the changes to correctly set the indexes of the duplicated objects,
depending on the index of the original object respect their parent."

33
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -19,11 +19,9 @@
[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]))
@ -429,37 +427,6 @@
[unames changes])))
(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]
(merge
{:file-id file-id
:is-local true}
(if (str/starts-with? uri "data:")
{:name "image"
:content (uu/data-uri->blob uri)}
{:name (uu/uri-name uri)
:url 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)
;; When the image uploaded fail we skip the shape
;; returning `nil` will afterward not create the shape.
(rx/catch #(rx/of nil))
(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

42
frontend/src/app/main/data/workspace/texts.cljs
View file

@ -13,6 +13,7 @@
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.text :as txt]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
@ -379,3 +380,44 @@
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:workspace-text-modifier id]))))
(defn commit-position-data
[]
(ptk/reify ::commit-position-data
ptk/WatchEvent
(watch [_ state _]
(let [position-data (::update-position-data state)]
(rx/concat
(rx/of (dch/update-shapes
(keys position-data)
(fn [shape]
(-> shape
(assoc :position-data (get position-data (:id shape)))))
{:save-undo? false :reg-objects? false}))
(rx/of (fn [state]
(dissoc state ::update-position-data-debounce ::update-position-data))))))))
(defn update-position-data
[id position-data]
(let [start (uuid/next)]
(ptk/reify ::update-position-data
ptk/UpdateEvent
(update [_ state]
(if (nil? (::update-position-data-debounce state))
(assoc state ::update-position-data-debounce start)
(assoc-in state [::update-position-data id] position-data)))
ptk/WatchEvent
(watch [_ state stream]
(if (= (::update-position-data-debounce state) start)
(let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))]
(rx/merge
(->> stream
(rx/filter (ptk/type? ::update-position-data))
(rx/debounce 50)
(rx/take 1)
(rx/map #(commit-position-data))
(rx/take-until stopper))
(rx/of (update-position-data id position-data))))
(rx/empty))))))

2
frontend/src/app/main/render.cljs
View file

@ -402,7 +402,7 @@
:style {:-webkit-print-color-adjust :exact}
:fill "none"}
(let [fonts (ff/frame->fonts object-id objects)]
(let [fonts (ff/frame->fonts object objects)]
[:& ff/fontfaces-style {:fonts fonts}])
(case (:type object)

5
frontend/src/app/main/ui/dashboard/import.cljs
View file

@ -17,6 +17,7 @@
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[potok.core :as ptk]
[rumext.alpha :as mf]))
@ -35,7 +36,7 @@
(mapv
(fn [file]
{:name (.-name file)
:uri (dom/create-uri file)})))]
:uri (wapi/create-uri file)})))]
(st/emit! (modal/show
{:type :import
:project-id project-id
@ -310,7 +311,7 @@
(fn []
;; dispose uris when the component is umount
#(doseq [file files]
(dom/revoke-uri (:uri file)))))
(wapi/revoke-uri (:uri file)))))
[:div.modal-overlay
[:div.modal-container.import-dialog

4
frontend/src/app/main/ui/onboarding/templates.cljs
View file

@ -12,9 +12,9 @@
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[rumext.alpha :as mf]))
@ -39,7 +39,7 @@
(reset! downloading? true)
(->> (http/send! {:method :get :uri link :response-type :blob :mode :no-cors})
(rx/subs (fn [{:keys [body] :as response}]
(open-import-modal {:name name :uri (dom/create-uri body)}))
(open-import-modal {:name name :uri (wapi/create-uri body)}))
(fn [error]
(js/console.log "error" error))
(fn []

49
frontend/src/app/main/ui/viewer/handoff/attributes/image.cljs
View file

@ -6,10 +6,11 @@
(ns app.main.ui.viewer.handoff.attributes.image
(:require
[app.config :as cfg]
[app.common.media :as cm]
[app.common.pages.helpers :as cph]
[app.config :as cf]
[app.main.ui.components.copy-button :refer [copy-button]]
[app.util.code-gen :as cg]
[app.util.dom :as dom]
[app.util.i18n :refer [tr]]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
@ -17,28 +18,28 @@
(defn has-image? [shape]
(= (:type shape) :image))
(mf/defc image-panel [{:keys [shapes]}]
(let [shapes (->> shapes (filter has-image?))]
(for [shape shapes]
[:div.attributes-block {:key (str "image-" (:id shape))}
[:div.attributes-image-row
[:div.attributes-image
[:img {:src (cfg/resolve-file-media (-> shape :metadata))}]]]
(mf/defc image-panel
[{:keys [shapes]}]
(for [shape (filter cph/image-shape? shapes)]
[:div.attributes-block {:key (str "image-" (:id shape))}
[:div.attributes-image-row
[:div.attributes-image
[:img {:src (cf/resolve-file-media (-> shape :metadata))}]]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.width")]
[:div.attributes-value (-> shape :metadata :width) "px"]
[:& copy-button {:data (cg/generate-css-props shape :width)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
[:div.attributes-unit-row
[:div.attributes-label (tr "handoff.attributes.image.height")]
[:div.attributes-value (-> shape :metadata :height) "px"]
[:& copy-button {:data (cg/generate-css-props shape :height)}]]
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (dom/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cfg/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])])))
(let [mtype (-> shape :metadata :mtype)
name (:name shape)
extension (cm/mtype->extension mtype)]
[:a.download-button {:target "_blank"
:download (cond-> name extension (str/concat extension))
:href (cf/resolve-file-media (-> shape :metadata))}
(tr "handoff.attributes.image.download")])]))

154
frontend/src/app/main/ui/viewer/interactions.cljs
View file

@ -406,101 +406,103 @@
(defn animate-open-overlay
[animation overlay-viewport
wrapper-size overlay-size overlay-position]
(case (:animation-type animation)
(when (some? overlay-viewport)
(case (:animation-type animation)
:dissolve
(dom/animate! overlay-viewport
[#js {:opacity "0"}
#js {:opacity "100"}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:slide
(case (:direction animation) ;; way and offset-effect are ignored
:right
:dissolve
(dom/animate! overlay-viewport
[#js {:left (str "-" (:width overlay-size) "px")}
#js {:left (str (:x overlay-position) "px")}]
[#js {:opacity "0"}
#js {:opacity "100"}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:left
(dom/animate! overlay-viewport
[#js {:left (str (:width wrapper-size) "px")}
#js {:left (str (:x overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:slide
(case (:direction animation) ;; way and offset-effect are ignored
:up
(dom/animate! overlay-viewport
[#js {:top (str (:height wrapper-size) "px")}
#js {:top (str (:y overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:right
(dom/animate! overlay-viewport
[#js {:left (str "-" (:width overlay-size) "px")}
#js {:left (str (:x overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:down
(dom/animate! overlay-viewport
[#js {:top (str "-" (:height overlay-size) "px")}
#js {:top (str (:y overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation))))))
:left
(dom/animate! overlay-viewport
[#js {:left (str (:width wrapper-size) "px")}
#js {:left (str (:x overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:up
(dom/animate! overlay-viewport
[#js {:top (str (:height wrapper-size) "px")}
#js {:top (str (:y overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))
:down
(dom/animate! overlay-viewport
[#js {:top (str "-" (:height overlay-size) "px")}
#js {:top (str (:y overlay-position) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)))))))
(defn animate-close-overlay
[animation overlay-viewport
wrapper-size overlay-size overlay-position overlay-id]
(case (:animation-type animation)
(when (some? overlay-viewport)
(case (:animation-type animation)
:dissolve
(dom/animate! overlay-viewport
[#js {:opacity "100"}
#js {:opacity "0"}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:slide
(case (:direction animation) ;; way and offset-effect are ignored
:right
:dissolve
(dom/animate! overlay-viewport
[#js {:left (str (:x overlay-position) "px")}
#js {:left (str (:width wrapper-size) "px")}]
[#js {:opacity "100"}
#js {:opacity "0"}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:left
(dom/animate! overlay-viewport
[#js {:left (str (:x overlay-position) "px")}
#js {:left (str "-" (:width overlay-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:slide
(case (:direction animation) ;; way and offset-effect are ignored
:up
(dom/animate! overlay-viewport
[#js {:top (str (:y overlay-position) "px")}
#js {:top (str "-" (:height overlay-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:right
(dom/animate! overlay-viewport
[#js {:left (str (:x overlay-position) "px")}
#js {:left (str (:width wrapper-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:down
(dom/animate! overlay-viewport
[#js {:top (str (:y overlay-position) "px")}
#js {:top (str (:height wrapper-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id))))))
:left
(dom/animate! overlay-viewport
[#js {:left (str (:x overlay-position) "px")}
#js {:left (str "-" (:width overlay-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:up
(dom/animate! overlay-viewport
[#js {:top (str (:y overlay-position) "px")}
#js {:top (str "-" (:height overlay-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))
:down
(dom/animate! overlay-viewport
[#js {:top (str (:y overlay-position) "px")}
#js {:top (str (:height wrapper-size) "px")}]
#js {:duration (:duration animation)
:easing (name (:easing animation))}
#(st/emit! (dv/complete-animation)
(dv/close-overlay overlay-id)))))))

5
frontend/src/app/main/ui/workspace/header.cljs
View file

@ -12,6 +12,7 @@
[app.main.data.exports :as de]
[app.main.data.modal :as modal]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.repo :as rp]
@ -111,10 +112,10 @@
frames (mf/deref refs/workspace-frames)
add-shared-fn
(st/emitf (dw/set-file-shared (:id file) true))
(st/emitf (dwl/set-file-shared (:id file) true))
del-shared-fn
(st/emitf (dw/set-file-shared (:id file) false))
(st/emitf (dwl/set-file-shared (:id file) false))
on-add-shared
(mf/use-fn

3
frontend/src/app/main/ui/workspace/left_toolbar.cljs
View file

@ -10,6 +10,7 @@
[app.common.media :as cm]
[app.main.data.events :as ev]
[app.main.data.workspace :as dw]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.shortcuts :as sc]
[app.main.refs :as refs]
[app.main.store :as st]
@ -44,7 +45,7 @@
params {:file-id (:id file)
:blobs (seq blobs)
:position (gpt/point x y)}]
(st/emit! (dw/upload-media-workspace params)))))]
(st/emit! (dwm/upload-media-workspace params)))))]
[:li.tooltip.tooltip-right
{:alt (tr "workspace.toolbar.image" (sc/get-tooltip :insert-image))

7
frontend/src/app/main/ui/workspace/libraries.cljs
View file

@ -8,7 +8,6 @@
(:require
[app.common.data :as d]
[app.main.data.modal :as modal]
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.refs :as refs]
[app.main.store :as st]
@ -72,13 +71,13 @@
(reset! search-term "")))
link-library
(mf/use-callback (mf/deps file) #(st/emit! (dw/link-file-to-library (:id file) %)))
(mf/use-callback (mf/deps file) #(st/emit! (dwl/link-file-to-library (:id file) %)))
unlink-library
(mf/use-callback
(mf/deps file)
(fn [library-id]
(st/emit! (dw/unlink-file-from-library (:id file) library-id)
(st/emit! (dwl/unlink-file-from-library (:id file) library-id)
(dwl/sync-file (:id file) library-id))))]
[:*
[:div.section
@ -164,7 +163,7 @@
(mf/deps project)
(fn []
(when (:team-id project)
(st/emit! (dw/fetch-shared-files {:team-id (:team-id project)})))))
(st/emit! (dwl/fetch-shared-files {:team-id (:team-id project)})))))
[:div.modal-overlay
[:div.modal.libraries-dialog

8
frontend/src/app/main/ui/workspace/shapes/text/viewport_texts.cljs
View file

@ -12,7 +12,6 @@
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.text :as txt]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.texts :as dwt]
[app.main.fonts :as fonts]
[app.main.refs :as refs]
@ -54,12 +53,7 @@
;; Update the position-data of every text fragment
(let [position-data (utp/calc-position-data node)]
(st/emit! (dch/update-shapes
[id]
(fn [shape]
(-> shape
(assoc :position-data position-data)))
{:save-undo? false}))))
(st/emit! (dwt/update-position-data id position-data))))
(defn- update-text-modifier
[{:keys [grow-type id]} node]

3
frontend/src/app/main/ui/workspace/sidebar/assets.cljs
View file

@ -18,6 +18,7 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.colors :as dc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.texts :as dwt]
[app.main.data.workspace.undo :as dwu]
@ -912,7 +913,7 @@
(fn [blobs]
(let [params {:file-id file-id
:blobs (seq blobs)}]
(st/emit! (dw/upload-media-asset params)
(st/emit! (dwm/upload-media-asset params)
(ptk/event ::ev/event {::ev/name "add-asset-to-library"
:asset-type "graphics"})))))

138
frontend/src/app/main/ui/workspace/viewport/actions.cljs
View file

@ -13,6 +13,7 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.drawing :as dd]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.media :as dwm]
[app.main.data.workspace.path :as dwdp]
[app.main.store :as st]
[app.main.streams :as ms]
@ -423,82 +424,77 @@
(dnd/has-type? e "text/asset-id"))
(dom/prevent-default e)))))
(defn on-image-uploaded []
(mf/use-callback
(fn [image position]
(st/emit! (dw/image-uploaded image position)))))
(defn on-drop
[file viewport-ref zoom]
(mf/use-fn
(mf/deps zoom)
(fn [event]
(dom/prevent-default event)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(defn on-drop [file viewport-ref zoom]
(let [on-image-uploaded (on-image-uploaded)]
(mf/use-callback
(mf/deps zoom)
(fn [event]
(dom/prevent-default event)
(let [point (gpt/point (.-clientX event) (.-clientY event))
viewport (mf/ref-val viewport-ref)
viewport-coord (utils/translate-point-to-viewport viewport zoom point)
asset-id (-> (dnd/get-data event "text/asset-id") uuid/uuid)
asset-name (dnd/get-data event "text/asset-name")
asset-type (dnd/get-data event "text/asset-type")]
(cond
(dnd/has-type? event "penpot/shape")
(let [shape (dnd/get-data event "penpot/shape")
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :id (uuid/next))
(assoc :x final-x)
(assoc :y final-y)))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
(dnd/has-type? event "penpot/component")
(let [{:keys [component file-id]} (dnd/get-data event "penpot/component")
shape (get-in component [:objects (:id component)])
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dwl/instantiate-component file-id
(:id component)
(gpt/point final-x final-y))))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dwm/upload-media-workspace params)))
;; Will trigger when the user drags an image from a browser to the viewport
(dnd/has-type? event "text/uri-list")
(let [data (dnd/get-data event "text/uri-list")
lines (str/lines data)
uris (filter #(and (not (str/blank? %))
(not (str/starts-with? % "#")))
lines)
params {:file-id (:id file)
:position viewport-coord
:uris uris}]
(st/emit! (dw/upload-media-workspace params)))
;; Will trigger when the user drags an SVG asset from the assets panel
(and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(st/emit! (dwm/upload-media-workspace params)))
;; Will trigger when the user drags an SVG asset from the assets panel
(and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
(let [path (cfg/resolve-file-media {:id asset-id})
params {:file-id (:id file)
:position viewport-coord
:uris [path]
:name asset-name
:mtype asset-type}]
(st/emit! (dw/upload-media-workspace params)))
;; Will trigger when the user drags an image from the assets SVG
(dnd/has-type? event "text/asset-id")
(let [params {:file-id (:id file)
:object-id asset-id
:name asset-name}]
(st/emit! (dwm/clone-media-object
(with-meta params
{:on-success #(st/emit! (dwm/image-uploaded % viewport-coord))}))))
;; Will trigger when the user drags an image from the assets SVG
(dnd/has-type? event "text/asset-id")
(let [params {:file-id (:id file)
:object-id asset-id
:name asset-name}]
(st/emit! (dw/clone-media-object
(with-meta params
{:on-success #(on-image-uploaded % viewport-coord)}))))
;; Will trigger when the user drags a file from their file explorer into the viewport
;; Or the user pastes an image
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dw/upload-media-workspace params)))))))))
;; Will trigger when the user drags a file from their file explorer into the viewport
;; Or the user pastes an image
;; Or the user uploads an image using the image tool
:else
(let [files (dnd/get-files event)
params {:file-id (:id file)
:position viewport-coord
:blobs (seq files)}]
(st/emit! (dwm/upload-media-workspace params))))))))
(defn on-paste [disable-paste in-viewport?]
(mf/use-callback

42
frontend/src/app/util/dom.cljs
View file

@ -10,8 +10,10 @@
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.common.media :as cm]
[app.util.globals :as globals]
[app.util.object :as obj]
[app.util.webapi :as wapi]
[cuerdas.core :as str]
[goog.dom :as dom]
[promesa.core :as p]))
@ -329,28 +331,11 @@
(log/error :msg "Seems like the current browser does not support fullscreen api.")
false)))
(defn ^boolean blob?
(defn blob?
[^js v]
(when (some? v)
(instance? js/Blob v)))
(defn create-blob
"Create a blob from content."
([content]
(create-blob content "application/octet-stream"))
([content mimetype]
(js/Blob. #js [content] #js {:type mimetype})))
(defn revoke-uri
[url]
(js/URL.revokeObjectURL url))
(defn create-uri
"Create a url from blob."
[b]
{:pre [(blob? b)]}
(js/URL.createObjectURL b))
(defn make-node
([namespace name]
(.createElementNS globals/document namespace name))
@ -442,21 +427,6 @@
(when (some? node)
(.getAttribute node (str "data-" attr))))
(defn mtype->extension [mtype]
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types
(case mtype
"image/apng" ".apng"
"image/avif" ".avif"
"image/gif" ".gif"
"image/jpeg" ".jpg"
"image/png" ".png"
"image/svg+xml" ".svg"
"image/webp" ".webp"
"application/zip" ".zip"
"application/penpot" ".penpot"
"application/pdf" ".pdf"
nil))
(defn set-attribute! [^js node ^string attr value]
(when (some? node)
(.setAttribute node attr value)))
@ -507,7 +477,7 @@
(defn trigger-download-uri
[filename mtype uri]
(let [link (create-element "a")
extension (mtype->extension mtype)
extension (cm/mtype->extension mtype)
filename (if (and extension (not (str/ends-with? filename extension)))
(str/concat filename extension)
filename)]
@ -520,14 +490,14 @@
(defn trigger-download
[filename blob]
(trigger-download-uri filename (.-type ^js blob) (create-uri blob)))
(trigger-download-uri filename (.-type ^js blob) (wapi/create-uri blob)))
(defn save-as
[uri filename mtype description]
;; Only chrome supports the save dialog
(if (obj/contains? globals/window "showSaveFilePicker")
(let [extension (mtype->extension mtype)
(let [extension (cm/mtype->extension mtype)
opts {:suggestedName (str filename "." extension)
:types [{:description description
:accept { mtype [(str "." extension)]}}]}]

34
frontend/src/app/util/uri.cljs
View file

@ -1,34 +0,0 @@
;; 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.uri
(:require
[app.util.object :as obj]
[cuerdas.core :as str]))
(defn uri-name [url]
(let [query-idx (str/last-index-of url "?")
url (if (> query-idx 0) (subs url 0 query-idx) url)
filename (->> (str/split url "/") (last))
ext-idx (str/last-index-of filename ".")]
(if (> ext-idx 0) (subs filename 0 ext-idx) filename)))
(defn data-uri->blob
[data-uri]
(let [[mtype b64-data] (str/split data-uri ";base64,")
mtype (subs mtype (inc (str/index-of mtype ":")))
decoded (.atob js/window b64-data)
size (.-length decoded)
content (js/Uint8Array. size)]
(doseq [i (range 0 size)]
(obj/set! content i (.charCodeAt decoded i)))
(js/Blob. #js [content] #js {"type" mtype})))

2
frontend/src/app/util/webapi.cljs
View file

@ -37,7 +37,7 @@
[file]
(file-reader #(.readAsDataURL ^js %1 file)))
(defn ^boolean blob?
(defn blob?
[v]
(instance? js/Blob v))

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

@ -7,13 +7,14 @@
(ns app.worker.export
(:require
[app.common.data :as d]
[app.common.media :as cm]
[app.common.text :as ct]
[app.config :as cfg]
[app.main.render :as r]
[app.main.repo :as rp]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.json :as json]
[app.util.webapi :as wapi]
[app.util.zip :as uz]
[app.worker.impl :as impl]
[beicon.core :as rx]
@ -135,7 +136,7 @@
(rx/map #(assoc % :file-id file-id))
(rx/flat-map
(fn [media]
(let [file-path (str/concat file-id "/media/" (:id media) (dom/mtype->extension (:mtype media)))]
(let [file-path (str/concat file-id "/media/" (:id media) (cm/mtype->extension (:mtype media)))]
(->> (http/send!
{:uri (cfg/resolve-file-media media)
:response-type :blob
@ -466,7 +467,7 @@
:filename (:name file)
:mtype "application/penpot"
:description "Penpot export (*.penpot)"
:uri (dom/create-uri export-blob)}))))
:uri (wapi/create-uri export-blob)}))))
(rx/catch
(fn [err]
(rx/of {:type :error

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

@ -12,11 +12,11 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gpa]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.pages :as cp]
[app.common.text :as ct]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.util.dom :as dom]
[app.util.http :as http]
[app.util.import.parser :as cip]
[app.util.json :as json]
@ -49,7 +49,7 @@
:colors (str file-id "/colors.json")
:typographies (str file-id "/typographies.json")
:media-list (str file-id "/media.json")
:media (let [ext (dom/mtype->extension (:mtype media))]
:media (let [ext (cm/mtype->extension (:mtype media))]
(str/concat file-id "/media/" id ext))
:components (str file-id "/components.svg"))