mirror of
https://github.com/penpot/penpot.git
synced 2025-12-11 22:14:05 +01:00
1229 lines
55 KiB
Clojure
1229 lines
55 KiB
Clojure
;; 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.geom.point :as gpt]
|
|
[app.common.geom.shapes :as gsh]
|
|
[app.common.logging :as log]
|
|
[app.common.pages :as cp]
|
|
[app.common.pages.changes-builder :as pcb]
|
|
[app.common.pages.helpers :as cph]
|
|
[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.shape-tree :as ctst]
|
|
[app.common.types.typography :as cty]
|
|
[app.common.uuid :as uuid]
|
|
[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))
|
|
"<local>"
|
|
(str "<" (get-in state [:workspace-libraries file-id :name]) ">")))
|
|
|
|
;; ---- Components and instances creation ----
|
|
|
|
(defn generate-add-component-changes
|
|
[changes root objects file-id page-id components-v2]
|
|
(let [name (:name root)
|
|
[path name] (cph/parse-path-name name)
|
|
|
|
[root-shape new-shapes updated-shapes]
|
|
(if-not components-v2
|
|
(ctn/make-component-shape root objects file-id components-v2)
|
|
(let [new-id (uuid/next)]
|
|
[(assoc root :id new-id)
|
|
nil
|
|
[(assoc root
|
|
:component-id new-id
|
|
:component-file file-id
|
|
:component-root? true
|
|
:main-instance? true)]]))
|
|
|
|
changes (-> changes
|
|
(pcb/add-component (:id root-shape)
|
|
path
|
|
name
|
|
new-shapes
|
|
updated-shapes
|
|
(:id root)
|
|
page-id))]
|
|
[root-shape changes]))
|
|
|
|
(defn generate-add-component
|
|
"If there is exactly one id, and it's a frame (or a group in v1), and not already a component,
|
|
use it as root. Otherwise, create a frame (v2) or group (v1) that contains all ids. Then, make a
|
|
component with it, and link all shapes to their corresponding one in the component."
|
|
[it shapes objects page-id file-id components-v2 prepare-create-group prepare-create-board]
|
|
(let [changes (pcb/empty-changes it page-id)
|
|
|
|
[root changes]
|
|
(if (and (= (count shapes) 1)
|
|
(or (and (= (:type (first shapes)) :group) (not components-v2))
|
|
(= (:type (first shapes)) :frame))
|
|
(not (ctk/instance-head? (first shapes))))
|
|
[(first shapes) (-> (pcb/empty-changes it page-id)
|
|
(pcb/with-objects objects))]
|
|
(let [root-name (if (= 1 (count shapes))
|
|
(:name (first shapes))
|
|
"Component 1")]
|
|
(if-not components-v2
|
|
(prepare-create-group it ; These functions needs to be passed as argument
|
|
objects ; to avoid a circular dependence
|
|
page-id
|
|
shapes
|
|
root-name
|
|
(not (ctk/instance-head? (first shapes))))
|
|
(prepare-create-board changes
|
|
(uuid/next)
|
|
(:parent-id (first shapes))
|
|
objects
|
|
(map :id shapes)
|
|
nil
|
|
root-name
|
|
true))))
|
|
|
|
[root-shape changes] (generate-add-component-changes changes root objects file-id page-id components-v2)]
|
|
[root (:id root-shape) changes]))
|
|
|
|
(defn duplicate-component
|
|
"Clone the root shape of the component and all children. Generate new
|
|
ids from all of them."
|
|
[component 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)
|
|
|
|
position (gpt/point (:x main-instance-shape) (:y main-instance-shape))
|
|
|
|
component-instance-extra-data (if components-v2 {:main-instance? true} {})
|
|
|
|
[new-instance-shape new-instance-shapes]
|
|
(when (and (some? main-instance-page) (some? main-instance-shape))
|
|
(ctn/make-component-instance main-instance-page
|
|
component
|
|
library-data
|
|
position
|
|
true
|
|
component-instance-extra-data))]
|
|
|
|
[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 file-id component-id position page libraries]
|
|
(generate-instantiate-component changes file-id component-id position page libraries nil nil))
|
|
|
|
([changes file-id component-id position page libraries old-id parent-id]
|
|
(let [component (ctf/get-component libraries file-id component-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))
|
|
|
|
changes (as-> changes $
|
|
(pcb/add-object $ first-shape {:ignore-touched true})
|
|
(cond-> $
|
|
(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
|
|
(reduce #(pcb/add-object %1 %2 {:ignore-touched true})
|
|
$
|
|
(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]
|
|
(log/debug :msg "Detach instance" :shape-id shape-id :container (:id container))
|
|
(generate-detach-recursive changes container shape-id true))
|
|
|
|
(defn- generate-detach-recursive
|
|
[changes container shape-id first]
|
|
(let [shape (ctn/get-shape container shape-id)]
|
|
(if (and (ctk/instance-head? shape) (not first))
|
|
;; Subinstances are not detached, but converted in top instances
|
|
(pcb/update-shapes changes [(:id shape)] #(assoc % :component-root? true))
|
|
;; Otherwise, detach the shape and all children
|
|
(let [children-ids (:shapes shape)]
|
|
(reduce #(generate-detach-recursive %1 container %2 false)
|
|
(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)
|
|
current-page)]
|
|
(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)
|
|
|
|
shapes (cph/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))
|
|
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
|
|
(cph/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
|
|
(cph/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 (cph/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 d/preconj (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 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 [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
|
|
(ctf/get-ref-shape library component shape-inst))
|
|
|
|
initial-root? (:component-root? shape-inst)
|
|
|
|
root-inst shape-inst
|
|
root-main (when component
|
|
(ctf/get-component-root library component))]
|
|
|
|
(if component
|
|
(generate-sync-shape-direct-recursive changes
|
|
container
|
|
shape-inst
|
|
component
|
|
library
|
|
shape-main
|
|
root-inst
|
|
root-main
|
|
reset?
|
|
initial-root?
|
|
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- generate-sync-shape-direct-recursive
|
|
[changes container shape-inst component library shape-main root-inst root-main reset? initial-root? 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 (ctf/get-component-container library component)
|
|
|
|
children-inst (vec (ctn/get-direct-children container shape-inst))
|
|
children-main (vec (ctn/get-direct-children component-container shape-main))
|
|
|
|
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?
|
|
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-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]
|
|
(log/debug :msg "Sync shape inverse" :shape (str shape-id))
|
|
(let [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 (ctf/get-ref-shape library component shape-inst)
|
|
|
|
initial-root? (:component-root? shape-inst)
|
|
|
|
root-inst shape-inst
|
|
root-main (ctf/get-component-root library component)]
|
|
|
|
(if component
|
|
(generate-sync-shape-inverse-recursive changes
|
|
container
|
|
shape-inst
|
|
component
|
|
library
|
|
shape-main
|
|
root-inst
|
|
root-main
|
|
initial-root?)
|
|
changes)))
|
|
|
|
(defn- generate-sync-shape-inverse-recursive
|
|
[changes container shape-inst component library shape-main root-inst root-main initial-root?]
|
|
(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))
|
|
|
|
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?))
|
|
|
|
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 mapv 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 %)
|
|
(cph/get-children-with-self (:objects container)
|
|
(:id root-instance)))
|
|
all-parents (into [(:id parent-shape)]
|
|
(cph/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
|
|
true
|
|
(assoc :frame-id (:frame-id parent-shape))
|
|
|
|
(nil? (:shape-ref original-shape))
|
|
(assoc :shape-ref (:id original-shape))
|
|
|
|
set-remote-synced?
|
|
(assoc :remote-synced? true))))
|
|
|
|
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)
|
|
|
|
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 d/preconj
|
|
(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 (cph/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)
|
|
(cph/get-children-with-self (:objects component-container)
|
|
(:id root-main)))
|
|
all-parents (into [(:id component-parent-shape)]
|
|
(cph/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 (: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 d/preconj
|
|
{: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 (cph/page? container) "[P] " "[C] ")
|
|
(:name shape)))
|
|
(let [objects (get container :objects)
|
|
parents (cph/get-parent-ids objects (:id shape))
|
|
parent (first parents)
|
|
children (cph/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 d/preconj
|
|
(make-change
|
|
container
|
|
(as-> {:type :add-obj
|
|
:id id
|
|
:index (cph/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 (cph/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 (cph/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}))
|
|
(update :undo-changes d/preconj (make-change
|
|
container
|
|
{:type :mov-objects
|
|
:parent-id (:parent-id shape)
|
|
:shapes [(:id shape)]
|
|
:index index-before
|
|
:ignore-touched true})))]
|
|
|
|
(if (and (cph/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 (cph/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 d/preconj (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 (cph/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 d/preconj (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 (cph/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 cp/component-sync-attrs))
|
|
roperations []
|
|
uoperations []]
|
|
|
|
(let [attr (first attrs)]
|
|
(if (nil? attr)
|
|
(if (empty? roperations)
|
|
changes
|
|
(let [all-parents (cph/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 d/preconj (make-change
|
|
container
|
|
{:type :mod-obj
|
|
:id (:id dest-shape)
|
|
:operations uoperations}))
|
|
(update :undo-changes conj (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 cp/component-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)
|
|
(d/preconj 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 (cph/page? container)
|
|
(assoc change :page-id (:id container))
|
|
(assoc change :component-id (:id container))))
|
|
|