;; 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.libraries-helpers (:require [app.common.data :as d] [app.common.data.macros :as dm] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.geom.shapes.grid-layout :as gslg] [app.common.logging :as log] [app.common.spec :as us] [app.common.text :as txt] [app.common.types.color :as ctc] [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] [app.common.types.file :as ctf] [app.common.types.pages-list :as ctpl] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] [app.common.types.typography :as cty] [app.main.data.workspace.state-helpers :as wsh] [cljs.spec.alpha :as s] [clojure.set :as set])) ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default (log/set-level! :warn) (declare generate-sync-container) (declare generate-sync-shape) (declare generate-sync-text-shape) (declare uses-assets?) (declare get-assets) (declare generate-sync-shape-direct) (declare generate-sync-shape-direct-recursive) (declare generate-sync-shape-inverse) (declare generate-sync-shape-inverse-recursive) (declare compare-children) (declare add-shape-to-instance) (declare add-shape-to-main) (declare remove-shape) (declare move-shape) (declare change-touched) (declare change-remote-synced) (declare update-attrs) (declare reposition-shape) (declare make-change) (defn pretty-file [file-id state] (if (= file-id (:current-file-id state)) "" (str "<" (get-in state [:workspace-libraries file-id :name]) ">"))) ;; ---- Components and instances creation ---- (defn duplicate-component "Clone the root shape of the component and all children. Generate new ids from all of them." [component new-component-id library-data] (let [components-v2 (dm/get-in library-data [:options :components-v2])] (if components-v2 (let [main-instance-page (ctf/get-component-page library-data component) main-instance-shape (ctf/get-component-root library-data component) delta (gpt/point (+ (:width main-instance-shape) 50) 0) ids-map (volatile! {}) inverted-ids-map (volatile! {}) nested-main-heads (volatile! #{}) update-original-shape (fn [original-shape new-shape] ; Save some ids for later (vswap! ids-map assoc (:id original-shape) (:id new-shape)) (vswap! inverted-ids-map assoc (:id new-shape) (:id original-shape)) (when (and (ctk/main-instance? original-shape) (not= (:component-id original-shape) (:id component))) (vswap! nested-main-heads conj (:id original-shape))) original-shape) update-new-shape (fn [new-shape _] (cond-> new-shape ; Link the new main to the new component (= (:component-id new-shape) (:id component)) (assoc :component-id new-component-id) :always (gsh/move delta))) [new-instance-shape new-instance-shapes _] (ctst/clone-object main-instance-shape (:parent-id main-instance-shape) (:objects main-instance-page) update-new-shape update-original-shape) remap-frame (fn [shape] ; Remap all frame-ids internal to the component to the new shapes (update shape :frame-id #(get @ids-map % (:frame-id shape)))) convert-nested-main (fn [shape] ; If there is some nested main instance, convert it into a copy of ; main nested in the original component. (let [origin-shape-id (get @inverted-ids-map (:id shape)) objects (:objects main-instance-page) parent-ids (cfh/get-parent-ids-seq-with-self objects origin-shape-id)] (cond-> shape (@nested-main-heads origin-shape-id) (dissoc :main-instance) (some @nested-main-heads parent-ids) (assoc :shape-ref origin-shape-id)))) xf-shape (comp (map remap-frame) (map convert-nested-main)) new-instance-shapes (into [] xf-shape new-instance-shapes)] [nil nil new-instance-shape new-instance-shapes]) (let [component-root (d/seek #(nil? (:parent-id %)) (vals (:objects component))) [new-component-shape new-component-shapes _] (ctst/clone-object component-root nil (get component :objects) identity)] [new-component-shape new-component-shapes nil nil])))) (defn generate-instantiate-component "Generate changes to create a new instance from a component." ([changes objects file-id component-id position page libraries] (generate-instantiate-component changes objects file-id component-id position page libraries nil nil nil)) ([changes objects file-id component-id position page libraries old-id parent-id frame-id] (let [component (ctf/get-component libraries file-id component-id) parent (when parent-id (get objects parent-id)) library (get libraries file-id) components-v2 (dm/get-in library [:data :options :components-v2]) [new-shape new-shapes] (ctn/make-component-instance page component (:data library) position components-v2) first-shape (cond-> (first new-shapes) (not (nil? parent-id)) (assoc :parent-id parent-id) (and (not (nil? parent)) (= :frame (:type parent))) (assoc :frame-id (:id parent)) (and (not (nil? parent)) (not= :frame (:type parent))) (assoc :frame-id (:frame-id parent)) (and (not (nil? parent)) (ctn/in-any-component? objects parent)) (dissoc :component-root) (and (nil? parent) (not (nil? frame-id))) (assoc :frame-id frame-id)) ;; on copy/paste old id is used later to reorder the paster layers changes (cond-> (pcb/add-object changes first-shape {:ignore-touched true}) (some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id))) changes (if (ctl/grid-layout? objects (:parent-id first-shape)) (let [[row column] (gslg/get-drop-cell (:parent-id first-shape) objects position)] (-> changes (pcb/update-shapes [(:parent-id first-shape)] (fn [shape objects] (-> shape (ctl/push-into-cell [(:id first-shape)] row column) (ctl/assign-cells objects))) {:with-objects? true}) (pcb/reorder-grid-children [(:parent-id first-shape)]))) changes) changes (reduce #(pcb/add-object %1 %2 {:ignore-touched true}) changes (rest new-shapes))] [new-shape changes]))) (declare generate-detach-recursive) (defn generate-detach-instance "Generate changes to remove the links between a shape and all its children with a component." [changes container shape-id] (let [shape (ctn/get-shape container shape-id)] (log/debug :msg "Detach instance" :shape-id shape-id :container (:id container)) (generate-detach-recursive changes container shape-id true (true? (:component-root shape))))) (defn- generate-detach-recursive [changes container shape-id first component-root?] (let [shape (ctn/get-shape container shape-id)] (if (and (ctk/instance-head? shape) (not first)) ;; Subinstances are not detached (if component-root? ;; if the original shape was component-root, the subinstances are converted in top instances (pcb/update-shapes changes [(:id shape)] #(assoc % :component-root true)) changes) ;; Otherwise, detach the shape and all children (let [children-ids (:shapes shape)] (reduce #(generate-detach-recursive %1 container %2 false component-root?) (pcb/update-shapes changes [(:id shape)] ctk/detach-shape) children-ids))))) (defn prepare-restore-component ([library-data component-id current-page it] (let [component (ctkl/get-deleted-component library-data component-id) page (or (ctf/get-component-page library-data component) (when (some #(= (:id current-page) %) (:pages library-data)) ;; If the page doesn't belong to the library, it's not valid current-page) (ctpl/get-last-page library-data))] (prepare-restore-component nil library-data component-id it page (gpt/point 0 0) nil nil))) ([changes library-data component-id it page delta old-id parent-id] (let [component (ctkl/get-deleted-component library-data component-id) parent (get-in page [:objects parent-id]) inside-component? (some? (ctn/get-instance-root (:objects page) parent)) shapes (cfh/get-children-with-self (:objects component) (:main-instance-id component)) shapes (map #(gsh/move % delta) shapes) first-shape (cond-> (first shapes) (not (nil? parent-id)) (assoc :parent-id parent-id) (and parent (= :frame (:type parent))) (assoc :frame-id parent-id) (and parent (not= :frame (:type parent))) (assoc :frame-id (:frame-id parent)) inside-component? (dissoc :component-root) (not inside-component?) (assoc :component-root true)) changes (-> (or changes (pcb/empty-changes it)) (pcb/with-page page) (pcb/with-objects (:objects page)) (pcb/with-library-data library-data)) changes (cond-> (pcb/add-object changes first-shape {:ignore-touched true}) (some? old-id) (pcb/amend-last-change #(assoc % :old-id old-id))) ; on copy/paste old id is used later to reorder the paster layers changes (reduce #(pcb/add-object %1 %2 {:ignore-touched true}) changes (rest shapes))] {:changes (pcb/restore-component changes component-id (:id page)) :shape (first shapes)}))) ;; ---- General library synchronization functions ---- (defn generate-sync-file "Generate changes to synchronize all shapes in all pages of the given file, that use assets of the given type in the given library. If an asset id is given, only shapes linked to this particular asset will be synchronized." [it file-id asset-type asset-id library-id state] (s/assert #{:colors :components :typographies} asset-type) (s/assert (s/nilable ::us/uuid) asset-id) (s/assert ::us/uuid file-id) (s/assert ::us/uuid library-id) (log/info :msg "Sync file with library" :asset-type asset-type :asset-id asset-id :file (pretty-file file-id state) :library (pretty-file library-id state)) (let [file (wsh/get-file state file-id) components-v2 (get-in file [:options :components-v2])] (loop [pages (vals (get file :pages-index)) changes (pcb/empty-changes it)] (if-let [page (first pages)] (recur (next pages) (pcb/concat-changes changes (generate-sync-container it asset-type asset-id library-id state (cfh/make-container page :page) components-v2))) changes)))) (defn generate-sync-library "Generate changes to synchronize all shapes in all components of the local library of the given file, that use assets of the given type in the given library. If an asset id is given, only shapes linked to this particular asset will be synchronized." [it file-id asset-type asset-id library-id state] (s/assert #{:colors :components :typographies} asset-type) (s/assert (s/nilable ::us/uuid) asset-id) (s/assert ::us/uuid file-id) (s/assert ::us/uuid library-id) (log/info :msg "Sync local components with library" :asset-type asset-type :asset-id asset-id :file (pretty-file file-id state) :library (pretty-file library-id state)) (let [file (wsh/get-file state file-id) components-v2 (get-in file [:options :components-v2])] (loop [local-components (ctkl/components-seq file) changes (pcb/empty-changes it)] (if-let [local-component (first local-components)] (recur (next local-components) (pcb/concat-changes changes (generate-sync-container it asset-type asset-id library-id state (cfh/make-container local-component :component) components-v2))) changes)))) (defn- generate-sync-container "Generate changes to synchronize all shapes in a particular container (a page or a component) that use assets of the given type in the given library." [it asset-type asset-id library-id state container components-v2] (if (cfh/page? container) (log/debug :msg "Sync page in local file" :page-id (:id container)) (log/debug :msg "Sync component in local library" :component-id (:id container))) (let [linked-shapes (->> (vals (:objects container)) (filter #(uses-assets? asset-type asset-id % library-id)))] (loop [shapes (seq linked-shapes) changes (-> (pcb/empty-changes it) (pcb/with-container container) (pcb/with-objects (:objects container)))] (if-let [shape (first shapes)] (recur (next shapes) (generate-sync-shape asset-type changes library-id state container shape components-v2)) changes)))) (defmulti uses-assets? "Checks if a shape uses some asset of the given type in the given library." (fn [asset-type _ _ _] asset-type)) (defmethod uses-assets? :components [_ component-id shape library-id] (if (nil? component-id) (ctk/uses-library-components? shape library-id) (ctk/instance-of? shape library-id component-id))) (defmethod uses-assets? :colors [_ color-id shape library-id] (if (nil? color-id) (ctc/uses-library-colors? shape library-id) (ctc/uses-library-color? shape library-id color-id))) (defmethod uses-assets? :typographies [_ typography-id shape library-id] (if (nil? typography-id) (cty/uses-library-typographies? shape library-id) (cty/uses-library-typography? shape library-id typography-id))) (defmulti generate-sync-shape "Generate changes to synchronize one shape from all assets of the given type that is using, in the given library." (fn [asset-type _changes _library-id _state _container _shape _components-v2] asset-type)) (defmethod generate-sync-shape :components [_ changes _library-id state container shape components-v2] (let [shape-id (:id shape) libraries (wsh/get-libraries state)] (generate-sync-shape-direct changes libraries container shape-id false components-v2))) (defmethod generate-sync-shape :colors [_ changes library-id state _ shape _] (log/debug :msg "Sync colors of shape" :shape (:name shape)) ;; Synchronize a shape that uses some colors of the library. The value of the ;; color in the library is copied to the shape. (let [library-colors (get-assets library-id :colors state)] (pcb/update-shapes changes [(:id shape)] #(ctc/sync-shape-colors % library-id library-colors)))) (defmethod generate-sync-shape :typographies [_ changes library-id state container shape _] (log/debug :msg "Sync typographies of shape" :shape (:name shape)) ;; Synchronize a shape that uses some typographies of the library. The attributes ;; of the typography are copied to the shape." (let [typographies (get-assets library-id :typographies state) update-node (fn [node] (if-let [typography (get typographies (:typography-ref-id node))] (merge node (dissoc typography :name :id)) (dissoc node :typography-ref-id :typography-ref-file)))] (generate-sync-text-shape changes shape container update-node))) (defn- get-assets [library-id asset-type state] (if (= library-id (:current-file-id state)) (get-in state [:workspace-data asset-type]) (get-in state [:workspace-libraries library-id :data asset-type]))) (defn- generate-sync-text-shape [changes shape container update-node] (let [old-content (:content shape) new-content (txt/transform-nodes update-node old-content) changes' (-> changes (update :redo-changes conj (make-change container {:type :mod-obj :id (:id shape) :operations [{:type :set :attr :content :val new-content}]})) (update :undo-changes conj (make-change container {:type :mod-obj :id (:id shape) :operations [{:type :set :attr :content :val old-content}]})))] (if (= new-content old-content) changes changes'))) ;; ---- Component synchronization helpers ---- ;; Three sources of component synchronization: ;; ;; - NORMAL SYNC: when a component is updated, any shape that use it, ;; must be synchronized. All attributes that have changed in the ;; component and whose attr group has not been "touched" in the dest ;; shape are copied. ;; ;; generate-sync-shape-direct (reset = false) ;; ;; - FORCED SYNC: when the "reset" command is applied to some shape, ;; all attributes that have changed in the component are copied, and ;; the "touched" flags are cleared. ;; ;; generate-sync-shape-direct (reset = true) ;; ;; - INVERSE SYNC: when the "update component" command is used in some ;; shape, all the attributes that have changed in the shape are copied ;; into the linked component. The "touched" flags are also cleared in ;; the origin shape. ;; ;; generate-sync-shape-inverse ;; ;; The initial shape is always a group (a root instance), so all the ;; children are recursively synced, too. A root instance is a group shape ;; that has the "component-id" attribute and also "component-root?" is true. ;; ;; The children lists of the instance and the component shapes are compared ;; side-by-side. Any new, deleted or moved child modifies (and "touches") ;; the parent shape. ;; ;; When a shape inside a component is in turn an instance of another ;; component, the synchronization is more complex: ;; ;; [Page] ;; Instance-2 #--> Component-2 (#--> = root instance) ;; IShape-2-1 --> Shape-2-1 (@--> = nested instance) ;; Subinstance-2-2 @--> Component-1 ( --> = shape ref) ;; IShape-2-2-1 --> Shape-1-1 ;; ;; [Component-1] ;; Component-1 ;; Shape-1-1 ;; ;; [Component-2] ;; Component-2 ;; Shape-2-1 ;; Subcomponent-2-2 @--> Component-1 ;; Shape-2-2-1 --> Shape-1-1 ;; ;; * A SUBINSTANCE ACTUALLY HAS TWO MAINS. For example IShape-2-2-1 ;; depends on Shape-2-2-1 (in the "near" component) but also on ;; Shape-1-1-1 (in the "remote" component). The "shape-ref" attribute ;; always refer to the remote shape, and it's guaranteed that it's ;; always a final shape, not an instance. The relationship between the ;; shape and the near shape is that both point to the same remote. ;; ;; * THE INITIAL VALUE of IShape-2-2-1 comes from the near component ;; Shape-2-2-1 (although the shape-ref attribute points to the direct ;; component Shape-1-1). The touched flags of IShape-2-2-1 start ;; cleared at first, and activate on any attribute change onwards. ;; ;; * IN A NORMAL SYNC, the sync process starts in the root instance and ;; continues recursively with the children of the root instance and ;; the component. Therefore, IShape-2-2-1 is synced with Shape-2-2-1. ;; ;; * IN A FORCED SYNC, IF THE INITIAL SHAPE IS THE ROOT INSTANCE, the ;; order is the same, and IShape-2-2-1 is reset from Shape-2-2-1 and ;; marked as not touched. ;; ;; * IF THE INITIAL SHAPE IS THE SUBINSTANCE, the sync is done against ;; the remote component. Therefore, IShape-2-2-1 is synched with ;; Shape-1-1. Then the "touched" flags are reset, and the ;; "remote-synced" flag is set (it will be set until the shape is ;; touched again or it's synced forced normal or inverse with the ;; near component). ;; ;; * IN AN INVERSE SYNC, IF THE INITIAL SHAPE IS THE ROOT INSTANCE, the ;; order is the same as in the normal sync. Therefore, IShape-2-2-1 ;; values are copied into Shape-2-2-1, and then its touched flags are ;; cleared. Then, the "touched" flags THAT ARE TRUE are copied to ;; Shape-2-2-1. This may cause that Shape-2-2-1 is now touched respect ;; to Shape-1-1, and so, some attributes are not copied in a subsequent ;; normal sync. Or, if "remote-synced" flag is set in IShape-2-2-1, ;; all touched flags are cleared in Shape-2-2-1 and "remote-synced" ;; is removed. ;; ;; * IN AN INVERSE SYNC INITIATED IN THE SUBINSTANCE, the update is done ;; to the remote component. E.g. IShape-2-2-1 attributes are copied into ;; Shape-1-1, and then touched cleared and "remote-synced" flag set. ;; ;; #### WARNING: there are two conditions that are invisible to user: ;; - When the near shape (Shape-2-2-1) is touched respect the remote ;; one (Shape-1-1), there is no asterisk displayed anywhere. ;; - When the instance shape (IShape-2-2-1) is synced with the remote ;; shape (remote-synced = true), the user will see that this shape ;; is different than the one in the near component (Shape-2-2-1) ;; but it's not touched. (defn- redirect-shaperef ;;Set the :shape-ref of a shape pointing to the :id of its remote-shape ([container libraries shape] (redirect-shaperef nil nil shape (ctf/find-remote-shape container libraries shape))) ([_ _ shape remote-shape] (if (some? (:shape-ref shape)) (assoc shape :shape-ref (:id remote-shape)) shape))) (defn generate-sync-shape-direct "Generate changes to synchronize one shape that is the root of a component instance, and all its children, from the given component." [changes libraries container shape-id reset? components-v2] (log/debug :msg "Sync shape direct" :shape (str shape-id) :reset? reset?) (let [shape-inst (ctn/get-shape container shape-id)] (if (ctk/in-component-copy? shape-inst) (let [redirect-shaperef (partial redirect-shaperef container libraries) library (dm/get-in libraries [(:component-file shape-inst) :data]) component (or (ctkl/get-component library (:component-id shape-inst)) (and reset? (ctkl/get-deleted-component library (:component-id shape-inst)))) shape-main (when component (if (and reset? components-v2) (ctf/find-remote-shape container libraries shape-inst) (ctf/get-ref-shape library component shape-inst))) shape-inst (if (and reset? components-v2) (redirect-shaperef shape-inst shape-main) shape-inst) initial-root? (:component-root shape-inst) root-inst shape-inst root-main shape-main] (if component (generate-sync-shape-direct-recursive changes container shape-inst component library shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2) ;; If the component is not found, because the master component has been ;; deleted or the library unlinked, do nothing in v2 or detach in v1. (if components-v2 changes (generate-detach-instance changes container shape-id)))) changes))) (defn- find-main-container "Find the container that has the main shape." [container-inst shape-inst shape-main library component] (loop [shape-inst' shape-inst component' component] (let [container (ctf/get-component-container library component')] ; TODO: this won't work if some intermediate component is in a different library (if (some? (ctn/get-shape container (:id shape-main))) ; for this to work we need to have access to the libraries list here container (let [parent (ctn/get-shape container-inst (:parent-id shape-inst')) shape-inst' (ctn/get-head-shape (:objects container-inst) parent) component' (or (ctkl/get-component library (:component-id shape-inst')) (ctkl/get-deleted-component library (:component-id shape-inst')))] (if (some? component) (recur shape-inst' component') nil)))))) (defn- generate-sync-shape-direct-recursive [changes container shape-inst component library shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2] (log/debug :msg "Sync shape direct recursive" :shape (str (:name shape-inst)) :component (:name component)) (if (nil? shape-main) ;; This should not occur, but protect against it in any case (if components-v2 changes (generate-detach-instance changes container (:id shape-inst))) (let [omit-touched? (not reset?) clear-remote-synced? (and initial-root? reset?) set-remote-synced? (and (not initial-root?) reset?) changes (cond-> changes :always (update-attrs shape-inst shape-main root-inst root-main container omit-touched?) reset? (change-touched shape-inst shape-main container {:reset-touched? true}) clear-remote-synced? (change-remote-synced shape-inst container nil) set-remote-synced? (change-remote-synced shape-inst container true)) component-container (find-main-container container shape-inst shape-main library component) children-inst (vec (ctn/get-direct-children container shape-inst)) children-main (vec (ctn/get-direct-children component-container shape-main)) children-inst (if (and reset? components-v2) (map #(redirect-shaperef %) children-inst) children-inst) only-inst (fn [changes child-inst] (if-not (and omit-touched? (contains? (:touched shape-inst) :shapes-group)) (remove-shape changes child-inst container omit-touched?) changes)) only-main (fn [changes child-main] (if-not (and omit-touched? (contains? (:touched shape-inst) :shapes-group)) (add-shape-to-instance changes child-main (d/index-of children-main child-main) component-container container root-inst root-main omit-touched? set-remote-synced?) changes)) both (fn [changes child-inst child-main] (generate-sync-shape-direct-recursive changes container child-inst component library child-main root-inst root-main reset? initial-root? redirect-shaperef components-v2)) moved (fn [changes child-inst child-main] (move-shape changes child-inst (d/index-of children-inst child-inst) (d/index-of children-main child-main) container omit-touched?))] (compare-children changes children-inst children-main only-inst only-main both moved false)))) (defn- generate-rename-component [changes id new-name library-data components-v2] (let [[path name] (cfh/parse-path-name new-name) update-fn (fn [component] (cond-> component :always (assoc :path path :name name) (not components-v2) (update :objects ;; Give the same name to the root shape #(assoc-in % [id :name] name))))] (-> changes (pcb/with-library-data library-data) (pcb/update-component id update-fn)))) (defn generate-sync-shape-inverse "Generate changes to update the component a shape is linked to, from the values in the shape and all its children." [changes libraries container shape-id components-v2] (log/debug :msg "Sync shape inverse" :shape (str shape-id)) (let [redirect-shaperef (partial redirect-shaperef container libraries) shape-inst (ctn/get-shape container shape-id) library (dm/get-in libraries [(:component-file shape-inst) :data]) component (ctkl/get-component library (:component-id shape-inst)) shape-main (when component (if components-v2 (ctf/find-remote-shape container libraries shape-inst) (ctf/get-ref-shape library component shape-inst))) shape-inst (if components-v2 (redirect-shaperef shape-inst shape-main) shape-inst) initial-root? (:component-root shape-inst) root-inst shape-inst root-main (ctf/get-component-root library component) changes (cond-> changes (and component (contains? (:touched shape-inst) :name-group)) (generate-rename-component (:component-id shape-inst) (:name shape-inst) library components-v2))] (if component (generate-sync-shape-inverse-recursive changes container shape-inst component library shape-main root-inst root-main initial-root? redirect-shaperef components-v2) changes))) (defn- generate-sync-shape-inverse-recursive [changes container shape-inst component library shape-main root-inst root-main initial-root? redirect-shaperef components-v2] (log/trace :msg "Sync shape inverse recursive" :shape (str (:name shape-inst)) :component (:name component)) (if (nil? shape-main) ;; This should not occur, but protect against it in any case changes (let [component-container (ctf/get-component-container library component) omit-touched? false set-remote-synced? (not initial-root?) clear-remote-synced? initial-root? changes (cond-> changes :always (-> (update-attrs shape-main shape-inst root-main root-inst component-container omit-touched?) (change-touched shape-inst shape-main container {:reset-touched? true}) (change-touched shape-main shape-inst component-container {:copy-touched? true})) clear-remote-synced? (change-remote-synced shape-inst container nil) set-remote-synced? (change-remote-synced shape-inst container true)) children-inst (mapv #(ctn/get-shape container %) (:shapes shape-inst)) children-main (mapv #(ctn/get-shape component-container %) (:shapes shape-main)) children-inst (if components-v2 (map #(redirect-shaperef %) children-inst) children-inst) only-inst (fn [changes child-inst] (add-shape-to-main changes child-inst (d/index-of children-inst child-inst) component component-container container root-inst root-main)) only-main (fn [changes child-main] (remove-shape changes child-main component-container false)) both (fn [changes child-inst child-main] (generate-sync-shape-inverse-recursive changes container child-inst component library child-main root-inst root-main initial-root? redirect-shaperef components-v2)) moved (fn [changes child-inst child-main] (move-shape changes child-main (d/index-of children-main child-main) (d/index-of children-inst child-inst) component-container false)) changes (compare-children changes children-inst children-main only-inst only-main both moved true) ;; The inverse sync may be made on a component that is inside a ;; remote library. We need to separate changes that are from ;; local and remote files. check-local (fn [change] (cond-> change (= (:id change) (:id shape-inst)) (assoc :local-change? true)))] (-> changes (update :redo-changes (partial mapv check-local)) (update :undo-changes (partial map check-local)))))) ;; ---- Operation generation helpers ---- (defn- compare-children [changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse?] (loop [children-inst (seq (or children-inst [])) children-main (seq (or children-main [])) changes changes] (let [child-inst (first children-inst) child-main (first children-main)] (cond (and (nil? child-inst) (nil? child-main)) changes (nil? child-inst) (reduce only-main-cb changes children-main) (nil? child-main) (reduce only-inst-cb changes children-inst) :else (if (ctk/is-main-of? child-main child-inst) (recur (next children-inst) (next children-main) (both-cb changes child-inst child-main)) (let [child-inst' (d/seek #(ctk/is-main-of? child-main %) children-inst) child-main' (d/seek #(ctk/is-main-of? % child-inst) children-main)] (cond (nil? child-inst') (recur children-inst (next children-main) (only-main-cb changes child-main)) (nil? child-main') (recur (next children-inst) children-main (only-inst-cb changes child-inst)) :else (if inverse? (recur (next children-inst) (remove #(= (:id %) (:id child-main')) children-main) (-> changes (both-cb child-inst' child-main) (moved-cb child-inst child-main'))) (recur (remove #(= (:id %) (:id child-inst')) children-inst) (next children-main) (-> changes (both-cb child-inst child-main') (moved-cb child-inst' child-main))))))))))) (defn- add-shape-to-instance [changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced?] (log/info :msg (str "ADD [P] " (:name component-shape))) (let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape)) parent-shape (d/seek #(ctk/is-main-of? component-parent-shape %) (cfh/get-children-with-self (:objects container) (:id root-instance))) all-parents (into [(:id parent-shape)] (cfh/get-parent-ids (:objects container) (:id parent-shape))) update-new-shape (fn [new-shape original-shape] (let [new-shape (reposition-shape new-shape root-main root-instance)] (cond-> new-shape (= (:id original-shape) (:id component-shape)) (assoc :frame-id (if (= (:type parent-shape) :frame) (:id parent-shape) (:frame-id parent-shape))) set-remote-synced? (assoc :remote-synced true) :always (assoc :shape-ref (:id original-shape))))) update-original-shape (fn [original-shape _new-shape] original-shape) [_ new-shapes _] (ctst/clone-object component-shape (:id parent-shape) (get component-page :objects) update-new-shape update-original-shape nil false nil (:objects container)) add-obj-change (fn [changes shape'] (update changes :redo-changes conj (make-change container (as-> {:type :add-obj :id (:id shape') :parent-id (:parent-id shape') :index index :ignore-touched true :obj shape'} $ (cond-> $ (:frame-id shape') (assoc :frame-id (:frame-id shape'))))))) del-obj-change (fn [changes shape'] (update changes :undo-changes conj (make-change container {:type :del-obj :id (:id shape') :ignore-touched true}))) changes' (reduce add-obj-change changes new-shapes) changes' (update changes' :redo-changes conj (make-change container {:type :reg-objects :shapes all-parents})) changes' (reduce del-obj-change changes' new-shapes)] (if (and (cfh/touched-group? parent-shape :shapes-group) omit-touched?) changes changes'))) (defn- add-shape-to-main [changes shape index component component-container page root-instance root-main] (log/info :msg (str "ADD [C] " (:name shape))) (let [parent-shape (ctn/get-shape page (:parent-id shape)) component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape) (cfh/get-children-with-self (:objects component-container) (:id root-main))) all-parents (into [(:id component-parent-shape)] (cfh/get-parent-ids (:objects component-container) (:id component-parent-shape))) update-new-shape (fn [new-shape _original-shape] (reposition-shape new-shape root-instance root-main)) update-original-shape (fn [original-shape new-shape] (if-not (:shape-ref original-shape) (assoc original-shape :shape-ref (:id new-shape)) original-shape)) [_new-shape new-shapes updated-shapes] (ctst/clone-object shape (:id component-parent-shape) (get page :objects) update-new-shape update-original-shape) add-obj-change (fn [changes shape'] (update changes :redo-changes conj (cond-> (make-change component-container {:type :add-obj :id (:id shape') :parent-id (:parent-id shape') :index index :ignore-touched true :obj shape'}) (ctn/page? component-container) (assoc :frame-id (if (= (:type shape') :frame) (:id shape') (:frame-id shape')))))) mod-obj-change (fn [changes shape'] (update changes :redo-changes conj {:type :mod-obj :page-id (:id page) :id (:id shape') :operations [{:type :set :attr :component-id :val (:component-id shape')} {:type :set :attr :component-file :val (:component-file shape')} {:type :set :attr :component-root :val (:component-root shape')} {:type :set :attr :shape-ref :val (:shape-ref shape')} {:type :set :attr :touched :val (:touched shape')}]})) del-obj-change (fn [changes shape'] (update changes :undo-changes conj {:type :del-obj :id (:id shape') :page-id (:id page) :ignore-touched true})) changes' (reduce add-obj-change changes new-shapes) changes' (update changes' :redo-changes conj {:type :reg-objects :component-id (:id component) :shapes all-parents}) changes' (reduce mod-obj-change changes' updated-shapes) changes' (reduce del-obj-change changes' new-shapes)] changes')) (defn- remove-shape [changes shape container omit-touched?] (log/info :msg (str "REMOVE-SHAPE " (if (cfh/page? container) "[P] " "[C] ") (:name shape))) (let [objects (get container :objects) parents (cfh/get-parent-ids objects (:id shape)) parent (first parents) children (cfh/get-children-ids objects (:id shape)) ids (into [(:id shape)] children) add-redo-change (fn [changes id] (update changes :redo-changes conj (make-change container {:type :del-obj :id id :ignore-touched true}))) add-undo-change (fn [changes id] (let [shape' (get objects id)] (update changes :undo-changes conj (make-change container (as-> {:type :add-obj :id id :index (cfh/get-position-on-parent objects id) :parent-id (:parent-id shape') :ignore-touched true :obj shape'} $ (cond-> $ (:frame-id shape') (assoc :frame-id (:frame-id shape')))))))) changes' (-> (reduce add-redo-change changes ids) (update :redo-changes conj (make-change container {:type :reg-objects :shapes (vec parents)})) (add-undo-change (:id shape))) changes' (reduce add-undo-change changes' children)] (if (and (cfh/touched-group? parent :shapes-group) omit-touched?) changes changes'))) (defn- move-shape [changes shape index-before index-after container omit-touched?] (log/info :msg (str "MOVE " (if (cfh/page? container) "[P] " "[C] ") (:name shape) " " index-before " -> " index-after)) (let [parent (ctn/get-shape container (:parent-id shape)) changes' (-> changes (update :redo-changes conj (make-change container {:type :mov-objects :parent-id (:parent-id shape) :shapes [(:id shape)] :index index-after :ignore-touched true :syncing true})) (update :undo-changes conj (make-change container {:type :mov-objects :parent-id (:parent-id shape) :shapes [(:id shape)] :index index-before :ignore-touched true :syncing true})))] (if (and (cfh/touched-group? parent :shapes-group) omit-touched?) changes changes'))) (defn- change-touched [changes dest-shape origin-shape container {:keys [reset-touched? copy-touched?] :as options}] (if (or (nil? (:shape-ref dest-shape)) (not (or reset-touched? copy-touched?))) changes (do (log/info :msg (str "CHANGE-TOUCHED " (if (cfh/page? container) "[P] " "[C] ") (:name dest-shape)) :options options) (let [new-touched (cond reset-touched? nil copy-touched? (if (:remote-synced origin-shape) nil (set/union (:touched dest-shape) (:touched origin-shape))))] (-> changes (update :redo-changes conj (make-change container {:type :mod-obj :id (:id dest-shape) :operations [{:type :set-touched :touched new-touched}]})) (update :undo-changes conj (make-change container {:type :mod-obj :id (:id dest-shape) :operations [{:type :set-touched :touched (:touched dest-shape)}]}))))))) (defn- change-remote-synced [changes shape container remote-synced?] (if (nil? (:shape-ref shape)) changes (do (log/info :msg (str "CHANGE-REMOTE-SYNCED? " (if (cfh/page? container) "[P] " "[C] ") (:name shape)) :remote-synced remote-synced?) (-> changes (update :redo-changes conj (make-change container {:type :mod-obj :id (:id shape) :operations [{:type :set-remote-synced :remote-synced remote-synced?}]})) (update :undo-changes conj (make-change container {:type :mod-obj :id (:id shape) :operations [{:type :set-remote-synced :remote-synced (:remote-synced shape)}]})))))) (defn- update-attrs "The main function that implements the attribute sync algorithm. Copy attributes that have changed in the origin shape to the dest shape. If omit-touched? is true, attributes whose group has been touched in the destination shape will not be copied." [changes dest-shape origin-shape dest-root origin-root container omit-touched?] (log/info :msg (str "SYNC " (:name origin-shape) " -> " (if (cfh/page? container) "[P] " "[C] ") (:name dest-shape))) (let [;; To synchronize geometry attributes we need to make a prior ;; operation, because coordinates are absolute, but we need to ;; sync only the position relative to the origin of the component. ;; We solve this by moving the origin shape so it is aligned with ;; the dest root before syncing. ;; In case of subinstances, the comparison is always done with the ;; near component, because this is that we are syncing with. origin-shape (reposition-shape origin-shape origin-root dest-root) touched (get dest-shape :touched #{})] (loop [attrs (seq (keys ctk/sync-attrs)) roperations [] uoperations '()] (let [attr (first attrs)] (if (nil? attr) (if (empty? roperations) changes (let [all-parents (cfh/get-parent-ids (:objects container) (:id dest-shape))] (-> changes (update :redo-changes conj (make-change container {:type :mod-obj :id (:id dest-shape) :operations roperations})) (update :redo-changes conj (make-change container {:type :reg-objects :shapes all-parents})) (update :undo-changes conj (make-change container {:type :mod-obj :id (:id dest-shape) :operations (vec uoperations)})) (update :undo-changes concat [(make-change container {:type :reg-objects :shapes all-parents})])))) (let [roperation {:type :set :attr attr :val (get origin-shape attr) :ignore-touched true} uoperation {:type :set :attr attr :val (get dest-shape attr) :ignore-touched true} attr-group (get ctk/sync-attrs attr)] (if (or (= (get origin-shape attr) (get dest-shape attr)) (and (touched attr-group) omit-touched?)) (recur (next attrs) roperations uoperations) (recur (next attrs) (conj roperations roperation) (conj uoperations uoperation))))))))) (defn- reposition-shape [shape origin-root dest-root] (let [shape-pos (fn [shape] (gpt/point (get-in shape [:selrect :x]) (get-in shape [:selrect :y]))) origin-root-pos (shape-pos origin-root) dest-root-pos (shape-pos dest-root) delta (gpt/subtract dest-root-pos origin-root-pos)] (gsh/move shape delta))) (defn- make-change [container change] (if (cfh/page? container) (assoc change :page-id (:id container)) (assoc change :component-id (:id container))))