;; 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.changes (:require [app.common.data :as d] [app.common.data.macros :as dm] [app.common.exceptions :as ex] [app.common.files.changes :as cpc] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cph] [app.common.logging :as log] [app.common.schema :as sm] [app.common.types.shape-tree :as ctst] [app.common.uuid :as uuid] [app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.undo :as dwu] [app.main.store :as st] [app.main.worker :as uw] [beicon.v2.core :as rx] [potok.v2.core :as ptk])) ;; Change this to :info :debug or :trace to debug this module (log/set-level! :warn) (defonce page-change? #{:add-page :mod-page :del-page :mov-page}) (defonce update-layout-attr? #{:hidden}) (declare commit-changes) (defn- add-undo-group [changes state] (let [undo (:workspace-undo state) items (:items undo) index (or (:index undo) (dec (count items))) prev-item (when-not (or (empty? items) (= index -1)) (get items index)) undo-group (:undo-group prev-item) add-undo-group? (and (not (nil? undo-group)) (= (get-in changes [:redo-changes 0 :type]) :mod-obj) (= (get-in prev-item [:redo-changes 0 :type]) :add-obj) (contains? (:tags prev-item) :alt-duplication))] ;; This is a copy-and-move with mouse+alt (cond-> changes add-undo-group? (assoc :undo-group undo-group)))) (def commit-changes? (ptk/type? ::commit-changes)) (defn update-shapes ([ids update-fn] (update-shapes ids update-fn nil)) ([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-remote? ignore-touched undo-group] :or {reg-objects? false save-undo? true stack-undo? false ignore-remote? false ignore-touched false}}] (dm/assert! "expected a valid coll of uuid's" (sm/check-coll-of-uuid! ids)) (dm/assert! (fn? update-fn)) (ptk/reify ::update-shapes ptk/WatchEvent (watch [it state _] (let [page-id (or page-id (:current-page-id state)) objects (wsh/lookup-page-objects state page-id) ids (into [] (filter some?) ids) update-layout-ids (->> ids (map (d/getf objects)) (filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs}))) (map :id)) changes (reduce (fn [changes id] (let [opts {:attrs attrs :ignore-geometry? (get ignore-tree id) :ignore-touched ignore-touched}] (pcb/update-shapes changes [id] update-fn (d/without-nils opts)))) (-> (pcb/empty-changes it page-id) (pcb/set-save-undo? save-undo?) (pcb/set-stack-undo? stack-undo?) (pcb/with-objects objects) (cond-> undo-group (pcb/set-undo-group undo-group))) ids) changes (pcb/reorder-grid-children changes ids) changes (add-undo-group changes state)] (rx/concat (if (seq (:redo-changes changes)) (let [changes (cond-> changes reg-objects? (pcb/resize-parents ids)) changes (cond-> changes ignore-remote? (pcb/ignore-remote))] (rx/of (commit-changes changes))) (rx/empty)) ;; Update layouts for properties marked (if (d/not-empty? update-layout-ids) (rx/of (ptk/data-event :layout/update update-layout-ids)) (rx/empty)))))))) (defn send-update-indices [] (ptk/reify ::send-update-indices ptk/WatchEvent (watch [_ _ _] (->> (rx/of (fn [state] (-> state (dissoc ::update-indices-debounce) (dissoc ::update-changes)))) (rx/observe-on :async))) ptk/EffectEvent (effect [_ state _] (doseq [[page-id changes] (::update-changes state)] (uw/ask! {:cmd :update-page-index :page-id page-id :changes changes}))))) ;; Update indices will debounce operations so we don't have to update ;; the index several times (which is an expensive operation) (defn update-indices [page-id changes] (let [start (uuid/next)] (ptk/reify ::update-indices ptk/UpdateEvent (update [_ state] (if (nil? (::update-indices-debounce state)) (assoc state ::update-indices-debounce start) (update-in state [::update-changes page-id] (fnil d/concat-vec []) changes))) ptk/WatchEvent (watch [_ state stream] (if (= (::update-indices-debounce state) start) (let [stopper (->> stream (rx/filter (ptk/type? :app.main.data.workspace/finalize)))] (rx/merge (->> stream (rx/filter (ptk/type? ::update-indices)) (rx/debounce 50) (rx/take 1) (rx/map #(send-update-indices)) (rx/take-until stopper)) (rx/of (update-indices page-id changes)))) (rx/empty)))))) (defn changed-frames "Extracts the frame-ids changed in the given changes" [changes objects] (let [change->ids (fn [change] (case (:type change) :add-obj [(:parent-id change)] (:mod-obj :del-obj) [(:id change)] :mov-objects (d/concat-vec (:shapes change) [(:parent-id change)]) []))] (into #{} (comp (mapcat change->ids) (keep #(cph/get-shape-id-root-frame objects %)) (remove #(= uuid/zero %))) changes))) (defn commit-changes "Schedules a list of changes to execute now, and add the corresponding undo changes to the undo stack. Options: - save-undo?: if set to false, do not add undo changes. - undo-group: if some consecutive changes (or even transactions) share the same undo-group, they will be undone or redone in a single step " [{:keys [redo-changes undo-changes origin save-undo? file-id undo-group tags stack-undo?] :or {save-undo? true stack-undo? false tags #{} undo-group (uuid/next)}}] (let [error (volatile! nil) page-id (:current-page-id @st/state) frames (changed-frames redo-changes (wsh/lookup-page-objects @st/state)) undo-changes (vec undo-changes) redo-changes (vec redo-changes)] (ptk/reify ::commit-changes cljs.core/IDeref (-deref [_] {:file-id file-id :hint-events @st/last-events :hint-origin (ptk/type origin) :changes redo-changes :page-id page-id :frames frames :save-undo? save-undo? :undo-group undo-group :tags tags :stack-undo? stack-undo?}) ptk/UpdateEvent (update [_ state] (log/info :msg "commit-changes" :js/undo-group (str undo-group) :js/file-id (str (or file-id "nil")) :js/redo-changes redo-changes :js/undo-changes undo-changes) (let [current-file-id (get state :current-file-id) file-id (or file-id current-file-id) path (if (= file-id current-file-id) [:workspace-data] [:workspace-libraries file-id :data])] (try (dm/assert! "expect valid vector of changes" (and (cpc/check-changes! redo-changes) (cpc/check-changes! undo-changes))) (update-in state path (fn [file] (-> file (cpc/process-changes redo-changes false) (ctst/update-object-indices page-id)))) (catch :default err (when-let [data (ex-data err)] (js/console.log (ex/explain data))) (when (ex/error? err) (js/console.log (.-stack ^js err))) (vreset! error err) state)))) ptk/WatchEvent (watch [_ _ _] (when-not @error (let [;; adds page-id to page changes (that have the `id` field instead) add-page-id (fn [{:keys [id type page] :as change}] (cond-> change (and (page-change? type) (nil? (:page-id change))) (assoc :page-id (or id (:id page))))) changes-by-pages (->> redo-changes (map add-page-id) (remove #(nil? (:page-id %))) (group-by :page-id)) process-page-changes (fn [[page-id _changes]] (update-indices page-id redo-changes))] (rx/concat (rx/from (map process-page-changes changes-by-pages)) (when (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?)))))))))))