mirror of
https://github.com/penpot/penpot.git
synced 2026-05-13 03:53:51 +00:00
478f631df5
* ✨ Add notification tag to media uploading This avoid hidding error messages once the upload is finished. * 🐛 Don't throw exception when picker is closed and image is still uploading
482 lines
16 KiB
Clojure
482 lines
16 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC
|
|
|
|
(ns app.main.data.workspace.media
|
|
(:require
|
|
["@penpot/svgo$default" :as svgo]
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.files.changes-builder :as pcb]
|
|
[app.common.files.shapes-builder :as sb]
|
|
[app.common.math :as mth]
|
|
[app.common.media :as media]
|
|
[app.common.schema :as sm]
|
|
[app.common.types.container :as ctn]
|
|
[app.common.types.fills :as types.fills]
|
|
[app.common.types.shape :as cts]
|
|
[app.common.uuid :as uuid]
|
|
[app.config :as cf]
|
|
[app.main.data.changes :as dch]
|
|
[app.main.data.helpers :as dsh]
|
|
[app.main.data.media :as dmm]
|
|
[app.main.data.notifications :as ntf]
|
|
[app.main.data.workspace.shapes :as dwsh]
|
|
[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]]
|
|
[beicon.v2.core :as rx]
|
|
[cuerdas.core :as str]
|
|
[potok.v2.core :as ptk]
|
|
[promesa.core :as p]
|
|
[tubax.core :as tubax]))
|
|
|
|
(def accept-image-types
|
|
(str/join "," media/image-types))
|
|
|
|
(defn- optimize
|
|
[input]
|
|
(svgo/optimize input svgo/defaultOptions))
|
|
|
|
(defn svg->clj
|
|
[[name text]]
|
|
(try
|
|
(let [text (if (contains? cf/flags :frontend-svgo)
|
|
(optimize text)
|
|
text)
|
|
data (-> (tubax/xml->clj text)
|
|
(assoc :name name))]
|
|
(rx/of data))
|
|
(catch :default cause
|
|
(js/console.error cause)
|
|
(rx/throw (ex/error :type :svg-parser
|
|
:hint (ex-message cause))))))
|
|
|
|
;; 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
|
|
|
|
fills (types.fills/create
|
|
{:fill-opacity 1
|
|
:fill-image {:width width
|
|
:height height
|
|
:mtype mtype
|
|
:id id
|
|
:keep-aspect-ratio true}})
|
|
|
|
shape {:name name
|
|
:width width
|
|
:height height
|
|
:x (mth/round (- x (/ width 2)))
|
|
:y (mth/round (- y (/ height 2)))
|
|
:fills fills}]
|
|
|
|
(rx/of (dwsh/create-and-add-shape :rect 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.
|
|
(->> (svg/upload-images svg-data file-id)
|
|
(rx/map #(svg/add-svg-shapes (assoc svg-data :image-data %) position))))))
|
|
|
|
|
|
(defn upload-media-url
|
|
[name file-id url]
|
|
(rp/cmd!
|
|
:create-file-media-object-from-url
|
|
{:name name
|
|
:file-id file-id
|
|
:url url
|
|
:is-local true}))
|
|
|
|
(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")))
|
|
|
|
(upload [uri]
|
|
(->> (http/send! {:method :get :uri uri :mode :no-cors :response-type :blob})
|
|
(rx/map :body)
|
|
(rx/map (fn [content]
|
|
{:file-id file-id
|
|
:name (or name (svg/extract-name uri))
|
|
:is-local local?
|
|
:content content}))
|
|
(rx/mapcat #(rp/cmd! :upload-file-media-object %))))
|
|
|
|
(fetch-svg [name uri]
|
|
(->> (http/send! {:method :get :uri uri :mode :no-cors})
|
|
(rx/map #(vector
|
|
(or name (svg/extract-name uri))
|
|
(:body %)))))]
|
|
|
|
(rx/merge
|
|
(->> (rx/from uris)
|
|
(rx/filter (comp not svg-url?))
|
|
(rx/mapcat upload)
|
|
(rx/tap on-image))
|
|
|
|
(->> (rx/from uris)
|
|
(rx/filter svg-url?)
|
|
(rx/merge-map (partial fetch-svg name))
|
|
(rx/merge-map svg->clj)
|
|
(rx/tap 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) (media/strip-image-extension (.-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/cmd! :upload-file-media-object %))
|
|
(rx/tap 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/tap on-svg)))))
|
|
|
|
(defn handle-media-error [error on-error]
|
|
(if (ex/ex-info? error)
|
|
(handle-media-error (ex-data error) on-error)
|
|
(cond
|
|
(= (:code error) :invalid-svg-file)
|
|
(rx/of (ntf/error (tr "errors.media-type-not-allowed")))
|
|
|
|
(= (:code error) :media-type-not-allowed)
|
|
(rx/of (ntf/error (tr "errors.media-type-not-allowed")))
|
|
|
|
(= (:code error) :unable-to-access-to-url)
|
|
(rx/of (ntf/error (tr "errors.media-type-not-allowed")))
|
|
|
|
(= (:code error) :invalid-image)
|
|
(rx/of (ntf/error (tr "errors.media-type-not-allowed")))
|
|
|
|
(= (:code error) :media-max-file-size-reached)
|
|
(rx/of (ntf/error (tr "errors.media-too-large")))
|
|
|
|
(= (:code error) :media-type-mismatch)
|
|
(rx/of (ntf/error (tr "errors.media-type-mismatch")))
|
|
|
|
(= (:code error) :unable-to-optimize)
|
|
(rx/of (ntf/error (:hint error)))
|
|
|
|
(fn? on-error)
|
|
(on-error error)
|
|
|
|
:else
|
|
(do
|
|
(.error js/console "ERROR" error)
|
|
(rx/of (ntf/error (tr "errors.cannot-upload")))))))
|
|
|
|
|
|
(def ^:private
|
|
schema:process-media-objects
|
|
[:map {:title "process-media-objects"}
|
|
[:file-id ::sm/uuid]
|
|
[:local? :boolean]
|
|
[:name {:optional true} :string]
|
|
[:data {:optional true} :any] ; FIXME
|
|
[:uris {:optional true} [:sequential :string]]
|
|
[:mtype {:optional true} :string]])
|
|
|
|
(defn- process-media-objects
|
|
[{:keys [uris on-error] :as params}]
|
|
(dm/assert!
|
|
(and (sm/check schema:process-media-objects params)
|
|
(or (contains? params :blobs)
|
|
(contains? params :uris))))
|
|
|
|
(ptk/reify ::process-media-objects
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(rx/concat
|
|
(rx/of (ntf/show {:content (tr "media.loading")
|
|
:type :toast
|
|
:level :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-media-error % on-error))
|
|
(rx/finalize #(st/emit! (ntf/hide :tag :media-loading))))))))
|
|
|
|
(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)))
|
|
|
|
(defn upload-fill-image
|
|
[file on-success]
|
|
(assert (dmm/blob? file) "expected a valid blob for `file` param")
|
|
|
|
(ptk/reify ::upload-fill-image
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [on-upload-success
|
|
(fn [image]
|
|
(on-success image)
|
|
(dmm/notify-finished-loading))
|
|
|
|
file-id (:current-file-id state)
|
|
|
|
prepare
|
|
(fn [content]
|
|
{:file-id file-id
|
|
:name (if (dmm/file? content) (.-name content) (tr "media.image"))
|
|
:is-local false
|
|
:content content})]
|
|
|
|
(dmm/notify-start-loading)
|
|
(->> (rx/of file)
|
|
(rx/map dmm/validate-file)
|
|
(rx/map prepare)
|
|
(rx/mapcat #(rp/cmd! :upload-file-media-object %))
|
|
(rx/tap on-upload-success)
|
|
(rx/catch handle-media-error))))))
|
|
|
|
;; --- Upload File Media objects
|
|
|
|
(defn create-shapes-svg
|
|
"Convert svg elements into penpot shapes."
|
|
[file-id objects pos svg-data]
|
|
(let [upload-images
|
|
(fn [svg-data]
|
|
(->> (svg/upload-images svg-data file-id)
|
|
(rx/map #(assoc svg-data :image-data %))))
|
|
|
|
process-svg
|
|
(fn [svg-data]
|
|
(let [[root-svg-shape children]
|
|
(sb/create-svg-shapes svg-data pos objects uuid/zero nil #{} false)
|
|
|
|
frame-shape
|
|
(cts/setup-shape
|
|
{:type :frame
|
|
:x (:x pos)
|
|
:y (:y pos)
|
|
:width (-> root-svg-shape :selrect :width)
|
|
:height (-> root-svg-shape :selrect :height)
|
|
:name (:name root-svg-shape)
|
|
:frame-id uuid/zero
|
|
:parent-id uuid/zero
|
|
:fills (types.fills/create)})
|
|
|
|
root-svg-shape
|
|
(-> root-svg-shape
|
|
(assoc :frame-id (:id frame-shape) :parent-id (:id frame-shape)))
|
|
|
|
shapes
|
|
(->> children
|
|
(filter #(= (:parent-id %) (:id root-svg-shape)))
|
|
(mapv :id))
|
|
|
|
root-svg-shape
|
|
(assoc root-svg-shape :shapes shapes)
|
|
|
|
children (->> children (mapv #(assoc % :frame-id (:id frame-shape))))
|
|
children (d/concat-vec [root-svg-shape] children)]
|
|
|
|
[frame-shape children]))]
|
|
|
|
(->> (upload-images svg-data)
|
|
(rx/map process-svg))))
|
|
|
|
(defn create-shapes-img
|
|
"Convert a media object that contains a bitmap image into shapes,
|
|
one shape of type :rect containing an image fill and one group that contains it."
|
|
[pos {:keys [name width height id mtype] :as media-obj}]
|
|
(let [frame-shape (cts/setup-shape
|
|
{:type :frame
|
|
:x (:x pos)
|
|
:y (:y pos)
|
|
:width width
|
|
:height height
|
|
:name name
|
|
:frame-id uuid/zero
|
|
:parent-id uuid/zero})
|
|
|
|
img-fills (types.fills/create
|
|
{:fill-opacity 1
|
|
:fill-image {:id id
|
|
:width width
|
|
:height height
|
|
:mtype mtype
|
|
:keep-aspect-ratio true}})
|
|
|
|
img-shape (cts/setup-shape
|
|
{:type :rect
|
|
:x (:x pos)
|
|
:y (:y pos)
|
|
:width width
|
|
:height height
|
|
:fills img-fills
|
|
:name name
|
|
:frame-id (:id frame-shape)
|
|
:parent-id (:id frame-shape)})]
|
|
(rx/of [frame-shape [img-shape]])))
|
|
|
|
(defn- add-shapes-and-component
|
|
[it file-data page name [shape children]]
|
|
(let [[component-shape updated-shapes]
|
|
(ctn/convert-shape-in-component shape children (:id file-data))
|
|
|
|
changes (-> (pcb/empty-changes it)
|
|
(pcb/with-page page)
|
|
(pcb/with-objects (:objects page))
|
|
(pcb/with-library-data file-data)
|
|
(pcb/add-objects (cons shape children))
|
|
(pcb/add-component (:id component-shape)
|
|
""
|
|
name
|
|
updated-shapes
|
|
(:id shape)
|
|
(:id page)))]
|
|
|
|
(dch/commit-changes changes)))
|
|
|
|
(defn- process-img-component
|
|
[media-obj]
|
|
(ptk/reify ::process-img-component
|
|
ptk/WatchEvent
|
|
(watch [it state _]
|
|
(let [file-id (:current-file-id state)
|
|
page-id (:current-page-id state)
|
|
|
|
fdata (dsh/lookup-file-data state file-id)
|
|
page (dsh/get-page fdata page-id)
|
|
pos (dsh/get-viewport-center state)]
|
|
|
|
(->> (create-shapes-img pos media-obj)
|
|
(rx/map (partial add-shapes-and-component it fdata page (:name media-obj))))))))
|
|
|
|
(defn- process-svg-component
|
|
[svg-data]
|
|
(ptk/reify ::process-svg-component
|
|
ptk/WatchEvent
|
|
(watch [it state _]
|
|
|
|
(let [file-id (:current-file-id state)
|
|
page-id (:current-page-id state)
|
|
|
|
fdata (dsh/lookup-file-data state file-id)
|
|
page (dsh/get-page fdata page-id)
|
|
pos (dsh/get-viewport-center state)]
|
|
|
|
(->> (create-shapes-svg file-id (:objects page) pos svg-data)
|
|
(rx/map (partial add-shapes-and-component it fdata page (:name svg-data))))))))
|
|
|
|
(defn upload-media-components
|
|
[params]
|
|
(let [params (assoc params
|
|
:local? false
|
|
:on-image #(st/emit! (process-img-component %))
|
|
:on-svg #(st/emit! (process-svg-component %)))]
|
|
(process-media-objects params)))
|
|
|
|
(def ^:private
|
|
schema:clone-media-object
|
|
[:map {:title "clone-media-object"}
|
|
[:file-id ::sm/uuid]
|
|
[:object-id ::sm/uuid]])
|
|
|
|
(defn clone-media-object
|
|
[{:keys [file-id object-id] :as params}]
|
|
(dm/assert!
|
|
(sm/check schema:clone-media-object 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 (ntf/show {:content (tr "media.loading")
|
|
:type :toast
|
|
:level :info
|
|
:timeout nil
|
|
:tag :media-loading}))
|
|
(->> (rp/cmd! :clone-file-media-object params)
|
|
(rx/tap on-success)
|
|
(rx/catch on-error)
|
|
(rx/finalize #(st/emit! (ntf/hide :tag :media-loading)))))))))
|
|
|
|
(defn create-svg-shape
|
|
[id name svg-string position]
|
|
(ptk/reify ::create-svg-shape
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(->> (svg->clj [name svg-string])
|
|
(rx/take 1)
|
|
(rx/map #(svg/add-svg-shapes id % position {:ignore-selection? true
|
|
:change-selection? false}))))))
|
|
(defn create-svg-shape-with-images
|
|
[file-id id name svg-string position on-success on-error]
|
|
(ptk/reify ::create-svg-shape-with-images
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(->> (svg->clj [name svg-string])
|
|
(rx/take 1)
|
|
(rx/mapcat
|
|
(fn [svg-data]
|
|
(->> (svg/upload-images svg-data file-id)
|
|
(rx/map #(assoc svg-data :image-data %)))))
|
|
(rx/map
|
|
(fn [svg-data]
|
|
(svg/add-svg-shapes
|
|
id
|
|
svg-data
|
|
position
|
|
{:ignore-selection? true
|
|
:change-selection? false})))
|
|
(rx/tap on-success)
|
|
(rx/catch on-error)))))
|