;; 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 (:require [app.common.data :as d] [app.common.geom.align :as gal] [app.common.geom.matrix :as gmt] [app.common.geom.point :as gpt] [app.common.geom.proportions :as gpr] [app.common.geom.shapes :as gsh] [app.common.math :as mth] [app.common.pages :as cp] [app.common.pages.helpers :as cph] [app.common.pages.spec :as spec] [app.common.spec :as us] [app.common.transit :as t] [app.common.uuid :as uuid] [app.config :as cfg] [app.main.data.events :as ev] [app.main.data.messages :as dm] [app.main.data.workspace.booleans :as dwb] [app.main.data.workspace.changes :as dch] [app.main.data.workspace.common :as dwc] [app.main.data.workspace.drawing :as dwd] [app.main.data.workspace.groups :as dwg] [app.main.data.workspace.interactions :as dwi] [app.main.data.workspace.libraries :as dwl] [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.transforms :as dwt] [app.main.data.workspace.undo :as dwu] [app.main.repo :as rp] [app.main.streams :as ms] [app.main.worker :as uw] [app.util.globals :as ug] [app.util.http :as http] [app.util.i18n :as i18n] [app.util.router :as rt] [app.util.webapi :as wapi] [beicon.core :as rx] [cljs.spec.alpha :as s] [clojure.set :as set] [cuerdas.core :as str] [potok.core :as ptk])) ;; (log/set-level! :trace) (s/def ::shape-attrs ::cp/shape-attrs) (s/def ::set-of-string (s/every string? :kind set?)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace Initialization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare file-initialized) ;; --- Initialize Workspace (s/def ::layout-flag #{:sitemap :layers :comments :assets :document-history :colorpalette :element-options :rules :display-grid :snap-grid :scale-text :dynamic-alignment}) (s/def ::layout-flags (s/coll-of ::layout-flag)) (def default-layout #{:sitemap :layers :element-options :rules :display-grid :snap-grid :dynamic-alignment}) (def layout-presets {:assets {:del #{:sitemap :layers :document-history } :add #{:assets}} :document-history {:del #{:assets :layers :sitemap} :add #{:document-history}} :layers {:del #{:document-history :assets} :add #{:sitemap :layers}}}) (s/def ::options-mode #{:design :prototype}) (def workspace-local-default {:zoom 1 :flags #{} :selected (d/ordered-set) :expanded {} :tooltip nil :options-mode :design :draw-interaction-to nil :left-sidebar? true :right-sidebar? true :color-for-rename nil :selected-palette-colorpicker :recent :selected-palette :recent :selected-palette-size :big :assets-files-open {} :picking-color? false :picked-color nil :picked-color-select false}) (defn ensure-layout [lname] (ptk/reify ::ensure-layout ptk/UpdateEvent (update [_ state] (update state :workspace-layout (fn [stored] (let [todel (get-in layout-presets [lname :del] #{}) toadd (get-in layout-presets [lname :add] #{})] (-> stored (set/difference todel) (set/union toadd)))))))) (defn setup-layout [lname] (us/verify (s/nilable ::us/keyword) lname) (ptk/reify ::setup-layout ptk/UpdateEvent (update [_ state] (update state :workspace-layout #(or % default-layout))) ptk/WatchEvent (watch [_ _ _] (if (and lname (contains? layout-presets lname)) (rx/of (ensure-layout lname)) (rx/of (ensure-layout :layers)))))) (defn initialize-file [project-id file-id] (us/verify ::us/uuid project-id) (us/verify ::us/uuid file-id) (ptk/reify ::initialize-file ptk/UpdateEvent (update [_ state] (assoc state :current-file-id file-id :current-project-id project-id :workspace-presence {})) ptk/WatchEvent (watch [_ _ stream] (rx/merge (rx/of (dwp/fetch-bundle project-id file-id)) ;; Initialize notifications (websocket connection) and the file persistence (->> stream (rx/filter (ptk/type? ::dwp/bundle-fetched)) (rx/take 1) (rx/map deref) (rx/mapcat (fn [bundle] (rx/merge (rx/of (dwn/initialize file-id) (dwp/initialize-file-persistence file-id) (dwc/initialize-indices bundle)) (->> stream (rx/filter #(= ::dwc/index-initialized %)) (rx/first) (rx/map #(file-initialized bundle))))))))) ptk/EffectEvent (effect [_ _ _] (let [name (str "workspace-" file-id)] (unchecked-set ug/global "name" name))))) (defn- file-initialized [{:keys [file users project libraries] :as bundle}] (ptk/reify ::file-initialized ptk/UpdateEvent (update [_ state] (assoc state :current-team-id (:team-id project) :users (d/index-by :id users) :workspace-undo {} :workspace-project project :workspace-file (assoc file :initialized true) :workspace-data (:data file) :workspace-libraries (d/index-by :id libraries))) ptk/WatchEvent (watch [_ _ _] (let [file-id (:id file) ignore-until (:ignore-sync-until file) needs-update? (some #(and (> (:modified-at %) (:synced-at %)) (or (not ignore-until) (> (:modified-at %) ignore-until))) libraries)] (when needs-update? (rx/of (dwl/notify-sync-file file-id))))))) (defn finalize-file [_project-id file-id] (ptk/reify ::finalize ptk/UpdateEvent (update [_ state] (dissoc state :current-file-id :current-project-id :workspace-data :workspace-editor-state :workspace-file :workspace-libraries :workspace-media-objects :workspace-persistence :workspace-presence :workspace-project :workspace-project :workspace-undo)) ptk/WatchEvent (watch [_ _ _] (rx/merge (rx/of (dwn/finalize file-id)) (->> (rx/of ::dwp/finalize) (rx/observe-on :async)))))) (defn initialize-page [page-id] (us/assert ::us/uuid page-id) (ptk/reify ::initialize-page ptk/UpdateEvent (update [_ state] (let [;; we maintain a cache of page state for user convenience ;; with the exception of the selection; when user abandon ;; the current page, the selection is lost page (get-in state [:workspace-data :pages-index page-id]) local (-> state (get-in [:workspace-cache page-id] workspace-local-default) (assoc :selected (d/ordered-set)))] (-> state (assoc :current-page-id page-id) (assoc :trimmed-page (select-keys page [:id :name])) (assoc :workspace-local local) (update-in [:route :params :query] assoc :page-id (str page-id))))))) (defn finalize-page [page-id] (us/assert ::us/uuid page-id) (ptk/reify ::finalize-page ptk/UpdateEvent (update [_ state] (let [page-id (or page-id (get-in state [:workspace-data :pages 0])) local (-> (:workspace-local state) (dissoc :edition :edit-path :selected))] (-> state (assoc-in [:workspace-cache page-id] local) (dissoc :current-page-id :workspace-local :trimmed-page :workspace-drawing)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace Page CRUD ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn create-page [{:keys [file-id]}] (let [id (uuid/next)] (ptk/reify ::create-page IDeref (-deref [_] {:id id :file-id file-id}) ptk/WatchEvent (watch [it state _] (let [pages (get-in state [:workspace-data :pages-index]) unames (dwc/retrieve-used-names pages) name (dwc/generate-unique-name unames "Page-1") rchange {:type :add-page :id id :name name} uchange {:type :del-page :id id}] (rx/of (dch/commit-changes {:redo-changes [rchange] :undo-changes [uchange] :origin it}))))))) (defn duplicate-page [page-id] (ptk/reify ::duplicate-page ptk/WatchEvent (watch [this state _] (let [id (uuid/next) pages (get-in state [:workspace-data :pages-index]) unames (dwc/retrieve-used-names pages) page (get-in state [:workspace-data :pages-index page-id]) name (dwc/generate-unique-name unames (:name page)) page (-> page (assoc :name name :id id)) rchange {:type :add-page :page page} uchange {:type :del-page :id id}] (rx/of (dch/commit-changes {:redo-changes [rchange] :undo-changes [uchange] :origin this})))))) (s/def ::rename-page (s/keys :req-un [::id ::name])) (defn rename-page [id name] (us/verify ::us/uuid id) (us/verify string? name) (ptk/reify ::rename-page ptk/WatchEvent (watch [it state _] (let [page (get-in state [:workspace-data :pages-index id]) rchg {:type :mod-page :id id :name name} uchg {:type :mod-page :id id :name (:name page)}] (rx/of (dch/commit-changes {:redo-changes [rchg] :undo-changes [uchg] :origin it})))))) (declare purge-page) (declare go-to-file) ;; TODO: properly handle positioning on undo. (defn delete-page [id] (ptk/reify ::delete-page ptk/WatchEvent (watch [it state _] (let [page (get-in state [:workspace-data :pages-index id]) rchg {:type :del-page :id id} uchg {:type :add-page :page page}] (rx/of (dch/commit-changes {:redo-changes [rchg] :undo-changes [uchg] :origin it}) (when (= id (:current-page-id state)) go-to-file)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; WORKSPACE File Actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn rename-file [id name] {:pre [(uuid? id) (string? name)]} (ptk/reify ::rename-file IDeref (-deref [_] {::ev/origin "workspace" :id id :name name}) ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-file :name] name)) ptk/WatchEvent (watch [_ _ _] (let [params {:id id :name name}] (->> (rp/mutation :rename-file params) (rx/ignore)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace State Manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; --- Viewport Sizing (declare increase-zoom) (declare decrease-zoom) (declare set-zoom) (declare zoom-to-fit-all) (defn initialize-viewport [{:keys [width height] :as size}] (letfn [(update* [{:keys [vport] :as local}] (let [wprop (/ (:width vport) width) hprop (/ (:height vport) height)] (-> local (assoc :vport size) (update :vbox (fn [vbox] (-> vbox (update :width #(/ % wprop)) (update :height #(/ % hprop)))))))) (initialize [state local] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) shapes (cp/select-toplevel-shapes objects {:include-frames? true}) srect (gsh/selection-rect shapes) local (assoc local :vport size :zoom 1)] (cond (or (not (mth/finite? (:width srect))) (not (mth/finite? (:height srect)))) (assoc local :vbox (assoc size :x 0 :y 0 :left-offset 0)) (or (> (:width srect) width) (> (:height srect) height)) (let [srect (gal/adjust-to-viewport size srect {:padding 40}) zoom (/ (:width size) (:width srect))] (-> local (assoc :zoom zoom) (update :vbox merge srect))) :else (assoc local :vbox (assoc size :x (+ (:x srect) (/ (- (:width srect) width) 2)) :y (+ (:y srect) (/ (- (:height srect) height) 2))))))) (setup [state local] (if (:vbox local) (update* local) (initialize state local)))] (ptk/reify ::initialize-viewport ptk/UpdateEvent (update [_ state] (update state :workspace-local (fn [local] (setup state local))))))) (defn update-viewport-position [{:keys [x y] :or {x identity y identity}}] (us/assert fn? x) (us/assert fn? y) (ptk/reify ::update-viewport-position ptk/UpdateEvent (update [_ state] (update-in state [:workspace-local :vbox] (fn [vbox] (-> vbox (update :x x) (update :y y))))))) (defn update-viewport-size [{:keys [width height] :as size}] (ptk/reify ::update-viewport-size ptk/UpdateEvent (update [_ state] (update state :workspace-local (fn [{:keys [vport left-sidebar? zoom] :as local}] (if (or (mth/almost-zero? width) (mth/almost-zero? height)) ;; If we have a resize to zero just keep the old value local (let [wprop (/ (:width vport) width) hprop (/ (:height vport) height) left-offset (if left-sidebar? 0 (/ (* -1 15 16) zoom))] (-> local ;; This matches $width-settings-bar (assoc :vport size) ;; in frontend/resources/styles/main/partials/sidebar.scss (update :vbox (fn [vbox] (-> vbox (update :width #(/ % wprop)) (update :height #(/ % hprop)) (assoc :left-offset left-offset)))))))))))) (defn start-panning [] (ptk/reify ::start-panning ptk/WatchEvent (watch [_ state stream] (let [stopper (->> stream (rx/filter (ptk/type? ::finish-panning))) zoom (-> (get-in state [:workspace-local :zoom]) gpt/point)] (when-not (get-in state [:workspace-local :panning]) (rx/concat (rx/of #(-> % (assoc-in [:workspace-local :panning] true))) (->> stream (rx/filter ms/pointer-event?) (rx/filter #(= :delta (:source %))) (rx/map :pt) (rx/take-until stopper) (rx/map (fn [delta] (let [delta (gpt/divide delta zoom)] (update-viewport-position {:x #(- % (:x delta)) :y #(- % (:y delta))}))))))))))) (defn finish-panning [] (ptk/reify ::finish-panning ptk/UpdateEvent (update [_ state] (-> state (update :workspace-local dissoc :panning))))) (defn start-zooming [pt] (ptk/reify ::start-zooming ptk/WatchEvent (watch [_ state stream] (let [stopper (->> stream (rx/filter (ptk/type? ::finish-zooming)))] (when-not (get-in state [:workspace-local :zooming]) (rx/concat (rx/of #(-> % (assoc-in [:workspace-local :zooming] true))) (->> stream (rx/filter ms/pointer-event?) (rx/filter #(= :delta (:source %))) (rx/map :pt) (rx/take-until stopper) (rx/map (fn [delta] (let [scale (+ 1 (/ (:y delta) 100))] ;; this number may be adjusted after user testing (set-zoom pt scale))))))))))) (defn finish-zooming [] (ptk/reify ::finish-zooming ptk/UpdateEvent (update [_ state] (-> state (update :workspace-local dissoc :zooming))))) ;; --- Toggle layout flag (defn toggle-layout-flags [& flags] (ptk/reify ::toggle-layout-flags ptk/UpdateEvent (update [_ state] (update state :workspace-layout (fn [stored] (reduce (fn [flags flag] (if (contains? flags flag) (disj flags flag) (conj flags flag))) stored (into #{} flags))))))) ;; --- Set element options mode (defn set-options-mode [mode] (us/assert ::options-mode mode) (ptk/reify ::set-options-mode ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :options-mode] mode)))) ;; --- Tooltip (defn assign-cursor-tooltip [content] (ptk/reify ::assign-cursor-tooltip ptk/UpdateEvent (update [_ state] (if (string? content) (assoc-in state [:workspace-local :tooltip] content) (assoc-in state [:workspace-local :tooltip] nil))))) ;; --- Zoom Management (defn- impl-update-zoom [{:keys [vbox] :as local} center zoom] (let [vbox (update vbox :x + (:left-offset vbox)) new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom) old-zoom (:zoom local) center (if center center (gsh/center-rect vbox)) scale (/ old-zoom new-zoom) mtx (gmt/scale-matrix (gpt/point scale) center) vbox' (gsh/transform-rect vbox mtx) vbox' (update vbox' :x - (:left-offset vbox))] (-> local (assoc :zoom new-zoom) (update :vbox merge (select-keys vbox' [:x :y :width :height]))))) (defn increase-zoom [center] (ptk/reify ::increase-zoom ptk/UpdateEvent (update [_ state] (update state :workspace-local #(impl-update-zoom % center (fn [z] (min (* z 1.3) 200))))))) (defn decrease-zoom [center] (ptk/reify ::decrease-zoom ptk/UpdateEvent (update [_ state] (update state :workspace-local #(impl-update-zoom % center (fn [z] (max (/ z 1.3) 0.01))))))) (defn set-zoom [center scale] (ptk/reify ::set-zoom ptk/UpdateEvent (update [_ state] (update state :workspace-local #(impl-update-zoom % center (fn [z] (-> (* z scale) (max 0.01) (min 200)))))))) (def reset-zoom (ptk/reify ::reset-zoom ptk/UpdateEvent (update [_ state] (update state :workspace-local #(impl-update-zoom % nil 1))))) (def zoom-to-fit-all (ptk/reify ::zoom-to-fit-all ptk/UpdateEvent (update [_ state] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) shapes (cp/select-toplevel-shapes objects {:include-frames? true}) srect (gsh/selection-rect shapes)] (if (or (mth/nan? (:width srect)) (mth/nan? (:height srect))) state (update state :workspace-local (fn [{:keys [vport] :as local}] (let [srect (gal/adjust-to-viewport vport srect {:padding 40}) zoom (/ (:width vport) (:width srect))] (-> local (assoc :zoom zoom) (update :vbox merge srect)))))))))) (def zoom-to-selected-shape (ptk/reify ::zoom-to-selected-shape ptk/UpdateEvent (update [_ state] (let [selected (wsh/lookup-selected state)] (if (empty? selected) state (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) srect (->> selected (map #(get objects %)) (gsh/selection-rect))] (update state :workspace-local (fn [{:keys [vport] :as local}] (let [srect (gal/adjust-to-viewport vport srect {:padding 40}) zoom (/ (:width vport) (:width srect))] (-> local (assoc :zoom zoom) (update :vbox merge srect))))))))))) ;; --- Update Shape Attrs (defn update-shape [id attrs] (us/verify ::us/uuid id) (us/verify ::shape-attrs attrs) (ptk/reify ::update-shape ptk/WatchEvent (watch [_ _ _] (rx/of (dch/update-shapes [id] #(merge % attrs)))))) (defn start-rename-shape [id] (us/verify ::us/uuid id) (ptk/reify ::start-rename-shape ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :shape-for-rename] id)))) (defn end-rename-shape [] (ptk/reify ::end-rename-shape ptk/UpdateEvent (update [_ state] (update state :workspace-local dissoc :shape-for-rename)))) ;; --- Update Selected Shapes attrs (defn update-selected-shapes [attrs] (us/verify ::shape-attrs attrs) (ptk/reify ::update-selected-shapes ptk/WatchEvent (watch [_ state _] (let [selected (wsh/lookup-selected state)] (rx/from (map #(update-shape % attrs) selected)))))) ;; --- Delete Selected (def delete-selected "Deselect all and remove all selected shapes." (ptk/reify ::delete-selected ptk/WatchEvent (watch [_ state _] (let [selected (wsh/lookup-selected state)] (rx/of (dwc/delete-shapes selected) (dws/deselect-all)))))) ;; --- Shape Vertical Ordering (s/def ::loc #{:up :down :bottom :top}) (defn vertical-order-selected [loc] (us/verify ::loc loc) (ptk/reify ::vertical-order-selected ptk/WatchEvent (watch [it state _] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) selected (wsh/lookup-selected state) rchanges (mapv (fn [id] (let [obj (get objects id) parent (get objects (:parent-id obj)) shapes (:shapes parent) cindex (d/index-of shapes id) nindex (case loc :top (count shapes) :down (max 0 (- cindex 1)) :up (min (count shapes) (+ (inc cindex) 1)) :bottom 0)] {:type :mov-objects :parent-id (:parent-id obj) :frame-id (:frame-id obj) :page-id page-id :index nindex :shapes [id]})) selected) uchanges (mapv (fn [id] (let [obj (get objects id)] {:type :mov-objects :parent-id (:parent-id obj) :frame-id (:frame-id obj) :page-id page-id :shapes [id] :index (cp/position-on-parent id objects)})) selected)] ;; TODO: maybe missing the :reg-objects event? (rx/of (dch/commit-changes {:redo-changes rchanges :undo-changes uchanges :origin it})))))) ;; --- Change Shape Order (D&D Ordering) (defn relocate-shapes-changes [objects parents parent-id page-id to-index ids groups-to-delete groups-to-unmask shapes-to-detach shapes-to-reroot shapes-to-deroot shapes-to-unconstraint] (let [;; Changes to the shapes that are being move r-mov-change [{:type :mov-objects :parent-id parent-id :page-id page-id :index to-index :shapes (vec (reverse ids))}] u-mov-change (map (fn [id] (let [obj (get objects id)] {:type :mov-objects :parent-id (:parent-id obj) :page-id page-id :index (cp/position-on-parent id objects) :shapes [id]})) (reverse ids)) ;; Changes deleting empty groups r-del-change (map (fn [group-id] {:type :del-obj :page-id page-id :id group-id}) groups-to-delete) u-del-change (d/concat [] ;; Create the groups (map (fn [group-id] (let [group (get objects group-id)] {:type :add-obj :page-id page-id :parent-id parent-id :frame-id (:frame-id group) :id group-id :obj (-> group (assoc :shapes []))})) groups-to-delete) ;; Creates the hierarchy (map (fn [group-id] (let [group (get objects group-id)] {:type :mov-objects :page-id page-id :parent-id (:id group) :shapes (:shapes group)})) groups-to-delete)) ;; Changes removing the masks from the groups without mask shape r-mask-change (map (fn [group-id] {:type :mod-obj :page-id page-id :id group-id :operations [{:type :set :attr :masked-group? :val false}]}) groups-to-unmask) u-mask-change (map (fn [group-id] (let [group (get objects group-id)] {:type :mod-obj :page-id page-id :id group-id :operations [{:type :set :attr :masked-group? :val (:masked-group? group)}]})) groups-to-unmask) ;; Changes to the components metadata detach-keys [:component-id :component-file :component-root? :remote-synced? :shape-ref :touched] r-detach-change (map (fn [id] {:type :mod-obj :page-id page-id :id id :operations (mapv #(hash-map :type :set :attr % :val nil) detach-keys)}) shapes-to-detach) u-detach-change (map (fn [id] (let [obj (get objects id)] {:type :mod-obj :page-id page-id :id id :operations (mapv #(hash-map :type :set :attr % :val (get obj %)) detach-keys)})) shapes-to-detach) r-deroot-change (map (fn [id] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :component-root? :val nil}]}) shapes-to-deroot) u-deroot-change (map (fn [id] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :component-root? :val true}]}) shapes-to-deroot) r-reroot-change (map (fn [id] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :component-root? :val true}]}) shapes-to-reroot) u-reroot-change (map (fn [id] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :component-root? :val nil}]}) shapes-to-reroot) ;; Changes resetting constraints r-unconstraint-change (map (fn [id] (let [obj (get objects id) parent (get objects parent-id) frame-id (if (= (:type parent) :frame) (:id parent) (:frame-id parent))] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :constraints-h :val (spec/default-constraints-h (assoc obj :parent-id parent-id :frame-id frame-id))} {:type :set :attr :constraints-v :val (spec/default-constraints-v (assoc obj :parent-id parent-id :frame-id frame-id))}]})) shapes-to-unconstraint) u-unconstraint-change (map (fn [id] (let [obj (get objects id)] {:type :mod-obj :page-id page-id :id id :operations [{:type :set :attr :constraints-h :val (:constraints-h obj)} {:type :set :attr :constraints-v :val (:constraints-v obj)}]})) shapes-to-unconstraint) r-reg-change [{:type :reg-objects :page-id page-id :shapes (vec parents)}] u-reg-change [{:type :reg-objects :page-id page-id :shapes (vec parents)}] rchanges (d/concat [] r-mov-change r-del-change r-mask-change r-detach-change r-deroot-change r-reroot-change r-unconstraint-change r-reg-change) uchanges (d/concat [] u-del-change u-reroot-change u-deroot-change u-detach-change u-mask-change u-mov-change u-unconstraint-change u-reg-change)] [rchanges uchanges])) (defn relocate-shapes [ids parent-id to-index] (us/verify (s/coll-of ::us/uuid) ids) (us/verify ::us/uuid parent-id) (us/verify number? to-index) (ptk/reify ::relocate-shapes ptk/WatchEvent (watch [it state _] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) ;; Ignore any shape whose parent is also intented to be moved ids (cp/clean-loops objects ids) ;; If we try to move a parent into a child we remove it ids (filter #(not (cp/is-parent? objects parent-id %)) ids) parents (reduce (fn [result id] (conj result (cp/get-parent id objects))) #{parent-id} ids) groups-to-delete (loop [current-id (first parents) to-check (rest parents) removed-id? (set ids) result #{}] (if-not current-id ;; Base case, no next element result (let [group (get objects current-id)] (if (and (not= :frame (:type group)) (not= current-id parent-id) (empty? (remove removed-id? (:shapes group)))) ;; Adds group to the remove and check its parent (let [to-check (d/concat [] to-check [(cp/get-parent current-id objects)]) ] (recur (first to-check) (rest to-check) (conj removed-id? current-id) (conj result current-id))) ;; otherwise recur (recur (first to-check) (rest to-check) removed-id? result))))) groups-to-unmask (reduce (fn [group-ids id] ;; When a masked group loses its mask shape, because it's ;; moved outside the group, the mask condition must be ;; removed, and it must be converted to a normal group. (let [obj (get objects id) parent (get objects (:parent-id obj))] (if (and (:masked-group? parent) (= id (first (:shapes parent))) (not= (:id parent) parent-id)) (conj group-ids (:id parent)) group-ids))) #{} ids) ;; Sets the correct components metadata for the moved shapes ;; `shapes-to-detach` Detach from a component instance a shape that was inside a component and is moved outside ;; `shapes-to-deroot` Removes the root flag from a component instance moved inside another component ;; `shapes-to-reroot` Adds a root flag when a nested component instance is moved outside [shapes-to-detach shapes-to-deroot shapes-to-reroot] (reduce (fn [[shapes-to-detach shapes-to-deroot shapes-to-reroot] id] (let [shape (get objects id) instance-part? (and (:shape-ref shape) (not (:component-id shape))) instance-root? (:component-root? shape) sub-instance? (and (:component-id shape) (not (:component-root? shape))) parent (get objects parent-id) component-shape (cph/get-component-shape shape objects) component-shape-parent (cph/get-component-shape parent objects) detach? (and instance-part? (not= (:id component-shape) (:id component-shape-parent))) deroot? (and instance-root? component-shape-parent) reroot? (and sub-instance? (not component-shape-parent)) ids-to-detach (when detach? (cons id (cph/get-children id objects)))] [(cond-> shapes-to-detach detach? (into ids-to-detach)) (cond-> shapes-to-deroot deroot? (conj id)) (cond-> shapes-to-reroot reroot? (conj id))])) [[] [] []] ids) [rchanges uchanges] (relocate-shapes-changes objects parents parent-id page-id to-index ids groups-to-delete groups-to-unmask shapes-to-detach shapes-to-reroot shapes-to-deroot ids)] (rx/of (dch/commit-changes {:redo-changes rchanges :undo-changes uchanges :origin it}) (dwc/expand-collapse parent-id)))))) (defn relocate-selected-shapes [parent-id to-index] (ptk/reify ::relocate-selected-shapes ptk/WatchEvent (watch [_ state _] (let [selected (wsh/lookup-selected state)] (rx/of (relocate-shapes selected parent-id to-index)))))) (defn start-editing-selected [] (ptk/reify ::start-editing-selected ptk/WatchEvent (watch [_ state _] (let [selected (wsh/lookup-selected state)] (if-not (= 1 (count selected)) (rx/empty) (let [objects (wsh/lookup-page-objects state) {:keys [id type shapes]} (get objects (first selected))] (case type :text (rx/of (dwc/start-edition-mode id)) (:group :bool) (rx/of (dwc/select-shapes (into (d/ordered-set) [(last shapes)]))) :svg-raw nil (rx/of (dwc/start-edition-mode id) (dwdp/start-path-edit id))))))))) ;; --- Change Page Order (D&D Ordering) (defn relocate-page [id index] (ptk/reify ::relocate-pages ptk/WatchEvent (watch [it state _] (let [cidx (-> (get-in state [:workspace-data :pages]) (d/index-of id)) rchg {:type :mov-page :id id :index index} uchg {:type :mov-page :id id :index cidx}] (rx/of (dch/commit-changes {:redo-changes [rchg] :undo-changes [uchg] :origin it})))))) ;; --- Shape / Selection Alignment and Distribution (declare align-object-to-frame) (declare align-objects-list) (defn align-objects [axis] (us/verify ::gal/align-axis axis) (ptk/reify ::align-objects ptk/WatchEvent (watch [_ state _] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) selected (wsh/lookup-selected state) moved (if (= 1 (count selected)) (align-object-to-frame objects (first selected) axis) (align-objects-list objects selected axis)) moved-objects (->> moved (group-by :id)) ids (keys moved-objects) update-fn (fn [shape] (first (get moved-objects (:id shape))))] (rx/of (dch/update-shapes ids update-fn {:reg-objects? true})))))) (defn align-object-to-frame [objects object-id axis] (let [object (get objects object-id) frame (get objects (:frame-id object))] (gal/align-to-rect object frame axis objects))) (defn align-objects-list [objects selected axis] (let [selected-objs (map #(get objects %) selected) rect (gsh/selection-rect selected-objs)] (mapcat #(gal/align-to-rect % rect axis objects) selected-objs))) (defn distribute-objects [axis] (us/verify ::gal/dist-axis axis) (ptk/reify ::distribute-objects ptk/WatchEvent (watch [_ state _] (let [page-id (:current-page-id state) objects (wsh/lookup-page-objects state page-id) selected (wsh/lookup-selected state) moved (-> (map #(get objects %) selected) (gal/distribute-space axis objects)) moved-objects (->> moved (group-by :id)) ids (keys moved-objects) update-fn (fn [shape] (first (get moved-objects (:id shape))))] (rx/of (dch/update-shapes ids update-fn {:reg-objects? true})))))) ;; --- Shape Proportions (defn set-shape-proportion-lock [id lock] (ptk/reify ::set-shape-proportion-lock ptk/WatchEvent (watch [_ _ _] (letfn [(assign-proportions [shape] (if-not lock (assoc shape :proportion-lock false) (-> (assoc shape :proportion-lock true) (gpr/assign-proportions))))] (rx/of (dch/update-shapes [id] assign-proportions)))))) ;; --- Update Shape Flags (defn update-shape-flags [id {:keys [blocked hidden] :as flags}] (s/assert ::us/uuid id) (s/assert ::shape-attrs flags) (ptk/reify ::update-shape-flags ptk/WatchEvent (watch [_ state _] (let [update-fn (fn [obj] (cond-> obj (boolean? blocked) (assoc :blocked blocked) (boolean? hidden) (assoc :hidden hidden))) objects (wsh/lookup-page-objects state) ids (d/concat [id] (cp/get-children id objects))] (rx/of (dch/update-shapes ids update-fn)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Navigation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn navigate-to-project [project-id] (ptk/reify ::navigate-to-project ptk/WatchEvent (watch [_ state _] (let [page-ids (get-in state [:projects project-id :pages]) params {:project project-id :page (first page-ids)}] (rx/of (rt/nav :workspace/page params)))))) (defn go-to-page ([] (ptk/reify ::go-to-page ptk/WatchEvent (watch [_ state _] (let [project-id (:current-project-id state) file-id (:current-file-id state) page-id (get-in state [:workspace-data :pages 0]) pparams {:file-id file-id :project-id project-id} qparams {:page-id page-id}] (rx/of (rt/nav' :workspace pparams qparams)))))) ([page-id] (us/verify ::us/uuid page-id) (ptk/reify ::go-to-page-2 ptk/WatchEvent (watch [_ state _] (let [project-id (:current-project-id state) file-id (:current-file-id state) pparams {:file-id file-id :project-id project-id} qparams {:page-id page-id}] (rx/of (rt/nav :workspace pparams qparams))))))) (defn go-to-layout [layout] (us/verify ::layout-flag layout) (ptk/reify ::set-workspace-layout IDeref (-deref [_] {:layout layout}) ptk/WatchEvent (watch [_ state _] (let [project-id (get-in state [:workspace-project :id]) file-id (get-in state [:workspace-file :id]) page-id (get state :current-page-id) pparams {:file-id file-id :project-id project-id} qparams {:page-id page-id :layout (name layout)}] (rx/of (rt/nav :workspace pparams qparams)))))) (def go-to-file (ptk/reify ::go-to-file ptk/WatchEvent (watch [_ state _] (let [{:keys [id project-id data] :as file} (:workspace-file state) page-id (get-in data [:pages 0]) pparams {:project-id project-id :file-id id} qparams {:page-id page-id}] (rx/of (rt/nav :workspace pparams qparams)))))) (defn go-to-viewer ([] (go-to-viewer {})) ([{:keys [file-id page-id]}] (ptk/reify ::go-to-viewer ptk/WatchEvent (watch [_ state _] (let [{:keys [current-file-id current-page-id]} state pparams {:file-id (or file-id current-file-id)} qparams {:page-id (or page-id current-page-id)}] (rx/of ::dwp/force-persist (rt/nav-new-window* {:rname :viewer :path-params pparams :query-params qparams :name (str "viewer-" (:file-id pparams))}))))))) (defn go-to-dashboard ([] (go-to-dashboard nil)) ([{:keys [team-id]}] (ptk/reify ::go-to-dashboard ptk/WatchEvent (watch [_ state _] (when-let [team-id (or team-id (:current-team-id state))] (rx/of ::dwp/force-persist (rt/nav :dashboard-projects {:team-id team-id}))))))) (defn go-to-dashboard-fonts [] (ptk/reify ::go-to-dashboard-fonts ptk/WatchEvent (watch [_ state _] (let [team-id (:current-team-id state)] (rx/of ::dwp/force-persist (rt/nav :dashboard-fonts {:team-id team-id})))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Context Menu ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (s/def ::point gpt/point?) (defn show-context-menu [{:keys [position shape] :as params}] (us/verify ::point position) (us/verify (s/nilable ::cp/minimal-shape) shape) (ptk/reify ::show-context-menu ptk/UpdateEvent (update [_ state] (let [selected (wsh/lookup-selected state) objects (wsh/lookup-page-objects state) selected-with-children (into [] (mapcat #(cp/get-object-with-children % objects)) selected) head (get objects (first selected)) first-not-group-like? (and (= (count selected) 1) (not (contains? #{:group :bool} (:type head)))) has-invalid-shapes? (->> selected-with-children (some (comp #{:frame :text} :type))) disable-booleans? (or (empty? selected) has-invalid-shapes? first-not-group-like?) disable-flatten? (or (empty? selected) has-invalid-shapes?) mdata (-> params (assoc :disable-booleans? disable-booleans?) (assoc :disable-flatten? disable-flatten?) (cond-> (some? shape) (assoc :selected selected)))] (assoc-in state [:workspace-local :context-menu] mdata))))) (defn show-shape-context-menu [{:keys [position shape] :as params}] (us/verify ::point position) (us/verify ::cp/minimal-shape shape) (ptk/reify ::show-shape-context-menu ptk/WatchEvent (watch [_ state _] (let [selected (wsh/lookup-selected state)] (rx/concat (when-not (selected (:id shape)) (rx/of (dws/select-shape (:id shape)))) (rx/of (show-context-menu params))))))) (def hide-context-menu (ptk/reify ::hide-context-menu ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :context-menu] nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Clipboard ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn copy-selected [] (letfn [;; Sort objects so they have the same relative ordering ;; when pasted later. (sort-selected [state data] (let [selected (:selected data) page-id (:current-page-id state) objects (get-in state [:workspace-data :pages-index page-id :objects])] (->> (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))))))))) ;; Retrieve all ids of selected shapes with corresponding ;; children; this is needed because each shape should be ;; processed one by one because of async events (data url ;; fetching). (collect-object-ids [objects res id] (let [obj (get objects id)] (reduce (partial collect-object-ids objects) (assoc res id obj) (:shapes obj)))) ;; Prepare the shape object. Mainly needed for image shapes ;; for retrieve the image data and convert it to the ;; data-url. (prepare-object [objects selected {:keys [type] :as obj}] (let [obj (maybe-translate obj objects selected)] (if (= type :image) (let [url (cfg/resolve-file-media (:metadata obj))] (->> (http/send! {:method :get :uri url :response-type :blob}) (rx/map :body) (rx/mapcat wapi/read-file-as-data-url) (rx/map #(assoc obj ::data %)) (rx/take 1))) (rx/of obj)))) ;; Collects all the items together and split images into a ;; separated data structure for a more easy paste process. (collect-data [res {:keys [id metadata] :as item}] (let [res (update res :objects assoc id (dissoc item ::data))] (if (= :image (:type item)) (let [img-part {:id (:id metadata) :name (:name item) :file-data (::data item)}] (update res :images conj img-part)) res))) (maybe-translate [shape objects selected] (if (and (not= (:type shape) :frame) (not (contains? selected (:frame-id shape)))) ;; When the parent frame is not selected we change to relative ;; coordinates (let [frame (get objects (:frame-id shape))] (gsh/translate-to-frame shape frame)) shape)) (on-copy-error [error] (js/console.error "Clipboard blocked:" error) (rx/empty))] (ptk/reify ::copy-selected ptk/WatchEvent (watch [_ state _] (let [objects (wsh/lookup-page-objects state) selected (->> (wsh/lookup-selected state) (cp/clean-loops objects)) pdata (reduce (partial collect-object-ids objects) {} selected) initial {:type :copied-shapes :file-id (:current-file-id state) :selected selected :objects {} :images #{}}] (->> (rx/from (seq (vals pdata))) (rx/merge-map (partial prepare-object objects selected)) (rx/reduce collect-data initial) (rx/mapcat (partial sort-selected state)) (rx/map t/encode-str) (rx/map wapi/write-to-clipboard) (rx/catch on-copy-error) (rx/ignore))))))) (declare paste-shape) (declare paste-text) (declare paste-image) (declare paste-svg) (def paste (ptk/reify ::paste ptk/WatchEvent (watch [_ _ _] (try (let [clipboard-str (wapi/read-from-clipboard) paste-transit-str (->> clipboard-str (rx/filter t/transit?) (rx/map t/decode-str) (rx/filter #(= :copied-shapes (:type %))) (rx/map #(select-keys % [:selected :objects])) (rx/map paste-shape)) paste-plain-text-str (->> clipboard-str (rx/filter (comp not empty?)) (rx/map paste-text)) paste-image-str (->> (wapi/read-image-from-clipboard) (rx/map paste-image))] (->> (rx/concat paste-transit-str paste-plain-text-str paste-image-str) (rx/first) (rx/catch (fn [err] (js/console.error "Clipboard error:" err) (rx/empty))))) (catch :default e (let [data (ex-data e)] (if (:not-implemented data) (rx/of (dm/warn (i18n/tr "errors.clipboard-not-implemented"))) (js/console.error "ERROR" e)))))))) (defn paste-from-event [event in-viewport?] (ptk/reify ::paste-from-event ptk/WatchEvent (watch [_ state _] (try (let [objects (wsh/lookup-page-objects state) paste-data (wapi/read-from-paste-event event) image-data (wapi/extract-images paste-data) text-data (wapi/extract-text paste-data) decoded-data (and (t/transit? text-data) (t/decode-str text-data)) edit-id (get-in state [:workspace-local :edition]) is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))] (cond (and (string? text-data) (str/includes? text-data "> (rx/of decoded-data) (rx/filter #(= :copied-shapes (:type %))) (rx/map #(paste-shape % in-viewport?))) ;; Some paste events can be fired while we're editing a text ;; we forbid that scenario so the default behaviour is executed (and (string? text-data) (not is-editing-text?)) (rx/of (paste-text text-data)) :else (rx/empty))) (catch :default err (js/console.error "Clipboard error:" err)))))) (defn selected-frame? [state] (let [selected (wsh/lookup-selected state) objects (wsh/lookup-page-objects state)] (and (= 1 (count selected)) (= :frame (get-in objects [(first selected) :type]))))) (defn- paste-shape [{:keys [selected objects images] :as data} in-viewport?] ;; TODO: perhaps rename 'objects' to 'shapes', because it contains only (letfn [;; Given a file-id and img (part generated by the ;; the shapes to paste, not the whole page tree of shapes ;; copy-selected event), uploads the new media. (upload-media [file-id imgpart] (->> (http/send! {:uri (:file-data imgpart) :response-type :blob :method :get}) (rx/map :body) (rx/map (fn [blob] {:name (:name imgpart) :file-id file-id :content blob :is-local true})) (rx/mapcat #(rp/mutation! :upload-file-media-object %)) (rx/map (fn [media] (assoc media :prev-id (:id imgpart)))))) ;; Analyze the rchange and replace staled media and ;; references to the new uploaded media-objects. (process-rchange [media-idx item] (if (= :image (get-in item [:obj :type])) (update-in item [:obj :metadata] (fn [{:keys [id] :as mdata}] (if-let [mobj (get media-idx id)] (assoc mdata :id (:id mobj) :path (:path mobj)) mdata))) item)) (calculate-paste-position [state mouse-pos in-viewport?] (let [page-objects (wsh/lookup-page-objects state) selected-objs (map #(get objects %) selected) has-frame? (d/seek #(= (:type %) :frame) selected-objs) page-selected (wsh/lookup-selected state) wrapper (gsh/selection-rect selected-objs) orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))] (cond (and (selected-frame? state) (not has-frame?)) (let [frame-id (first page-selected) delta (get page-objects frame-id)] [frame-id frame-id delta]) (empty? page-selected) (let [frame-id (cp/frame-id-by-position page-objects mouse-pos) delta (gpt/subtract mouse-pos orig-pos)] [frame-id frame-id delta]) :else (let [base (cp/get-base-shape page-objects page-selected) index (cp/position-on-parent (:id base) page-objects) frame-id (:frame-id base) parent-id (:parent-id base) delta (if in-viewport? (gpt/subtract mouse-pos orig-pos) (gpt/subtract (gpt/point (:selrect base)) orig-pos))] [frame-id parent-id delta index])))) ;; Change the indexes if the paste is done with an element selected (change-add-obj-index [objects selected index change] (let [set-index (fn [[result index] id] [(assoc result id index) (inc index)]) map-ids (when index (->> (vals objects) (filter #(not (selected (:parent-id %)))) (map :id) (reduce set-index [{} (inc index)]) first))] (if (and (= :add-obj (:type change)) (contains? map-ids (:old-id change))) (assoc change :index (get map-ids (:old-id change))) change))) ;; Check if the shape is an instance whose master is defined in a ;; library that is not linked to the current file (foreign-instance? [shape objects state] (let [root (cph/get-root-shape shape objects) root-file-id (:component-file root)] (and (some? root) (not= root-file-id (:current-file-id state)) (nil? (get-in state [:workspace-libraries root-file-id]))))) ;; Procceed with the standard shape paste procediment. (do-paste [it state mouse-pos media] (let [media-idx (d/index-by :prev-id media) ;; Calculate position for the pasted elements [frame-id parent-id delta index] (calculate-paste-position state mouse-pos in-viewport?) objects (->> objects (d/mapm (fn [_ shape] (-> shape (assoc :frame-id frame-id) (assoc :parent-id parent-id) (cond-> ;; if foreign instance, detach the shape (foreign-instance? shape objects state) (dissoc :component-id :component-file :component-root? :remote-synced? :shape-ref :touched)))))) page-id (:current-page-id state) unames (-> (wsh/lookup-page-objects state page-id) (dwc/retrieve-used-names)) ;; TODO: move this calculation inside prepare-duplcate-changes? rchanges (->> (dws/prepare-duplicate-changes objects page-id unames selected delta) (mapv (partial process-rchange media-idx)) (mapv (partial change-add-obj-index objects selected index))) uchanges (mapv #(array-map :type :del-obj :page-id page-id :id (:id %)) (reverse rchanges)) ;; Adds a reg-objects operation so the groups are updated. We add all the new objects new-objects-ids (->> rchanges (filter #(= (:type %) :add-obj)) (mapv :id)) rchanges (conj rchanges {:type :reg-objects :page-id page-id :shapes new-objects-ids}) selected (->> rchanges (filter #(selected (:old-id %))) (map #(get-in % [:obj :id])) (into (d/ordered-set)))] (rx/of (dch/commit-changes {:redo-changes rchanges :undo-changes uchanges :origin it}) (dwc/select-shapes selected))))] (ptk/reify ::paste-shape ptk/WatchEvent (watch [it state _] (let [file-id (:current-file-id state) mouse-pos (deref ms/mouse-position)] (if (= file-id (:file-id data)) (do-paste it state mouse-pos []) (->> (rx/from images) (rx/merge-map (partial upload-media file-id)) (rx/reduce conj []) (rx/mapcat (partial do-paste it state mouse-pos))))))))) (defn as-content [text] (let [paragraphs (->> (str/lines text) (map str/trim) (mapv #(hash-map :type "paragraph" :children [{:text %}])))] {:type "root" :children [{:type "paragraph-set" :children paragraphs}]})) (defn paste-text [text] (s/assert string? text) (ptk/reify ::paste-text ptk/WatchEvent (watch [_ state _] (let [id (uuid/next) {:keys [x y]} @ms/mouse-position width (max 8 (min (* 7 (count text)) 700)) height 16 page-id (:current-page-id state) frame-id (-> (wsh/lookup-page-objects state page-id) (cp/frame-id-by-position @ms/mouse-position)) shape (gsh/setup-selrect {:id id :type :text :name "Text" :x x :y y :frame-id frame-id :width width :height height :grow-type (if (> (count text) 100) :auto-height :auto-width) :content (as-content text)})] (rx/of (dwu/start-undo-transaction) (dws/deselect-all) (dwc/add-shape shape) (dwu/commit-undo-transaction)))))) (defn- paste-svg [text] (s/assert string? text) (ptk/reify ::paste-svg ptk/WatchEvent (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))))))) (defn- paste-image [image] (ptk/reify ::paste-bin-impl ptk/WatchEvent (watch [_ state _] (let [file-id (get-in state [:workspace-file :id]) params {:file-id file-id :blobs [image] :position @ms/mouse-position}] (rx/of (dwp/upload-media-workspace params)))))) (defn toggle-distances-display [value] (ptk/reify ::toggle-distances-display ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :show-distances?] value)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interactions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (d/export dwi/start-edit-interaction) (d/export dwi/move-edit-interaction) (d/export dwi/finish-edit-interaction) (d/export dwi/start-move-overlay-pos) (d/export dwi/move-overlay-pos) (d/export dwi/finish-move-overlay-pos) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CANVAS OPTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn change-canvas-color [color] (ptk/reify ::change-canvas-color ptk/WatchEvent (watch [it state _] (let [page-id (get state :current-page-id) options (wsh/lookup-page-options state page-id) previus-color (:background options)] (rx/of (dch/commit-changes {:redo-changes [{:type :set-option :page-id page-id :option :background :value (:color color)}] :undo-changes [{:type :set-option :page-id page-id :option :background :value previus-color}] :origin it})))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Transform (d/export dwt/start-resize) (d/export dwt/update-dimensions) (d/export dwt/start-rotate) (d/export dwt/increase-rotation) (d/export dwt/start-move-selected) (d/export dwt/move-selected) (d/export dwt/update-position) (d/export dwt/flip-horizontal-selected) (d/export dwt/flip-vertical-selected) ;; Persistence (d/export dwp/set-file-shared) (d/export dwp/fetch-shared-files) (d/export dwp/link-file-to-library) (d/export dwp/unlink-file-from-library) (d/export dwp/upload-media-asset) (d/export dwp/upload-media-workspace) (d/export dwp/clone-media-object) (d/export dwc/image-uploaded) ;; Selection (d/export dws/select-shape) (d/export dws/deselect-shape) (d/export dws/select-all) (d/export dws/deselect-all) (d/export dwc/select-shapes) (d/export dws/shift-select-shapes) (d/export dws/duplicate-selected) (d/export dws/handle-area-selection) (d/export dws/select-inside-group) (d/export dwd/select-for-drawing) (d/export dwc/clear-edition-mode) (d/export dwc/add-shape) (d/export dwc/start-edition-mode) ;; Groups (d/export dwg/mask-group) (d/export dwg/unmask-group) (d/export dwg/group-selected) (d/export dwg/ungroup-selected) ;; Boolean (d/export dwb/create-bool) (d/export dwb/group-to-bool) (d/export dwb/bool-to-group) (d/export dwb/change-bool-type) ;; Shapes to path (d/export dwps/convert-selected-to-path)