diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index 0ec4e3a66..b5ce81ae2 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -31,6 +31,7 @@ [app.main.data.workspace.persistence :as dwp] [app.main.data.workspace.selection :as dws] [app.main.data.workspace.transforms :as dwt] + [app.main.data.workspace.svg-upload :as svg] [app.main.repo :as rp] [app.main.store :as st] [app.main.streams :as ms] @@ -1372,6 +1373,7 @@ (declare paste-shape) (declare paste-text) (declare paste-image) +(declare paste-svg) (def paste (ptk/reify ::paste @@ -1428,6 +1430,10 @@ is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))] (cond + (and (string? text-data) + (str/includes? text-data "> (dwp/parse-svg ["svg" text]) + (rx/map #(svg/svg-uploaded % file-id position))))))) (defn- paste-image [image] @@ -1635,8 +1652,9 @@ (watch [_ state stream] (let [file-id (get-in state [:workspace-file :id]) params {:file-id file-id - :data [image]}] - (rx/of (dwp/upload-media-workspace params @ms/mouse-position)))))) + :blobs [image] + :position @ms/mouse-position}] + (rx/of (dwp/upload-media-workspace params)))))) (defn toggle-distances-display [value] (ptk/reify ::toggle-distances-display diff --git a/frontend/src/app/main/data/workspace/common.cljs b/frontend/src/app/main/data/workspace/common.cljs index a9a669bbc..afec9744c 100644 --- a/frontend/src/app/main/data/workspace/common.cljs +++ b/frontend/src/app/main/data/workspace/common.cljs @@ -800,7 +800,8 @@ (gsh/setup-selrect))] (rx/of (add-shape shape)))))) -(defn image-uploaded [image x y] +(defn image-uploaded + [image {:keys [x y]}] (ptk/reify ::image-uploaded ptk/WatchEvent (watch [_ state stream] diff --git a/frontend/src/app/main/data/workspace/persistence.cljs b/frontend/src/app/main/data/workspace/persistence.cljs index 67e4bf8e9..37b0cfb2a 100644 --- a/frontend/src/app/main/data/workspace/persistence.cljs +++ b/frontend/src/app/main/data/workspace/persistence.cljs @@ -376,21 +376,6 @@ ;; --- Upload File Media objects -(s/def ::local? ::us/boolean) -(s/def ::data ::di/blobs) -(s/def ::name ::us/string) -(s/def ::uri ::us/string) -(s/def ::uris (s/coll-of ::uri)) -(s/def ::mtype ::us/string) - -(s/def ::upload-media-objects - (s/and - (s/keys :req-un [::file-id ::local?] - :opt-in [::name ::data ::uris ::mtype]) - (fn [props] - (or (contains? props :data) - (contains? props :uris))))) - (defn parse-svg [[name text]] (->> (rp/query! :parse-svg {:data text}) @@ -402,46 +387,48 @@ (or name (uu/uri-name uri)) (:body %))))) -(defn- handle-upload-error [on-error stream] - (->> stream - (rx/catch - (fn 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"))) +(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) :media-type-not-allowed) + (rx/of (dm/error (tr "errors.media-type-not-allowed"))) - (= (:code error) :ubable-to-access-to-url) - (rx/of (dm/error (tr "errors.media-type-not-allowed"))) + (= (:code error) :ubable-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) :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-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) :media-type-mismatch) + (rx/of (dm/error (tr "errors.media-type-mismatch"))) - (= (:code error) :unable-to-optimize) - (rx/of (dm/error (:hint error))) + (= (:code error) :unable-to-optimize) + (rx/of (dm/error (:hint error))) - (fn? on-error) - (on-error error) + (fn? on-error) + (on-error error) - :else - (rx/throw error))))))) + :else + (rx/throw error))))] + (rx/catch on-error* stream))) -(defn- upload-uris [file-id local? name uris mtype on-image on-svg] +(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 [uri] + (prepare [uri] {:file-id file-id :is-local local? :name (or name (uu/uri-name uri)) @@ -449,7 +436,7 @@ (rx/merge (->> (rx/from uris) (rx/filter (comp not svg-url?)) - (rx/map prepare-uri) + (rx/map prepare) (rx/mapcat #(rp/mutation! :create-file-media-object-from-url %)) (rx/do on-image)) @@ -459,81 +446,91 @@ (rx/merge-map parse-svg) (rx/do on-svg))))) -(defn- upload-data [file-id local? name data force-media on-image on-svg] - (let [svg-blob? (fn [blob] - (and (not force-media) - (= (.-type blob) "image/svg+xml"))) - prepare-file - (fn [blob] - (let [name (or name (if (di/file? blob) (.-name blob) "blob"))] - {:file-id file-id - :name name - :is-local local? - :content blob})) +(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"))) - extract-content - (fn [blob] - (let [name (or name (.-name blob))] - (-> (.text blob) - (p/then #(vector name %))))) + (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 %)))))] - file-stream (->> (rx/from data) - (rx/map di/validate-file))] (rx/merge - (->> file-stream + (->> (rx/from blobs) + (rx/map di/validate-file) (rx/filter (comp not svg-blob?)) - (rx/map prepare-file) + (rx/map prepare-blob) (rx/mapcat #(rp/mutation! :upload-file-media-object %)) (rx/do on-image)) - (->> file-stream + (->> (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))))) -(defn- upload-media-objects - [{:keys [file-id local? data name uris mtype svg-as-images] :as params}] - (us/assert ::upload-media-objects params) - (ptk/reify ::upload-media-objects +(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-in [::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 [_ state stream] - (let [{:keys [on-image on-svg on-error] - :or {on-image identity - on-svg identity}} (meta params)] - (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 - (upload-uris file-id local? name uris mtype on-image on-svg) - ;; Media objects are blob of data to be upload - (upload-data file-id local? name data svg-as-images on-image on-svg)) - ;; Every stream has its own sideffect. We need to ignore the result - (rx/ignore) - (handle-upload-error on-error) - (rx/finalize (st/emitf (dm/hide-tag :media-loading))))))))) + (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 sideffect. 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 (-> params - (assoc :svg-as-images true) - (assoc :local? false) - (with-meta {:on-image #(st/emit! (dwl/add-media %))}))] - (upload-media-objects 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 - [params position] - (let [{:keys [x y]} position - mdata {:on-image #(st/emit! (dwc/image-uploaded % x y)) - :on-svg #(st/emit! (svg/svg-uploaded % (:file-id params) x y))} + [{: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)))] - params (-> (assoc params :local? true) - (with-meta mdata))] - - (upload-media-objects params))) + (process-media-objects params))) ;; --- Upload File Media objects diff --git a/frontend/src/app/main/data/workspace/svg_upload.cljs b/frontend/src/app/main/data/workspace/svg_upload.cljs index 1d076bf52..f2dca9d4e 100644 --- a/frontend/src/app/main/data/workspace/svg_upload.cljs +++ b/frontend/src/app/main/data/workspace/svg_upload.cljs @@ -211,7 +211,7 @@ (defn create-rect-shape [name frame-id svg-data {:keys [attrs] :as data}] (let [svg-transform (usvg/parse-transform (:transform attrs)) - transform (->> svg-transform + transform (->> svg-transform (gmt/transform-in (gpt/point svg-data))) rect (->> (select-keys attrs [:x :y :width :height]) @@ -239,7 +239,7 @@ (defn create-circle-shape [name frame-id svg-data {:keys [attrs] :as data}] (let [svg-transform (usvg/parse-transform (:transform attrs)) - transform (->> svg-transform + transform (->> svg-transform (gmt/transform-in (gpt/point svg-data))) circle (->> (select-keys attrs [:r :ry :rx :cx :cy]) @@ -273,7 +273,7 @@ (defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}] (let [svg-transform (usvg/parse-transform (:transform attrs)) - transform (->> svg-transform + transform (->> svg-transform (gmt/transform-in (gpt/point svg-data))) image-url (:xlink:href attrs) @@ -327,7 +327,7 @@ (update :attrs usvg/add-transform disp-matrix) (assoc :content [use-data]))] (parse-svg-element frame-id svg-data element-data unames)) - + ;; SVG graphic elements ;; :circle :ellipse :image :line :path :polygon :polyline :rect :text :use (let [shape (-> (case tag @@ -381,42 +381,42 @@ (declare create-svg-shapes) -(defn svg-uploaded [svg-data file-id x y] +(defn svg-uploaded + [svg-data file-id position] (ptk/reify ::svg-uploaded ptk/WatchEvent (watch [_ state stream] - (let [images-to-upload (-> svg-data (usvg/collect-images)) + ;; Once the SVG is uploaded, we need to extract all the bitmap + ;; images and upload them separatelly, then proceed to create + ;; all shapes. + (->> (rx/from (usvg/collect-images svg-data)) + (rx/map (fn [uri] + (d/merge + {:file-id file-id + :is-local true + :url uri} - prepare-uri - (fn [uri] - (merge - {:file-id file-id - :is-local true - :url uri} + (if (str/starts-with? uri "data:") + {:name "image" + :content (uu/data-uri->blob uri)} + {:name (uu/uri-name uri)})))) + (rx/mapcat (fn [uri-data] + (->> (rp/mutation! (if (contains? uri-data :content) + :upload-file-media-object + :create-file-media-object-from-url) uri-data) + (rx/map #(vector (:url uri-data) %))))) + (rx/reduce (fn [acc [url image]] (assoc acc url image)) {}) + (rx/map #(create-svg-shapes (assoc svg-data :image-data %) position)))))) - (if (str/starts-with? uri "data:") - {:name "image" - :content (uu/data-uri->blob uri)} - {:name (uu/uri-name uri)})))] - - (->> (rx/from images-to-upload) - (rx/map prepare-uri) - (rx/mapcat (fn [uri-data] - (->> (rp/mutation! (if (contains? uri-data :content) - :upload-file-media-object - :create-file-media-object-from-url) uri-data) - (rx/map #(vector (:url uri-data) %))))) - (rx/reduce (fn [acc [url image]] (assoc acc url image)) {}) - (rx/map #(create-svg-shapes (assoc svg-data :image-data %) x y))))))) - -(defn create-svg-shapes [svg-data x y] +(defn create-svg-shapes + [svg-data {:keys [x y] :as position}] (ptk/reify ::create-svg-shapes ptk/WatchEvent (watch [_ state stream] (try (let [page-id (:current-page-id state) objects (dwc/lookup-page-objects state page-id) - frame-id (cp/frame-id-by-position objects {:x x :y y}) + frame-id (cp/frame-id-by-position objects position) selected (get-in state [:workspace-local :selected]) [vb-x vb-y vb-width vb-height] (svg-dimensions svg-data) diff --git a/frontend/src/app/main/ui/workspace/left_toolbar.cljs b/frontend/src/app/main/ui/workspace/left_toolbar.cljs index 9390b62ca..fd7053d5e 100644 --- a/frontend/src/app/main/ui/workspace/left_toolbar.cljs +++ b/frontend/src/app/main/ui/workspace/left_toolbar.cljs @@ -33,14 +33,16 @@ (mf/use-callback (mf/deps file) (fn [blobs] - (let [params {:file-id (:id file) - :data (seq blobs)} - ;; We don't want to add a ref because that redraws the component - ;; for everychange. Better direct access on the callback - vbox (get-in @st/state [:workspace-local :vbox]) - x (mth/round (+ (:x vbox) (/ (:width vbox) 2))) - y (mth/round (+ (:y vbox) (/ (:height vbox) 2)))] - (st/emit! (dw/upload-media-workspace params (gpt/point x y))))))] + ;; We don't want to add a ref because that redraws the component + ;; for everychange. Better direct access on the callback + ;; vbox (get-in @st/state [:workspace-local :vbox]) + (let [vbox (:vbox @refs/workspace-local) + x (mth/round (+ (:x vbox) (/ (:width vbox) 2))) + y (mth/round (+ (:y vbox) (/ (:height vbox) 2))) + params {:file-id (:id file) + :blobs (seq blobs) + :position (gpt/point x y)}] + (st/emit! (dw/upload-media-workspace params)))))] [:li.tooltip.tooltip-right {:alt (tr "workspace.toolbar.image") diff --git a/frontend/src/app/main/ui/workspace/sidebar/assets.cljs b/frontend/src/app/main/ui/workspace/sidebar/assets.cljs index 604004d55..6a2abb5b0 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/assets.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/assets.cljs @@ -152,18 +152,12 @@ (st/emitf (dwl/set-assets-box-open file-id :graphics true)) (dom/click (mf/ref-val input-ref)))) - on-media-uploaded - (mf/use-callback - (mf/deps file-id) - (fn [data] - (st/emit! (dwl/add-media data)))) - on-selected (mf/use-callback (mf/deps file-id) (fn [blobs] (let [params {:file-id file-id - :data (seq blobs)}] + :blobs (seq blobs)}] (st/emit! (dw/upload-media-asset params))))) on-delete diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index 2bcf54cac..1d94d938d 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -389,8 +389,8 @@ (defn on-image-uploaded [] (mf/use-callback - (fn [image {:keys [x y]}] - (st/emit! (dw/image-uploaded image x y))))) + (fn [image position] + (st/emit! (dw/image-uploaded image position))))) (defn on-drop [file viewport-ref zoom] (let [on-image-uploaded (on-image-uploaded)] @@ -427,21 +427,23 @@ (dnd/has-type? event "text/uri-list") (let [data (dnd/get-data event "text/uri-list") lines (str/lines data) - urls (filter #(and (not (str/blank? %)) + uris (filter #(and (not (str/blank? %)) (not (str/starts-with? % "#"))) lines) params {:file-id (:id file) - :uris urls}] - (st/emit! (dw/upload-media-workspace params viewport-coord))) + :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! (dw/upload-media-workspace params viewport-coord))) + (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") @@ -458,8 +460,9 @@ :else (let [files (dnd/get-files event) params {:file-id (:id file) - :data (seq files)}] - (st/emit! (dw/upload-media-workspace params viewport-coord))))))))) + :position viewport-coord + :blobs (seq files)}] + (st/emit! (dw/upload-media-workspace params))))))))) (defn on-paste [disable-paste in-viewport?] (mf/use-callback