;; 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 (:require [app.common.attrs :as attrs] [app.common.data :as d] [app.common.data.macros :as dm] [app.common.exceptions :as ex] [app.common.features :as cfeat] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.files.variant :as cfv] [app.common.geom.align :as gal] [app.common.geom.point :as gpt] [app.common.geom.proportions :as gpp] [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] [app.common.geom.shapes.grid-layout :as gslg] [app.common.logging :as log] [app.common.logic.libraries :as cll] [app.common.logic.shapes :as cls] [app.common.schema :as sm] [app.common.text :as txt] [app.common.transit :as t] [app.common.types.component :as ctc] [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] [app.common.types.file :as ctf] [app.common.types.page :as ctp] [app.common.types.shape :as cts] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] [app.common.types.shape.text :as types.text] [app.common.types.typography :as ctt] [app.common.uuid :as uuid] [app.config :as cf] [app.main.data.changes :as dch] [app.main.data.comments :as dcmt] [app.main.data.common :as dcm] [app.main.data.event :as ev] [app.main.data.fonts :as df] [app.main.data.helpers :as dsh] [app.main.data.modal :as modal] [app.main.data.notifications :as ntf] [app.main.data.persistence :as-alias dps] [app.main.data.plugins :as dp] [app.main.data.profile :as du] [app.main.data.project :as dpj] [app.main.data.workspace.bool :as dwb] [app.main.data.workspace.collapse :as dwco] [app.main.data.workspace.colors :as dwcl] [app.main.data.workspace.comments :as dwcm] [app.main.data.workspace.common :as dwc] [app.main.data.workspace.drawing :as dwd] [app.main.data.workspace.edition :as dwe] [app.main.data.workspace.fix-broken-shapes :as fbs] [app.main.data.workspace.fix-deleted-fonts :as fdf] [app.main.data.workspace.groups :as dwg] [app.main.data.workspace.guides :as dwgu] [app.main.data.workspace.highlight :as dwh] [app.main.data.workspace.interactions :as dwi] [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.selection :as dws] [app.main.data.workspace.shape-layout :as dwsl] [app.main.data.workspace.shapes :as dwsh] [app.main.data.workspace.texts :as dwtxt] [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.variants :as dwva] [app.main.data.workspace.viewport :as dwv] [app.main.data.workspace.zoom :as dwz] [app.main.errors] [app.main.features :as features] [app.main.features.pointer-map :as fpmap] [app.main.repo :as rp] [app.main.router :as rt] [app.main.streams :as ms] [app.main.worker :as mw] [app.render-wasm :as wasm] [app.render-wasm.api :as api] [app.util.code-gen.style-css :as css] [app.util.dom :as dom] [app.util.globals :as ug] [app.util.http :as http] [app.util.i18n :as i18n :refer [tr]] [app.util.storage :as storage] [app.util.text.content :as tc] [app.util.timers :as tm] [app.util.webapi :as wapi] [beicon.v2.core :as rx] [cljs.spec.alpha :as s] [clojure.set :as set] [cuerdas.core :as str] [potok.v2.core :as ptk] [promesa.core :as p])) (def default-workspace-local {:zoom 1}) (log/set-level! :debug) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace Initialization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare ^:private workspace-initialized) (declare ^:private fetch-libraries) (declare ^:private libraries-fetched) ;; --- Initialize Workspace (defn initialize-workspace-layout [lname] (ptk/reify ::initialize-layout ptk/UpdateEvent (update [_ state] (-> state (update :workspace-layout #(or % layout/default-layout)) (update :workspace-global #(or % layout/default-global)))) ptk/WatchEvent (watch [_ _ _] (if (and lname (contains? layout/presets lname)) (rx/of (layout/ensure-layout lname)) (rx/of (layout/ensure-layout :layers)))))) (defn- datauri->blob-uri [uri] (->> (http/send! {:uri uri :response-type :blob :method :get}) (rx/map :body) (rx/map (fn [blob] (wapi/create-uri blob))))) (defn- get-file-object-thumbnails [file-id] (->> (rp/cmd! :get-file-object-thumbnails {:file-id file-id}) (rx/mapcat (fn [thumbnails] (->> (rx/from thumbnails) (rx/mapcat (fn [[k v]] ;; we only need to fetch the thumbnail if ;; it is a data:uri, otherwise we can just ;; use the value as is. (if (str/starts-with? v "data:") (->> (datauri->blob-uri v) (rx/map (fn [uri] [k uri]))) (rx/of [k v]))))))) (rx/reduce conj {}))) (defn- resolve-file [file] (->> (fpmap/resolve-file file) (rx/map :data) (rx/mapcat (fn [{:keys [pages-index] :as data}] (->> (rx/from (seq pages-index)) (rx/mapcat (fn [[id page]] (let [page (update page :objects ctst/start-page-index)] (->> (mw/ask! {:cmd :index/initialize-page-index :page page}) (rx/map (fn [_] [id page])))))) (rx/reduce conj {}) (rx/map (fn [pages-index] (let [data (assoc data :pages-index pages-index)] (assoc file :data (d/removem (comp t/pointer? val) data)))))))))) (defn- check-libraries-synchronozation [file-id libraries] (ptk/reify ::check-libraries-synchronozation ptk/WatchEvent (watch [_ state _] (let [file (dsh/lookup-file state file-id) ignore-until (get file :ignore-sync-until) needs-check? (some #(and (> (:modified-at %) (:synced-at %)) (or (not ignore-until) (> (:modified-at %) ignore-until))) libraries)] (when needs-check? (->> (rx/of (dwl/notify-sync-file file-id)) (rx/delay 1000))))))) (defn- library-resolved [library] (ptk/reify ::library-resolved ptk/UpdateEvent (update [_ state] (update state :files assoc (:id library) library)))) (defn- libraries-fetched [file-id libraries] (ptk/reify ::libraries-fetched ptk/UpdateEvent (update [_ state] (update state :files merge (->> libraries (map #(assoc % :library-of file-id)) (d/index-by :id)))))) (defn- fetch-libraries [file-id features] (ptk/reify ::fetch-libries ptk/WatchEvent (watch [_ _ _] (->> (rp/cmd! :get-file-libraries {:file-id file-id}) (rx/mapcat (fn [libraries] (rx/concat (rx/of (libraries-fetched file-id libraries)) (rx/merge (->> (rx/from libraries) (rx/merge-map (fn [{:keys [id synced-at]}] (->> (rp/cmd! :get-file {:id id :features features}) (rx/map #(assoc % :synced-at synced-at :library-of file-id))))) (rx/mapcat resolve-file) (rx/map library-resolved)) (->> (rx/from libraries) (rx/map :id) (rx/mapcat (fn [file-id] (rp/cmd! :get-file-object-thumbnails {:file-id file-id :tag "component"}))) (rx/map dwl/library-thumbnails-fetched))) (rx/of (check-libraries-synchronozation file-id libraries))))))))) (defn- workspace-initialized [file-id] (ptk/reify ::workspace-initialized ptk/UpdateEvent (update [_ state] (-> state (assoc :workspace-undo {}) (assoc :workspace-ready file-id))) ptk/WatchEvent (watch [_ _ _] (rx/of (dp/check-open-plugin) (fdf/fix-deleted-fonts) (fbs/fix-broken-shapes))))) (defn- bundle-fetched [{:keys [file file-id thumbnails] :as bundle}] (ptk/reify ::bundle-fetched IDeref (-deref [_] bundle) ptk/UpdateEvent (update [_ state] (-> state (assoc :thumbnails thumbnails) (update :files assoc file-id file))))) (defn zoom-to-frame [] (ptk/reify ::zoom-to-frame ptk/WatchEvent (watch [_ state _] (let [params (rt/get-params state) board-id (get params :board-id) board-id (cond (vector? board-id) board-id (string? board-id) [board-id]) frames-id (->> board-id (map uuid/uuid) (into (d/ordered-set)))] (rx/of (dws/select-shapes frames-id) dwz/zoom-to-selected-shape))))) (defn- select-frame-tool [file-id page-id] (ptk/reify ::select-frame-tool ptk/WatchEvent (watch [_ state _] (let [page (dsh/lookup-page state file-id page-id)] (when (ctp/is-empty? page) (rx/of (dwd/select-for-drawing :frame))))))) (defn- fetch-bundle "Multi-stage file bundle fetch coordinator" [file-id features] (ptk/reify ::fetch-bundle ptk/WatchEvent (watch [_ _ stream] (let [stopper-s (rx/filter (ptk/type? ::finalize-workspace) stream)] (->> (rx/zip (rp/cmd! :get-file {:id file-id :features features}) (get-file-object-thumbnails file-id)) (rx/take 1) (rx/mapcat (fn [[file thumbnails]] (->> (resolve-file file) (rx/map (fn [file] {:file file :file-id file-id :features features :thumbnails thumbnails}))))) (rx/map bundle-fetched) (rx/take-until stopper-s)))))) (defn initialize-workspace [team-id file-id] (assert (uuid? team-id) "expected valud uuid for `team-id`") (assert (uuid? file-id) "expected valud uuid for `file-id`") (ptk/reify ::initialize-workspace ptk/UpdateEvent (update [_ state] (-> state (assoc :recent-colors (:recent-colors storage/user)) (assoc :recent-fonts (:recent-fonts storage/user)) (assoc :current-file-id file-id) (assoc :workspace-presence {}))) ptk/WatchEvent (watch [_ state stream] (let [stoper-s (rx/filter (ptk/type? ::finalize-workspace) stream) rparams (rt/get-params state) features (features/get-enabled-features state team-id) render-wasm? (contains? features "render-wasm/v1")] (log/debug :hint "initialize-workspace" :team-id (dm/str team-id) :file-id (dm/str file-id)) (->> (rx/merge (rx/concat ;; Fetch all essential data that should be loaded before the file (rx/merge (if ^boolean render-wasm? (->> (rx/from @wasm/module) (rx/ignore)) (rx/empty)) (->> stream (rx/filter (ptk/type? ::df/fonts-loaded)) (rx/take 1) (rx/ignore)) (rx/of (ntf/hide) (dcmt/retrieve-comment-threads file-id) (dcmt/fetch-profiles) (df/fetch-fonts team-id))) ;; Once the essential data is fetched, lets proceed to ;; fetch teh file bunldle (rx/of (fetch-bundle file-id features))) (->> stream (rx/filter (ptk/type? ::bundle-fetched)) (rx/take 1) (rx/map deref) (rx/mapcat (fn [{:keys [file]}] (rx/of (dpj/initialize-project (:project-id file)) (dwn/initialize team-id file-id) (dwsl/initialize-shape-layout) (fetch-libraries file-id features) (-> (workspace-initialized file-id) (with-meta {:team-id team-id :file-id file-id})))))) (->> stream (rx/filter (ptk/type? ::dps/persistence-notification)) (rx/take 1) (rx/map dwc/set-workspace-visited)) (when-let [component-id (some-> rparams :component-id uuid/parse)] (->> stream (rx/filter (ptk/type? ::workspace-initialized)) (rx/observe-on :async) (rx/take 1) (rx/map #(dwl/go-to-local-component :id component-id)))) (when (:board-id rparams) (->> stream (rx/filter (ptk/type? ::dwv/initialize-viewport)) (rx/take 1) (rx/map zoom-to-frame))) (when-let [comment-id (some-> rparams :comment-id uuid/parse)] (->> stream (rx/filter (ptk/type? ::workspace-initialized)) (rx/observe-on :async) (rx/take 1) (rx/map #(dwcm/navigate-to-comment-id comment-id)))) (->> stream (rx/filter dch/commit?) (rx/map deref) (rx/mapcat (fn [{:keys [save-undo? undo-changes redo-changes undo-group tags stack-undo?]}] (when render-wasm? (let [added (->> redo-changes (filter #(= (:type %) :add-obj)) (map :obj))] (doseq [shape added] (api/process-object shape)))) (if (and save-undo? (seq undo-changes)) (let [entry {:undo-changes undo-changes :redo-changes redo-changes :undo-group undo-group :tags tags}] (rx/of (dwu/append-undo entry stack-undo?))) (rx/empty)))))) (rx/take-until stoper-s)))) ptk/EffectEvent (effect [_ _ _] (let [name (dm/str "workspace-" file-id)] (unchecked-set ug/global "name" name))))) (defn finalize-workspace [_team-id file-id] (ptk/reify ::finalize-workspace ptk/UpdateEvent (update [_ state] (-> state ;; FIXME: revisit (dissoc :current-file-id :workspace-editor-state :workspace-media-objects :workspace-persistence :workspace-presence :workspace-tokens :workspace-undo) (update :workspace-global dissoc :read-only?) (assoc-in [:workspace-global :options-mode] :design) (update :files d/update-vals #(dissoc % :data)))) ptk/WatchEvent (watch [_ state _] (let [project-id (:current-project-id state)] (rx/of (dwn/finalize file-id) (dpj/finalize-project project-id) (dwsl/finalize-shape-layout) (dwcl/stop-picker) (dwc/set-workspace-visited) (modal/hide) (ntf/hide)))))) (defn- reload-current-file [] (ptk/reify ::reload-current-file ptk/WatchEvent (watch [_ state _] (let [file-id (:current-file-id state) team-id (:current-team-id state)] (rx/of (initialize-workspace team-id file-id)))))) ;; Make this event callable through dynamic resolution (defmethod ptk/resolve ::reload-current-file [_ _] (reload-current-file)) (def ^:private xf:collect-file-media "Resolve and collect all file media on page objects" (comp (map second) (keep (fn [{:keys [metadata fill-image]}] (cond (some? metadata) (cf/resolve-file-media metadata) (some? fill-image) (cf/resolve-file-media fill-image)))))) (defn- initialize-page* "Second phase of page initialization, once we know the page is available on the sate" [file-id page-id page] (ptk/reify ::initialize-page* ptk/UpdateEvent (update [_ state] ;; selection; when user abandon the current page, the selection is lost (let [local (dm/get-in state [:workspace-cache [file-id page-id]] default-workspace-local)] (-> state (assoc :current-page-id page-id) (assoc :workspace-local (assoc local :selected (d/ordered-set))) (assoc :workspace-trimmed-page (dm/select-keys page [:id :name])) ;; FIXME: this should be done on `initialize-layout` (?) (update :workspace-layout layout/load-layout-flags) (update :workspace-global layout/load-layout-state)))) ptk/EffectEvent (effect [_ _ _] (let [uris (into #{} xf:collect-file-media (:objects page))] (->> (rx/from uris) (rx/subs! #(http/fetch-data-uri % false))))))) (defn initialize-page [file-id page-id] (assert (uuid? file-id) "expected valid uuid for `file-id`") (assert (uuid? page-id) "expected valid uuid for `page-id`") (ptk/reify ::initialize-page ptk/WatchEvent (watch [_ state _] (if-let [page (dsh/lookup-page state file-id page-id)] (rx/concat (rx/of (initialize-page* file-id page-id page) (dwth/watch-state-changes file-id page-id) (dwl/watch-component-changes)) (let [profile (:profile state) props (get profile :props)] (when (not (:workspace-visited props)) (rx/of (select-frame-tool file-id page-id))))) ;; NOTE: this redirect is necessary for cases where user ;; explicitly passes an non-existing page-id on the url ;; params, so on check it we can detect that there are no data ;; for the page and redirect user to an existing page (rx/of (dcm/go-to-workspace :file-id file-id ::rt/replace true)))))) (defn finalize-page [file-id page-id] (assert (uuid? file-id) "expected valid uuid for `file-id`") (assert (uuid? page-id) "expected valid uuid for `page-id`") (ptk/reify ::finalize-page ptk/UpdateEvent (update [_ state] (let [local (-> (:workspace-local state) (dissoc :edition :edit-path :selected)) exit? (not= :workspace (rt/lookup-name state)) state (-> state (update :workspace-cache assoc [file-id page-id] local) (dissoc :current-page-id :workspace-local :workspace-trimmed-page :workspace-focus-selected))] (cond-> state exit? (dissoc :workspace-drawing)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace Page CRUD ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn create-page [{:keys [page-id file-id]}] (let [id (or page-id (uuid/next))] (ptk/reify ::create-page ev/Event (-data [_] {:id id :file-id file-id}) ptk/WatchEvent (watch [it state _] (let [pages (-> (dsh/lookup-file-data state) (get :pages-index)) unames (cfh/get-used-names pages) name (cfh/generate-unique-name "Page" unames :immediate-suffix? true) changes (-> (pcb/empty-changes it) (pcb/add-empty-page id name))] (rx/of (dch/commit-changes changes))))))) (defn duplicate-page [page-id] (ptk/reify ::duplicate-page ptk/WatchEvent (watch [it state _] (let [id (uuid/next) fdata (dsh/lookup-file-data state) pages (get fdata :pages-index) page (get pages page-id) unames (cfh/get-used-names pages) suffix-fn (fn [copy-count] (str/concat " " (tr "dashboard.copy-suffix") (when (> copy-count 1) (str " " copy-count)))) base-name (:name page) name (cfh/generate-unique-name base-name unames :suffix-fn suffix-fn) objects (update-vals (:objects page) #(dissoc % :use-for-thumbnail)) main-instances-ids (set (keep #(when (ctc/main-instance? (val %)) (key %)) objects)) ids-to-remove (set (apply concat (map #(cfh/get-children-ids objects %) main-instances-ids))) add-component-copy (fn [objs id shape] (let [component (ctkl/get-component fdata (:component-id shape)) [new-shape new-shapes] (ctn/make-component-instance page component fdata (gpt/point (:x shape) (:y shape)) {:keep-ids? true :force-frame-id (:frame-id shape)}) children (into {} (map (fn [shape] [(:id shape) shape]) new-shapes)) objs (assoc objs id new-shape)] (merge objs children))) objects (reduce (fn [objs [id shape]] (cond (contains? main-instances-ids id) (add-component-copy objs id shape) (contains? ids-to-remove id) objs :else (assoc objs id shape))) {} objects) page (-> page (assoc :name name) (assoc :id id) (assoc :objects objects)) changes (-> (pcb/empty-changes it) (pcb/add-page id page))] (rx/of (dch/commit-changes changes)))))) (s/def ::rename-page (s/keys :req-un [::id ::name])) (defn rename-page [id name] (dm/assert! (uuid? id)) (dm/assert! (string? name)) (ptk/reify ::rename-page ptk/WatchEvent (watch [it state _] (let [page (dsh/lookup-page state id) changes (-> (pcb/empty-changes it) (pcb/mod-page page {:name name}))] (rx/of (dch/commit-changes changes)))))) (defn set-plugin-data ([file-id type namespace key value] (set-plugin-data file-id type nil nil namespace key value)) ([file-id type id namespace key value] (set-plugin-data file-id type id nil namespace key value)) ([file-id type id page-id namespace key value] (dm/assert! (contains? #{:file :page :shape :color :typography :component} type)) (dm/assert! (or (nil? id) (uuid? id))) (dm/assert! (or (nil? page-id) (uuid? page-id))) (dm/assert! (uuid? file-id)) (dm/assert! (keyword? namespace)) (dm/assert! (string? key)) (dm/assert! (or (nil? value) (string? value))) (ptk/reify ::set-file-plugin-data ptk/WatchEvent (watch [it state _] (let [file-data (dm/get-in state [:files file-id :data]) changes (-> (pcb/empty-changes it) (pcb/with-file-data file-data) (assoc :file-id file-id) (pcb/set-plugin-data type id page-id namespace key value))] (rx/of (dch/commit-changes changes))))))) (declare purge-page) (defn- delete-page-components [changes page] (let [components-to-delete (->> page :objects vals (filter #(true? (:main-instance %))) (map :component-id)) changes (reduce (fn [changes component-id] (pcb/delete-component changes component-id (:id page))) changes components-to-delete)] changes)) (defn delete-page [id] (ptk/reify ::delete-page ptk/WatchEvent (watch [it state _] (let [file-id (:current-file-id state) fdata (dsh/lookup-file-data state file-id) pindex (:pages-index fdata) pages (:pages fdata) index (d/index-of pages id) page (get pindex id) page (assoc page :index index) pages (filter #(not= % id) pages) changes (-> (pcb/empty-changes it) (pcb/with-library-data fdata) (delete-page-components page) (pcb/del-page page))] (rx/of (dch/commit-changes changes) (when (= id (:current-page-id state)) (dcm/go-to-workspace {:page-id (first pages)}))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; WORKSPACE File Actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FIXME: move to common (defn rename-file [id name] {:pre [(uuid? id) (string? name)]} (let [name (dm/truncate name 200)] (ptk/reify ::rename-file IDeref (-deref [_] {::ev/origin "workspace" :id id :name name}) ptk/UpdateEvent (update [_ state] (let [file-id (:current-file-id state)] (assoc-in state [:files file-id :name] name))) ptk/WatchEvent (watch [_ _ _] (let [params {:id id :name name}] (->> (rp/cmd! :rename-file params) (rx/ignore))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Workspace State Manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; --- Layout Flags (dm/export layout/toggle-layout-flag) (dm/export layout/remove-layout-flag) ;; --- Profile (defn update-nudge [{:keys [big small] :as params}] (ptk/reify ::update-nudge IDeref (-deref [_] (d/without-nils params)) ptk/UpdateEvent (update [_ state] (update-in state [:profile :props :nudge] (fn [nudge] (cond-> nudge (number? big) (assoc :big big) (number? small) (assoc :small small))))) ptk/WatchEvent (watch [_ state _] (let [nudge (get-in state [:profile :props :nudge])] (rx/of (du/update-profile-props {:nudge nudge})))))) ;; --- Set element options mode (dm/export layout/set-options-mode) ;; --- Tooltip (defn assign-cursor-tooltip [content] (ptk/reify ::assign-cursor-tooltip ptk/UpdateEvent (update [_ state] (if (string? content) (assoc-in state [:workspace-global :tooltip] content) (assoc-in state [:workspace-global :tooltip] nil))))) ;; --- Update Shape Attrs ;; FIXME: rename to update-shape-generic-attrs because on the end we ;; only allow here to update generic attrs (defn update-shape [id attrs] (assert (uuid? id) "expected valid uuid for `id`") (let [attrs (cts/check-shape-generic-attrs attrs)] (ptk/reify ::update-shape ptk/WatchEvent (watch [_ _ _] (rx/of (dwsh/update-shapes [id] #(merge % attrs))))))) (defn start-rename-shape "Start shape renaming process" [id] (dm/assert! (uuid? id)) (ptk/reify ::start-rename-shape ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :shape-for-rename] id)))) (defn end-rename-shape "End the ongoing shape rename process" ([] (end-rename-shape nil nil)) ([shape-id name] (ptk/reify ::end-rename-shape ptk/UpdateEvent (update [_ state] ;; Remove rename state from workspace local state (update state :workspace-local dissoc :shape-for-rename)) ptk/WatchEvent (watch [_ state _] (when-let [shape-id (d/nilv shape-id (dm/get-in state [:workspace-local :shape-for-rename]))] (let [shape (dsh/lookup-shape state shape-id) name (str/trim name) clean-name (cfh/clean-path name) valid? (and (not (str/ends-with? name "/")) (string? clean-name) (not (str/blank? clean-name))) component-id (:component-id shape) undo-id (js/Symbol)] (when valid? (if (ctc/is-variant-container? shape) ;; Rename the full variant when it is a variant container (rx/of (dwva/rename-variant shape-id clean-name)) (rx/of (dwu/start-undo-transaction undo-id) ;; Rename the shape if string is not empty/blank (update-shape shape-id {:name clean-name}) ;; Update the component in case shape is a main instance (when (and (some? component-id) (ctc/main-instance? shape)) (dwl/rename-component component-id clean-name)) (dwu/commit-undo-transaction undo-id)))))))))) ;; --- Update Selected Shapes attrs (defn update-selected-shapes [attrs] (ptk/reify ::update-selected-shapes ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state)] (rx/from (map #(update-shape % attrs) selected)))))) ;; --- Delete Selected (defn delete-selected "Deselect all and remove all selected shapes." [] (ptk/reify ::delete-selected ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state) hover-guides (get-in state [:workspace-guides :hover])] (cond (d/not-empty? selected) (rx/of (dwsh/delete-shapes selected) (dws/deselect-all)) (d/not-empty? hover-guides) (rx/of (dwgu/remove-guides hover-guides))))))) ;; --- Start renaming selected shape (defn start-rename-selected "Rename selected shape." [] (ptk/reify ::start-rename-selected ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state) id (first selected)] (when (= (count selected) 1) (rx/of (dcm/go-to-workspace :layout :layers) (start-rename-shape id))))))) ;; --- Shape Vertical Ordering (def valid-vertical-locations #{:up :down :bottom :top}) (defn vertical-order-selected [loc] (dm/assert! "expected valid location" (contains? valid-vertical-locations loc)) (ptk/reify ::vertical-order-selected ptk/WatchEvent (watch [it state _] (let [page-id (:current-page-id state) objects (dsh/lookup-page-objects state page-id) selected-ids (dsh/lookup-selected state) selected-shapes (map (d/getf objects) selected-ids) undo-id (js/Symbol) move-shape (fn [changes shape] (let [parent (get objects (:parent-id shape)) sibling-ids (:shapes parent) current-index (d/index-of sibling-ids (:id shape)) index-in-selection (d/index-of selected-ids (:id shape)) new-index (case loc :top (count sibling-ids) :down (max 0 (- current-index 1)) :up (min (count sibling-ids) (+ (inc current-index) 1)) :bottom index-in-selection)] (pcb/change-parent changes (:id parent) [shape] new-index))) changes (reduce move-shape (-> (pcb/empty-changes it page-id) (pcb/with-objects objects)) selected-shapes)] (rx/of (dwu/start-undo-transaction undo-id) (dch/commit-changes changes) (ptk/data-event :layout/update {:ids selected-ids}) (dwu/commit-undo-transaction undo-id)))))) ;; --- Change Shape Order (D&D Ordering) (defn relocate-shapes [ids parent-id to-index & [ignore-parents?]] (dm/assert! (every? uuid? ids)) (dm/assert! (set? ids)) (dm/assert! (uuid? parent-id)) (dm/assert! (number? to-index)) (ptk/reify ::relocate-shapes ptk/WatchEvent (watch [it state _] (let [page-id (:current-page-id state) objects (dsh/lookup-page-objects state page-id) data (dsh/lookup-file-data state) ;; Ignore any shape whose parent is also intended to be moved ids (cfh/clean-loops objects ids) ;; If we try to move a parent into a child we remove it ids (filter #(not (cfh/is-parent? objects parent-id %)) ids) all-parents (into #{parent-id} (map #(cfh/get-parent-id objects %)) ids) changes (-> (pcb/empty-changes it) (pcb/with-page-id page-id) (pcb/with-objects objects) (pcb/with-library-data data) (cls/generate-relocate parent-id to-index ids :ignore-parents? ignore-parents?)) undo-id (js/Symbol)] (rx/of (dwu/start-undo-transaction undo-id) (dch/commit-changes changes) (dwco/expand-collapse parent-id) (ptk/data-event :layout/update {:ids (concat all-parents ids)}) (dwu/commit-undo-transaction undo-id)))))) (defn relocate-selected-shapes [parent-id to-index] (ptk/reify ::relocate-selected-shapes ptk/WatchEvent (watch [_ state _] (let [selected (dsh/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 (dsh/lookup-selected state) objects (dsh/lookup-page-objects state)] (condp = (count selected) 0 (rx/empty) 1 (let [{:keys [id type] :as shape} (get objects (first selected))] (case type :text (rx/of (dwe/start-edition-mode id)) (:group :bool :frame) (let [shapes-ids (into (d/ordered-set) (get shape :shapes))] (rx/of (dws/select-shapes shapes-ids))) :svg-raw nil (rx/of (dwe/start-edition-mode id) (dwdp/start-path-edit id)))) ;; When we have multiple shapes selected, instead of enter ;; on the edition mode, we proceed to select all children of ;; the selected shapes. Because we can't enter on edition ;; mode on multiple shapes and this is a fallback operation. (let [shapes-to-select (->> selected (reduce (fn [result shape-id] (let [children (dm/get-in objects [shape-id :shapes])] (if (empty? children) (conj result shape-id) (into result children)))) (d/ordered-set)))] (rx/of (dws/select-shapes shapes-to-select)))))))) (defn select-parent-layer [] (ptk/reify ::select-parent-layer ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state) objects (dsh/lookup-page-objects state) shapes-to-select (->> selected (reduce (fn [result shape-id] (let [parent-id (dm/get-in objects [shape-id :parent-id])] (if (and (some? parent-id) (not= parent-id uuid/zero)) (conj result parent-id) (conj result shape-id)))) (d/ordered-set)))] (rx/of (dws/select-shapes shapes-to-select)))))) ;; --- Change Page Order (D&D Ordering) (defn relocate-page [id index] (ptk/reify ::relocate-page ptk/WatchEvent (watch [it state _] (let [prev-index (-> (dsh/lookup-file-data state) (get :pages) (d/index-of id)) changes (-> (pcb/empty-changes it) (pcb/move-page id index prev-index))] (rx/of (dch/commit-changes changes)))))) ;; --- Shape / Selection Alignment and Distribution (defn can-align? [selected objects] (cond (empty? selected) false (> (count selected) 1) true :else (not= uuid/zero (:parent-id (get objects (first selected)))))) (defn align-object-to-parent [objects object-id axis] (let [object (get objects object-id) parent-id (:parent-id (get objects object-id)) parent (get objects parent-id)] [(gal/align-to-parent object parent axis)])) (defn align-objects-list [objects selected axis] (let [selected-objs (map #(get objects %) selected) rect (gsh/shapes->rect selected-objs)] (map #(gal/align-to-rect % rect axis) selected-objs))) (defn align-objects ([axis] (align-objects axis nil)) ([axis selected] (dm/assert! "expected valid align axis value" (contains? gal/valid-align-axis axis)) (ptk/reify ::align-objects ptk/WatchEvent (watch [_ state _] (let [objects (dsh/lookup-page-objects state) selected (or selected (dsh/lookup-selected state)) moved (if (= 1 (count selected)) (align-object-to-parent objects (first selected) axis) (align-objects-list objects selected axis)) undo-id (js/Symbol)] (when (can-align? selected objects) (rx/of (dwu/start-undo-transaction undo-id) (dwt/position-shapes moved) (ptk/data-event :layout/update {:ids selected}) (dwu/commit-undo-transaction undo-id)))))))) (defn can-distribute? [selected] (cond (empty? selected) false (< (count selected) 3) false :else true)) (defn distribute-objects ([axis] (distribute-objects axis nil)) ([axis ids] (dm/assert! "expected valid distribute axis value" (contains? gal/valid-dist-axis axis)) (ptk/reify ::distribute-objects ptk/WatchEvent (watch [_ state _] (let [page-id (:current-page-id state) objects (dsh/lookup-page-objects state page-id) selected (or ids (dsh/lookup-selected state)) moved (-> (map #(get objects %) selected) (gal/distribute-space axis)) undo-id (js/Symbol)] (when (can-distribute? selected) (rx/of (dwu/start-undo-transaction undo-id) (dwt/position-shapes moved) (ptk/data-event :layout/update {:ids selected}) (dwu/commit-undo-transaction undo-id)))))))) ;; --- 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) (gpp/assign-proportions))))] (rx/of (dwsh/update-shapes [id] assign-proportions)))))) (defn toggle-proportion-lock [] (ptk/reify ::toggle-proportion-lock ptk/WatchEvent (watch [_ state _] (let [page-id (:current-page-id state) objects (dsh/lookup-page-objects state page-id) selected (dsh/lookup-selected state) selected-obj (-> (map #(get objects %) selected)) multi (attrs/get-attrs-multi selected-obj [:proportion-lock]) multi? (= :multiple (:proportion-lock multi))] (if multi? (rx/of (dwsh/update-shapes selected #(assoc % :proportion-lock true))) (rx/of (dwsh/update-shapes selected #(update % :proportion-lock not)))))))) (defn workspace-focus-lost [] (ptk/reify ::workspace-focus-lost ptk/UpdateEvent (update [_ state] ;; FIXME: remove the `?` from show-distances? (assoc-in state [:workspace-global :show-distances?] false)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Navigation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn set-assets-section-open [file-id section open?] (ptk/reify ::set-assets-section-open ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-assets :open-status file-id section] open?)))) (defn clear-assets-section-open [] (ptk/reify ::clear-assets-section-open ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-assets :open-status] {})))) (defn set-assets-group-open [file-id section path open?] (ptk/reify ::set-assets-group-open ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-assets :open-status file-id :groups section path] open?)))) (defn- check-in-asset [items element] (let [items (or items #{})] (if (contains? items element) (disj items element) (conj items element)))) (defn toggle-selected-assets [file-id asset-id type] (ptk/reify ::toggle-selected-assets ptk/UpdateEvent (update [_ state] (update-in state [:workspace-assets :selected file-id type] check-in-asset asset-id)))) (defn select-single-asset [file-id asset-id type] (ptk/reify ::select-single-asset ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-assets :selected file-id type] #{asset-id})))) (defn select-assets [file-id assets-ids type] (ptk/reify ::select-assets ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-assets :selected file-id type] (into #{} assets-ids))))) (defn unselect-all-assets ([] (unselect-all-assets nil)) ([file-id] (ptk/reify ::unselect-all-assets ptk/UpdateEvent (update [_ state] (if file-id (update-in state [:workspace-assets :selected] dissoc file-id) (update state :workspace-assets dissoc :selected)))))) (defn show-component-in-assets [component-id] (ptk/reify ::show-component-in-assets ptk/WatchEvent (watch [_ state _] (let [file-id (:current-file-id state) fdata (dsh/lookup-file-data state file-id) component (cfv/get-primary-component fdata component-id) cpath (:path component) cpath (cfh/split-path cpath) paths (map (fn [i] (cfh/join-path (take (inc i) cpath))) (range (count cpath)))] (rx/concat (rx/from (map #(set-assets-group-open file-id :components % true) paths)) (rx/of (dcm/go-to-workspace :layout :assets) (set-assets-section-open file-id :library true) (set-assets-section-open file-id :components true) (select-single-asset file-id (:id component) :components))))) ptk/EffectEvent (effect [_ state _] (let [file-id (:current-file-id state) fdata (dsh/lookup-file-data state file-id) component (cfv/get-primary-component fdata component-id) wrapper-id (str "component-shape-id-" (:id component))] (tm/schedule-on-idle #(dom/scroll-into-view-if-needed! (dom/get-element wrapper-id))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Context Menu ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn show-context-menu [{:keys [position] :as params}] (dm/assert! (gpt/point? position)) (ptk/reify ::show-context-menu ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :context-menu] params)))) (defn show-shape-context-menu [{:keys [shape] :as params}] (ptk/reify ::show-shape-context-menu ptk/WatchEvent (watch [_ state _] (let [selected (dsh/lookup-selected state) objects (dsh/lookup-page-objects state) all-selected (into [] (mapcat #(cfh/get-children-with-self objects %)) selected) head (get objects (first selected)) not-group-like? (and (= (count selected) 1) (not (contains? #{:group :bool} (:type head)))) no-bool-shapes? (->> all-selected (some (comp #{:frame :text} :type)))] (if (and (some? shape) (not (contains? selected (:id shape)))) (rx/concat (rx/of (dws/select-shape (:id shape))) (rx/of (show-shape-context-menu params))) (rx/of (show-context-menu (-> params (assoc :kind :shape :disable-booleans? (or no-bool-shapes? not-group-like?) :disable-flatten? no-bool-shapes? :selected (conj selected (:id shape))))))))))) (defn show-page-item-context-menu [{:keys [position page] :as params}] (dm/assert! (gpt/point? position)) (ptk/reify ::show-page-item-context-menu ptk/WatchEvent (watch [_ _ _] (rx/of (show-context-menu (-> params (assoc :kind :page :selected (:id page)))))))) (defn show-track-context-menu [{:keys [grid-id type index] :as params}] (ptk/reify ::show-track-context-menu ptk/WatchEvent (watch [_ _ _] (rx/of (show-context-menu (-> params (assoc :kind :grid-track :grid-id grid-id :type type :index index))))))) (defn show-grid-cell-context-menu [{:keys [grid-id] :as params}] (ptk/reify ::show-grid-cell-context-menu ptk/WatchEvent (watch [_ state _] (let [objects (dsh/lookup-page-objects state) grid (get objects grid-id) cells (->> (get-in state [:workspace-grid-edition grid-id :selected]) (map #(get-in grid [:layout-grid-cells %])))] (rx/of (show-context-menu (-> params (assoc :kind :grid-cells :grid grid :cells cells)))))))) (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-selected [state data] (let [selected (dsh/lookup-selected state) objects (dsh/lookup-page-objects state) ;; Narrow the objects map so it contains only relevant data for ;; selected and its parents objects (cfh/selected-subtree objects selected) selected (->> (ctst/sort-z-index objects selected) (reverse) (into (d/ordered-set)))] (assoc data :selected selected))) (fetch-image [entry] (let [url (cf/resolve-file-media entry)] (->> (http/send! {:method :get :uri url :response-type :blob}) (rx/map :body) (rx/mapcat wapi/read-file-as-data-url) (rx/map #(assoc entry :data %))))) ;; Prepare the shape object. Mainly needed for image shapes ;; for retrieve the image data and convert it to the ;; data-url. (prepare-object [objects parent-frame-id obj] (let [obj (maybe-translate obj objects parent-frame-id) ;; Texts can have different fills for pieces of the text imgdata (concat (->> (or (:position-data obj) [obj]) (mapcat :fills) (keep :fill-image)) (->> (:strokes obj) (keep :stroke-image)) (when (cfh/image-shape? obj) [(:metadata obj)]) (when (:fill-image obj) [(:fill-image obj)]))] (if (seq imgdata) (->> (rx/from imgdata) (rx/mapcat fetch-image) (rx/reduce conj []) (rx/map (fn [images] (assoc obj ::images images)))) (rx/of obj)))) (collect-variants [state shape] (let [page-id (:current-page-id state) data (dsh/lookup-file-data state) objects (-> (dsh/get-page data page-id) (get :objects)) components (cfv/find-variant-components data objects (:id shape))] (into {} (map (juxt :id :variant-properties) components)))) ;; Collects all the items together and split images into a ;; separated data structure for a more easy paste process. ;; Also collects the variant properties of the copied variants (collect-data [state result {:keys [id ::images] :as item}] (cond-> result :always (update :objects assoc id (dissoc item ::images)) (some? images) (update :images into images) (ctc/is-variant-container? item) (update :variant-properties merge (collect-variants state item)))) (maybe-translate [shape objects parent-frame-id] (if (= parent-frame-id uuid/zero) shape (let [frame (get objects parent-frame-id)] (gsh/translate-to-frame shape frame)))) ;; When copying an instance that is nested inside another one, we need to ;; advance the shape refs to one or more levels of remote mains. (advance-copies [state selected data] (let [file (dsh/lookup-file state) libraries (:files state) ;; FIXME page (dsh/lookup-page state) heads (mapcat #(ctn/get-child-heads (:objects data) %) selected)] (update data :objects #(reduce (partial advance-copy file libraries page) % heads)))) (advance-copy [file libraries page objects shape] (if (and (ctc/instance-head? shape) (not (ctc/main-instance? shape))) (let [level-delta (ctn/get-nesting-level-delta (:objects page) shape uuid/zero)] (if (pos? level-delta) (reduce (partial advance-shape file libraries page level-delta) objects (cfh/get-children-with-self objects (:id shape))) objects)) objects)) (advance-shape [file libraries page level-delta objects shape] (let [new-shape-ref (ctf/advance-shape-ref file page libraries shape level-delta {:include-deleted? true})] (cond-> objects (and (some? new-shape-ref) (not= new-shape-ref (:shape-ref shape))) (assoc-in [(:id shape) :shape-ref] new-shape-ref)))) (on-copy-error [error] (js/console.error "clipboard blocked:" error) (rx/empty))] (ptk/reify ::copy-selected ptk/WatchEvent (watch [_ state _] (let [text (wapi/get-current-selected-text)] (if-not (str/empty? text) (try (wapi/write-to-clipboard text) (catch :default e (on-copy-error e))) (let [objects (dsh/lookup-page-objects state) selected (->> (dsh/lookup-selected state) (cfh/clean-loops objects)) features (-> (get state :features) (set/difference cfeat/frontend-only-features)) file-id (:current-file-id state) frame-id (cfh/common-parent-frame objects selected) file (dsh/lookup-file state file-id) version (get file :version) initial {:type :copied-shapes :features features :version version :file-id file-id :selected selected :objects {} :images #{}} shapes (->> (cfh/selected-with-children objects selected) (keep (d/getf objects)))] ;; The clipboard API doesn't handle well asynchronous calls because it expects to use ;; the clipboard in an user interaction. If you do an async call the callback is outside ;; the thread of the UI and so Safari blocks the copying event. ;; We use the API `ClipboardItem` that allows promises to be passed and so the event ;; will wait for the promise to resolve and everything should work as expected. ;; This only works in the current versions of the browsers. (if (some? (unchecked-get ug/global "ClipboardItem")) (let [resolve-data-promise (p/create (fn [resolve reject] (->> (rx/from shapes) (rx/merge-map (partial prepare-object objects frame-id)) (rx/reduce (partial collect-data state) initial) (rx/map (partial sort-selected state)) (rx/map (partial advance-copies state selected)) (rx/map #(t/encode-str % {:type :json-verbose})) (rx/map #(wapi/create-blob % "text/plain")) (rx/subs! resolve reject))))] (->> (rx/from (wapi/write-to-clipboard-promise "text/plain" resolve-data-promise)) (rx/catch on-copy-error) (rx/ignore))) ;; FIXME: this is to support Firefox versions below 116 that don't support ;; `ClipboardItem` after the version 116 is less common we could remove this. ;; https://caniuse.com/?search=ClipboardItem (->> (rx/from shapes) (rx/merge-map (partial prepare-object objects frame-id)) (rx/reduce (partial collect-data state) initial) (rx/map (partial sort-selected state)) (rx/map (partial advance-copies state selected)) (rx/map #(t/encode-str % {:type :json-verbose})) (rx/map wapi/write-to-clipboard) (rx/catch on-copy-error) (rx/ignore)))))))))) (declare ^:private paste-transit-shapes) (declare ^:private paste-transit-props) (declare ^:private paste-html-text) (declare ^:private paste-text) (declare ^:private paste-image) (declare ^:private paste-svg-text) (declare ^:private paste-shapes) (defn paste-from-clipboard "Perform a `paste` operation using the Clipboard API." [] (letfn [(decode-entry [entry] (try [:transit (t/decode-str entry)] (catch :default _cause [:text entry]))) (process-entry [[type data]] (case type :text (cond (str/empty? data) (rx/empty) (re-find #"> (rx/concat (->> (wapi/read-from-clipboard) (rx/map decode-entry) (rx/mapcat process-entry)) (->> (wapi/read-image-from-clipboard) (rx/map paste-image))) (rx/take 1) (rx/catch on-error)))))) (defn paste-from-event "Perform a `paste` operation from user emmited event." [event in-viewport?] (ptk/reify ::paste-from-event ptk/WatchEvent (watch [_ state _] (let [objects (dsh/lookup-page-objects state) edit-id (dm/get-in state [:workspace-local :edition]) is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))] ;; Some paste events can be fired while we're editing a text ;; we forbid that scenario so the default behaviour is executed (if is-editing? (rx/empty) (let [pdata (wapi/read-from-paste-event event) image-data (some-> pdata wapi/extract-images) text-data (some-> pdata wapi/extract-text) html-data (some-> pdata wapi/extract-html-text) transit-data (ex/ignoring (some-> text-data t/decode-str))] (cond (and (string? text-data) (re-find #"> (rx/from image-data) (rx/map paste-image)) (coll? transit-data) (rx/of (paste-transit-shapes (assoc transit-data :in-viewport in-viewport?))) (and (string? html-data) (d/not-empty? html-data)) (rx/of (paste-html-text html-data text-data)) (and (string? text-data) (d/not-empty? text-data)) (rx/of (paste-text text-data)) :else (rx/empty)))))))) (defn copy-selected-css [] (ptk/reify ::copy-selected-css ptk/EffectEvent (effect [_ state _] (let [objects (dsh/lookup-page-objects state) selected (->> (dsh/lookup-selected state) (mapv (d/getf objects))) css (css/generate-style objects selected selected {:with-prelude? false})] (wapi/write-to-clipboard css))))) (defn copy-selected-css-nested [] (ptk/reify ::copy-selected-css-nested ptk/EffectEvent (effect [_ state _] (let [objects (dsh/lookup-page-objects state) selected (->> (dsh/lookup-selected state) (cfh/selected-with-children objects) (mapv (d/getf objects))) css (css/generate-style objects selected selected {:with-prelude? false})] (wapi/write-to-clipboard css))))) (defn copy-selected-text [] (ptk/reify ::copy-selected-text ptk/EffectEvent (effect [_ state _] (let [selected (dsh/lookup-selected state) objects (dsh/lookup-page-objects state) text-shapes (->> (cfh/selected-with-children objects selected) (keep (d/getf objects)) (filter cfh/text-shape?)) selected (into (d/ordered-set) (map :id) text-shapes) ;; Narrow the objects map so it contains only relevant data for ;; selected and its parents objects (cfh/selected-subtree objects selected) selected (->> (ctst/sort-z-index objects selected) (into (d/ordered-set))) text (->> selected (map (fn [id] (let [shape (get objects id)] (-> shape :content txt/content->text)))) (str/join "\n"))] (wapi/write-to-clipboard text))))) (defn copy-selected-props [] (ptk/reify ::copy-selected-props ptk/WatchEvent (watch [_ state _] (letfn [(fetch-image [entry] (let [url (cf/resolve-file-media entry)] (->> (http/send! {:method :get :uri url :response-type :blob}) (rx/map :body) (rx/mapcat wapi/read-file-as-data-url) (rx/map #(assoc entry :data %))))) (resolve-images [data] (let [images (concat (->> data :props :fills (keep :fill-image)) (->> data :props :strokes (keep :stroke-image)))] (if (seq images) (->> (rx/from images) (rx/mapcat fetch-image) (rx/reduce conj #{}) (rx/map #(assoc data :images %))) (rx/of data)))) (on-copy-error [error] (js/console.error "clipboard blocked:" error) (rx/empty))] (let [selected (dsh/lookup-selected state)] (if (> (count selected) 1) ;; If multiple items are selected don't do anything (rx/empty) (let [selected (->> (dsh/lookup-selected state) first) objects (dsh/lookup-page-objects state)] (when-let [shape (get objects selected)] (let [props (cts/extract-props shape) features (-> (get state :features) (set/difference cfeat/frontend-only-features)) version (-> (dsh/lookup-file state) (get :version)) copy-data {:type :copied-props :features features :version version :props props :images #{}}] ;; The clipboard API doesn't handle well asynchronous calls because it expects to use ;; the clipboard in an user interaction. If you do an async call the callback is outside ;; the thread of the UI and so Safari blocks the copying event. ;; We use the API `ClipboardItem` that allows promises to be passed and so the event ;; will wait for the promise to resolve and everything should work as expected. ;; This only works in the current versions of the browsers. (if (some? (unchecked-get ug/global "ClipboardItem")) (let [resolve-data-promise (p/create (fn [resolve reject] (->> (rx/of copy-data) (rx/mapcat resolve-images) (rx/map #(t/encode-str % {:type :json-verbose})) (rx/map #(wapi/create-blob % "text/plain")) (rx/subs! resolve reject))))] (->> (rx/from (wapi/write-to-clipboard-promise "text/plain" resolve-data-promise)) (rx/catch on-copy-error) (rx/ignore))) ;; FIXME: this is to support Firefox versions below 116 that don't support ;; `ClipboardItem` after the version 116 is less common we could remove this. ;; https://caniuse.com/?search=ClipboardItem (->> (rx/of copy-data) (rx/mapcat resolve-images) (rx/map #(wapi/write-to-clipboard (t/encode-str % {:type :json-verbose}))) (rx/catch on-copy-error) (rx/ignore)))))))))))) (defn paste-selected-props [] (ptk/reify ::paste-selected-props ptk/WatchEvent (watch [_ state _] (when-not (-> state :workspace-global :read-only?) (letfn [(decode-entry [entry] (-> entry t/decode-str paste-transit-props)) (on-error [cause] (let [data (ex-data cause)] (if (:not-implemented data) (rx/of (ntf/warn (tr "errors.clipboard-not-implemented"))) (js/console.error "Clipboard error:" cause)) (rx/empty)))] (->> (wapi/read-from-clipboard) (rx/map decode-entry) (rx/take 1) (rx/catch on-error))))))) (defn selected-frame? [state] (let [selected (dsh/lookup-selected state) objects (dsh/lookup-page-objects state)] (and (= 1 (count selected)) (= :frame (get-in objects [(first selected) :type]))))) (defn get-tree-root-shapes [tree] ;; This fn gets a map of shapes and finds what shapes are parent of the rest (let [shapes-in-tree (vals tree) shape-ids (keys tree) parent-ids (set (map #(:parent-id %) shapes-in-tree))] (->> shape-ids (filter #(contains? parent-ids %))))) (defn any-same-frame-from-selected? [state frame-ids] (let [selected (first (dsh/lookup-selected state))] (< 0 (count (filter #(= % selected) frame-ids))))) (defn frame-same-size? [paste-obj frame-obj] (and (= (:heigth (:selrect (first (vals paste-obj)))) (:heigth (:selrect frame-obj))) (= (:width (:selrect (first (vals paste-obj)))) (:width (:selrect frame-obj))))) (def ^:private schema:paste-data-shapes [:map {:title "paste-data-shapes"} [:type [:= :copied-shapes]] [:features ::sm/set-of-strings] [:version :int] [:file-id ::sm/uuid] [:selected ::sm/set-of-uuid] [:objects [:map-of ::sm/uuid :map]] [:images [:set :map]] [:position {:optional true} ::gpt/point]]) (def ^:private schema:paste-data-props [:map {:title "paste-data-props"} [:type [:= :copied-props]] [:features ::sm/set-of-strings] [:version :int] [:props ;; todo type the properties [:map-of :keyword :any]]]) (def schema:paste-data [:multi {:title "paste-data" :dispatch :type} [:copied-shapes schema:paste-data-shapes] [:copied-props schema:paste-data-props]]) (def paste-data-valid? (sm/lazy-validator schema:paste-data)) (defn- paste-transit-shapes [{:keys [images] :as pdata}] (letfn [(upload-media [file-id imgpart] (->> (http/send! {:uri (: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 (partial rp/cmd! :upload-file-media-object)) (rx/map #(assoc % :prev-id (:id imgpart)))))] (ptk/reify ::paste-transit-shapes ptk/WatchEvent (watch [_ state _] (let [file-id (:current-file-id state) features (get state :features)] (when-not (paste-data-valid? pdata) (ex/raise :type :validation :code :invalid-paste-data :hibt "invalid paste data found")) (cfeat/check-paste-features! features (:features pdata)) (case (:type pdata) :copied-shapes (if (= file-id (:file-id pdata)) (let [pdata (assoc pdata :images [])] (rx/of (paste-shapes pdata))) (->> (rx/from images) (rx/merge-map (partial upload-media file-id)) (rx/reduce conj []) (rx/map #(assoc pdata :images %)) (rx/map paste-shapes))) nil)))))) (defn- paste-transit-props [pdata] (letfn [(upload-media [file-id imgpart] (->> (http/send! {:uri (: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 (partial rp/cmd! :upload-file-media-object)) (rx/map #(vector (:id imgpart) %)))) (update-image-data [pdata media-map] (update pdata :props (fn [props] (-> props (d/update-when :fills (fn [fills] (mapv (fn [fill] (cond-> fill (some? (:fill-image fill)) (update-in [:fill-image :id] #(get media-map % %)))) fills))) (d/update-when :strokes (fn [strokes] (mapv (fn [stroke] (cond-> stroke (some? (:stroke-image stroke)) (update-in [:stroke-image :id] #(get media-map % %)))) strokes))))))) (upload-images [file-id pdata] (->> (rx/from (:images pdata)) (rx/merge-map (partial upload-media file-id)) (rx/reduce conj {}) (rx/map (partial update-image-data pdata))))] (ptk/reify ::paste-transit-props ptk/WatchEvent (watch [_ state _] (let [features (get state :features) selected (dsh/lookup-selected state)] (when (paste-data-valid? pdata) (cfeat/check-paste-features! features (:features pdata)) (case (:type pdata) :copied-props (rx/concat (->> (rx/of pdata) (rx/mapcat (partial upload-images (:current-file-id state))) (rx/map #(dwsh/update-shapes selected (fn [shape objects] (cts/patch-props shape (:props pdata) objects)) {:with-objects? true}))) (rx/of (ptk/data-event :layout/update {:ids selected}))) ;; (rx/empty)))))))) (defn paste-shapes [{in-viewport? :in-viewport :as pdata}] (letfn [(translate-media [mdata media-idx attr-path] (let [id (-> (get-in mdata attr-path) (:id)) mobj (get media-idx id)] (if mobj (if (empty? attr-path) (-> mdata (assoc :id (:id mobj)) (assoc :path (:path mobj))) (update-in mdata attr-path (fn [value] (-> value (assoc :id (:id mobj)) (assoc :path (:path mobj)))))) mdata))) (add-obj? [chg] (= (:type chg) :add-obj)) ;; Analyze the rchange and replace staled media and ;; references to the new uploaded media-objects. (process-rchange [media-idx change] (let [;; Texts can have different fills for pieces of the text tr-fill-xf (map #(translate-media % media-idx [:fill-image])) tr-stroke-xf (map #(translate-media % media-idx [:stroke-image]))] (if (add-obj? change) (update change :obj (fn [obj] (-> obj (update :fills #(into [] tr-fill-xf %)) (update :strokes #(into [] tr-stroke-xf %)) (d/update-when :metadata translate-media media-idx []) (d/update-when :fill-image translate-media media-idx []) (d/update-when :content (fn [content] (txt/xform-nodes tr-fill-xf content))) (d/update-when :position-data (fn [position-data] (mapv (fn [pos-data] (update pos-data :fills #(into [] tr-fill-xf %))) position-data)))))) change))) (calculate-paste-position [state pobjects selected position] (let [page-objects (dsh/lookup-page-objects state) selected-objs (map (d/getf pobjects) selected) first-selected-obj (first selected-objs) page-selected (dsh/lookup-selected state) wrapper (gsh/shapes->rect selected-objs) orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper)) frame-id (first page-selected) frame-object (get page-objects frame-id) base (cfh/get-base-shape page-objects page-selected) index (cfh/get-position-on-parent page-objects (:id base)) tree-root (get-tree-root-shapes pobjects) only-one-root-shape? (and (< 1 (count pobjects)) (= 1 (count tree-root)))] (cond (selected-frame? state) (if (or (any-same-frame-from-selected? state (keys pobjects)) (and only-one-root-shape? (frame-same-size? pobjects (first tree-root)))) ;; Paste next to selected frame, if selected is itself or of the same size as the copied (let [selected-frame-obj (get page-objects (first page-selected)) parent-id (:parent-id base) paste-x (+ (:width selected-frame-obj) (:x selected-frame-obj) 50) paste-y (:y selected-frame-obj) delta (gpt/subtract (gpt/point paste-x paste-y) orig-pos)] [parent-id delta index]) ;; Paste inside selected frame otherwise (let [selected-frame-obj (get page-objects (first page-selected)) origin-frame-id (:frame-id first-selected-obj) origin-frame-object (get page-objects origin-frame-id) margin-x (-> (- (:width origin-frame-object) (+ (:x wrapper) (:width wrapper))) (min (- (:width frame-object) (:width wrapper)))) margin-y (-> (- (:height origin-frame-object) (+ (:y wrapper) (:height wrapper))) (min (- (:height frame-object) (:height wrapper)))) ;; Pasted objects mustn't exceed the selected frame x limit paste-x (if (> (+ (:width wrapper) (:x1 wrapper)) (:width frame-object)) (+ (- (:x frame-object) (:x orig-pos)) (- (:width frame-object) (:width wrapper) margin-x)) (:x frame-object)) ;; Pasted objects mustn't exceed the selected frame y limit paste-y (if (> (+ (:height wrapper) (:y1 wrapper)) (:height frame-object)) (+ (- (:y frame-object) (:y orig-pos)) (- (:height frame-object) (:height wrapper) margin-y)) (:y frame-object)) delta (if (= origin-frame-id uuid/zero) ;; When the origin isn't in a frame the result is pasted in the center. (gpt/subtract (gsh/shape->center frame-object) (grc/rect->center wrapper)) ;; When pasting from one frame to another frame the object ;; position must be limited to container boundaries. If ;; the pasted object doesn't fit we try to: ;; ;; - Align it to the limits on the x and y axis ;; - Respect the distance of the object to the right ;; and bottom in the original frame (gpt/point paste-x paste-y))] [frame-id delta (dec (count (:shapes selected-frame-obj)))])) (empty? page-selected) (let [frame-id (ctst/top-nested-frame page-objects position) delta (gpt/subtract position orig-pos)] [frame-id delta]) :else (let [parent-id (:parent-id base) delta (if in-viewport? (gpt/subtract position orig-pos) (gpt/subtract (gpt/point (:selrect base)) orig-pos))] [parent-id delta index])))) ;; Change the indexes of the pasted shapes (change-add-obj-index [objects selected index change] (let [;; if there is no current element selected, we want ;; the first (inc index) to be 0 index (d/nilv index -1) set-index (fn [[result index] id] [(assoc result id index) (inc index)]) ;; FIXME: optimize ??? map-ids (->> selected (map #(get-in objects [% :id])) (reduce set-index [{} (inc index)]) first)] (if (and (add-obj? change) (contains? map-ids (:old-id change))) (assoc change :index (get map-ids (:old-id change))) change))) (process-shape [file-id frame-id parent-id shape] (cond-> shape :always (assoc :frame-id frame-id :parent-id parent-id) (and (or (cfh/group-shape? shape) (cfh/bool-shape? shape)) (nil? (:shapes shape))) (assoc :shapes []) (cfh/text-shape? shape) (ctt/remove-external-typographies file-id)))] (ptk/reify ::paste-shapes ptk/WatchEvent (watch [it state _] (let [file-id (:current-file-id state) page (dsh/lookup-page state) media-idx (->> (:images pdata) (d/index-by :prev-id)) selected (:selected pdata) objects (:objects pdata) variant-props (:variant-properties pdata) position (deref ms/mouse-position) ;; Calculate position for the pasted elements [candidate-parent-id delta index] (calculate-paste-position state objects selected position) page-objects (:objects page) libraries (dsh/lookup-libraries state) ldata (dsh/lookup-file-data state file-id) [parent-id frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries) index (if (= candidate-parent-id parent-id) index 0) selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id))) (into (d/ordered-set) (reverse selected)) selected) objects (update-vals objects (partial process-shape file-id frame-id parent-id)) all-objects (merge page-objects objects) drop-cell (when (ctl/grid-layout? all-objects parent-id) (gslg/get-drop-cell frame-id all-objects position)) changes (-> (pcb/empty-changes it) (cll/generate-duplicate-changes all-objects page selected delta libraries ldata file-id {:variant-props variant-props}) (pcb/amend-changes (partial process-rchange media-idx)) (pcb/amend-changes (partial change-add-obj-index objects selected index))) ;; Adds a resize-parents operation so the groups are ;; updated. We add all the new objects changes (->> (:redo-changes changes) (filter add-obj?) (map :id) (pcb/resize-parents changes)) orig-shapes (map (d/getf all-objects) selected) selected (into (d/ordered-set) (comp (filter add-obj?) (filter #(contains? selected (:old-id %))) (map :obj) (map :id)) (:redo-changes changes)) changes (cond-> changes (some? drop-cell) (pcb/update-shapes [parent-id] #(ctl/add-children-to-cell % selected all-objects drop-cell))) undo-id (js/Symbol)] (rx/concat (->> (filter ctc/instance-head? orig-shapes) (map (fn [{:keys [component-file]}] (ptk/event ::ev/event {::ev/name "use-library-component" ::ev/origin "paste" :external-library (not= file-id component-file)}))) (rx/from)) (rx/of (dwu/start-undo-transaction undo-id) (dch/commit-changes changes) (dws/select-shapes selected) (ptk/data-event :layout/update {:ids [frame-id]}) (dwu/commit-undo-transaction undo-id)))))))) (defn as-content [text] (let [paragraphs (->> (str/lines text) (map str/trim) (mapv #(hash-map :type "paragraph" :children [(merge txt/default-text-attrs {:text %})])))] ;; if text is composed only by line breaks paragraphs is an empty list and should be nil (when (d/not-empty? paragraphs) {:type "root" :children [{:type "paragraph-set" :children paragraphs}]}))) (defn calculate-paste-position [state] (cond ;; Pasting inside a frame (selected-frame? state) (let [page-selected (dsh/lookup-selected state) page-objects (dsh/lookup-page-objects state) frame-id (first page-selected) frame-object (get page-objects frame-id)] (gsh/shape->center frame-object)) :else (deref ms/mouse-position))) (defn- paste-html-text [html text] (dm/assert! (string? html)) (ptk/reify ::paste-html-text ptk/WatchEvent (watch [_ state _] (let [root (dwtxt/create-root-from-html html) content (tc/dom->cljs root)] (when (types.text/valid-content? content) (let [id (uuid/next) width (max 8 (min (* 7 (count text)) 700)) height 16 {:keys [x y]} (calculate-paste-position state) shape {:id id :type :text :name (txt/generate-shape-name text) :x x :y y :width width :height height :grow-type (if (> (count text) 100) :auto-height :auto-width) :content content} undo-id (js/Symbol)] (rx/of (dwu/start-undo-transaction undo-id) (dwsh/create-and-add-shape :text x y shape) (dwu/commit-undo-transaction undo-id)))))))) (defn- paste-text [text] (dm/assert! (string? text)) (ptk/reify ::paste-text ptk/WatchEvent (watch [_ state _] (let [id (uuid/next) width (max 8 (min (* 7 (count text)) 700)) height 16 {:keys [x y]} (calculate-paste-position state) shape {:id id :type :text :name (txt/generate-shape-name text) :x x :y y :width width :height height :grow-type (if (> (count text) 100) :auto-height :auto-width) :content (as-content text)} undo-id (js/Symbol)] (rx/of (dwu/start-undo-transaction undo-id) (dwsh/create-and-add-shape :text x y shape) (dwu/commit-undo-transaction undo-id)))))) ;; TODO: why not implement it in terms of upload-media-workspace? (defn- paste-svg-text [text] (dm/assert! (string? text)) (ptk/reify ::paste-svg-text ptk/WatchEvent (watch [_ state _] (let [position (calculate-paste-position state) file-id (:current-file-id state)] (->> (dwm/svg->clj ["svg" text]) (rx/map #(dwm/svg-uploaded % file-id position))))))) (defn- paste-image [image] (ptk/reify ::paste-image ptk/WatchEvent (watch [_ state _] (let [file-id (:current-file-id state) position (calculate-paste-position state) params {:file-id file-id :blobs [image] :position position}] (rx/of (dwm/upload-media-workspace params)))))) (defn toggle-distances-display [value] (ptk/reify ::toggle-distances-display ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-global :show-distances?] value)))) (defn copy-link-to-clipboard [] (ptk/reify ::copy-link-to-clipboard ptk/WatchEvent (watch [_ _ _] (wapi/write-to-clipboard (rt/get-current-href))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interactions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (dm/export dwi/start-edit-interaction) (dm/export dwi/move-edit-interaction) (dm/export dwi/finish-edit-interaction) (dm/export dwi/start-move-overlay-pos) (dm/export dwi/move-overlay-pos) (dm/export dwi/finish-move-overlay-pos) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CANVAS OPTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn change-canvas-color ([color] (change-canvas-color nil color)) ([page-id color] (ptk/reify ::change-canvas-color ptk/WatchEvent (watch [it state _] (let [page-id (or page-id (:current-page-id state)) page (dsh/lookup-page state page-id) changes (-> (pcb/empty-changes it) (pcb/with-page page) (pcb/mod-page {:background (:color color)}))] (rx/of (dch/commit-changes changes))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Measurements ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn set-paddings-selected [paddings-selected] (ptk/reify ::set-paddings-selected ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-global :paddings-selected] paddings-selected)))) (defn set-gap-selected [gap-selected] (ptk/reify ::set-gap-selected ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-global :gap-selected] gap-selected)))) (defn set-margins-selected [margins-selected] (ptk/reify ::set-margins-selected ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-global :margins-selected] margins-selected)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Orphan Shapes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- find-orphan-shapes ([state] (find-orphan-shapes state (:current-page-id state))) ([state page-id] (let [objects (dsh/lookup-page-objects state page-id) objects (filter (fn [item] (and (not= (key item) uuid/zero) (not (contains? objects (:parent-id (val item)))))) objects)] objects))) (defn fix-orphan-shapes [] (ptk/reify ::fix-orphan-shapes ptk/WatchEvent (watch [_ state _] (let [orphans (set (into [] (keys (find-orphan-shapes state))))] (rx/of (relocate-shapes orphans uuid/zero 0 true)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Sitemap ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn start-rename-page-item [id] (ptk/reify ::start-rename-page-item ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-local :page-item] id)))) (defn stop-rename-page-item [] (ptk/reify ::stop-rename-page-item ptk/UpdateEvent (update [_ state] (let [local (-> (:workspace-local state) (dissoc :page-item))] (assoc state :workspace-local local))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Components annotations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn update-component-annotation "Update the component with the given annotation" [id annotation] (dm/assert! (uuid? id)) (dm/assert! (or (nil? annotation) (string? annotation))) (ptk/reify ::update-component-annotation ptk/WatchEvent (watch [it state _] (let [data (dsh/lookup-file-data state) update-fn (fn [component] ;; NOTE: we need to ensure the component exists, ;; because there are small possibilities of race ;; conditions with component deletion. (when component (if (nil? annotation) (dissoc component :annotation) (assoc component :annotation annotation)))) changes (-> (pcb/empty-changes it) (pcb/with-library-data data) (pcb/update-component id update-fn))] (rx/concat (rx/of (dch/commit-changes changes)) (when (nil? annotation) (rx/of (ptk/data-event ::ev/event {::ev/name "delete-component-annotation"})))))))) (defn set-annotations-expanded [expanded] (ptk/reify ::set-annotations-expanded ptk/UpdateEvent (update [_ state] (assoc-in state [:workspace-annotations :expanded] expanded)))) (defn set-annotations-id-for-create [id] (ptk/reify ::set-annotations-id-for-create ptk/UpdateEvent (update [_ state] (if id (-> (assoc-in state [:workspace-annotations :id-for-create] id) (assoc-in [:workspace-annotations :expanded] true)) (d/dissoc-in state [:workspace-annotations :id-for-create]))) ptk/WatchEvent (watch [_ _ _] (when (some? id) (rx/of (ptk/data-event ::ev/event {::ev/name "create-component-annotation"})))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Preview blend modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn set-preview-blend-mode [ids blend-mode] (ptk/reify ::set-preview-blend-mode ptk/UpdateEvent (update [_ state] (reduce #(assoc-in %1 [:workspace-preview-blend %2] blend-mode) state ids)))) (defn unset-preview-blend-mode [ids] (ptk/reify ::unset-preview-blend-mode ptk/UpdateEvent (update [_ state] (reduce #(update %1 :workspace-preview-blend dissoc %2) state ids)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Components ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn find-components-norefs [] (ptk/reify ::find-components-norefs ptk/WatchEvent (watch [_ state _] (let [objects (dsh/lookup-page-objects state) copies (->> objects vals (filter #(and (ctc/instance-head? %) (not (ctc/main-instance? %))))) copies-no-ref (filter #(not (:shape-ref %)) copies) find-childs-no-ref (fn [acc-map item] (let [id (:id item) childs (->> (cfh/get-children objects id) (filter #(not (:shape-ref %))))] (if (seq childs) (assoc acc-map id childs) acc-map))) childs-no-ref (reduce find-childs-no-ref {} copies)] (js/console.log "Copies no ref" (count copies-no-ref) (clj->js copies-no-ref)) (js/console.log "Childs no ref" (count childs-no-ref) (clj->js childs-no-ref)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Transform (dm/export dwt/trigger-bounding-box-cloaking) (dm/export dwt/start-resize) (dm/export dwt/update-dimensions) (dm/export dwt/change-orientation) (dm/export dwt/start-rotate) (dm/export dwt/increase-rotation) (dm/export dwt/start-move-selected) (dm/export dwt/move-selected) (dm/export dwt/update-position) (dm/export dwt/flip-horizontal-selected) (dm/export dwt/flip-vertical-selected) (dm/export dwly/set-opacity) ;; Common (dm/export dwsh/add-shape) (dm/export dwe/clear-edition-mode) (dm/export dws/select-shapes) (dm/export dwe/start-edition-mode) ;; Drawing (dm/export dwd/select-for-drawing) ;; Selection (dm/export dws/toggle-focus-mode) (dm/export dws/deselect-all) (dm/export dws/deselect-shape) (dm/export dws/duplicate-selected) (dm/export dws/handle-area-selection) (dm/export dws/select-all) (dm/export dws/select-inside-group) (dm/export dws/select-shape) (dm/export dws/select-prev-shape) (dm/export dws/select-next-shape) (dm/export dws/shift-select-shapes) ;; Highlight (dm/export dwh/highlight-shape) (dm/export dwh/dehighlight-shape) ;; Shape flags (dm/export dwsh/update-shape-flags) (dm/export dwsh/toggle-visibility-selected) (dm/export dwsh/toggle-lock-selected) (dm/export dwsh/toggle-file-thumbnail-selected) ;; Groups (dm/export dwg/mask-group) (dm/export dwg/unmask-group) (dm/export dwg/group-selected) (dm/export dwg/ungroup-selected) ;; Boolean (dm/export dwb/create-bool) (dm/export dwb/group-to-bool) (dm/export dwb/bool-to-group) (dm/export dwb/change-bool-type) ;; Shapes to path (dm/export dwps/convert-selected-to-path) ;; Guides (dm/export dwgu/update-guides) (dm/export dwgu/remove-guide) (dm/export dwgu/set-hover-guide) ;; Zoom (dm/export dwz/reset-zoom) (dm/export dwz/zoom-to-selected-shape) (dm/export dwz/start-zooming) (dm/export dwz/finish-zooming) (dm/export dwz/zoom-to-fit-all) (dm/export dwz/decrease-zoom) (dm/export dwz/increase-zoom) (dm/export dwz/set-zoom) ;; Thumbnails (dm/export dwth/update-thumbnail) ;; Viewport (dm/export dwv/initialize-viewport) (dm/export dwv/update-viewport-position) (dm/export dwv/update-viewport-size) (dm/export dwv/start-panning) (dm/export dwv/finish-panning) ;; Undo (dm/export dwu/reinitialize-undo)