Synchronize add/delete/move shapes in componentes

This commit is contained in:
Andrés Moya 2020-11-11 13:03:24 +01:00
parent 912be76400
commit ebb7410e5b
5 changed files with 640 additions and 405 deletions

View file

@ -251,7 +251,8 @@
:add-media :mod-media :del-media :add-media :mod-media :del-media
:add-component :mod-component :del-component :add-component :mod-component :del-component
:add-typography :mod-typography :del-typography} (:type change)) :add-typography :mod-typography :del-typography} (:type change))
(and (= (:type change) :mod-obj) (and (#{:add-obj :mod-obj :del-obj
:reg-objects :mov-objects} (:type change))
(some? (:component-id change))))) (some? (:component-id change)))))
(declare update-file) (declare update-file)

View file

@ -435,6 +435,14 @@
:internal.file/recent-colors :internal.file/recent-colors
:internal.file/media])) :internal.file/media]))
(s/def ::container-type #{:page :component})
(s/def ::container
(s/keys :req-un [::container-type
::id
::name
:internal.page/objects]))
(defmulti operation-spec :type) (defmulti operation-spec :type)
(s/def :internal.operations.set/attr keyword?) (s/def :internal.operations.set/attr keyword?)
@ -461,9 +469,9 @@
(s/def :internal.changes.add-obj/obj ::shape) (s/def :internal.changes.add-obj/obj ::shape)
(defmethod change-spec :add-obj [_] (defmethod change-spec :add-obj [_]
(s/keys :req-un [::id ::page-id ::frame-id (s/keys :req-un [::id (or ::page-id ::component-id)
:internal.changes.add-obj/obj] :internal.changes.add-obj/obj]
:opt-un [::parent-id])) :opt-un [::parent-id ::frame-id]))
(s/def ::operation (s/multi-spec operation-spec :type)) (s/def ::operation (s/multi-spec operation-spec :type))
(s/def ::operations (s/coll-of ::operation)) (s/def ::operations (s/coll-of ::operation))
@ -472,16 +480,17 @@
(s/keys :req-un [::id (or ::page-id ::component-id) ::operations])) (s/keys :req-un [::id (or ::page-id ::component-id) ::operations]))
(defmethod change-spec :del-obj [_] (defmethod change-spec :del-obj [_]
(s/keys :req-un [::id ::page-id])) (s/keys :req-un [::id (or ::page-id ::component-id)]))
(s/def :internal.changes.reg-objects/shapes (s/def :internal.changes.reg-objects/shapes
(s/coll-of uuid? :kind vector?)) (s/coll-of uuid? :kind vector?))
(defmethod change-spec :reg-objects [_] (defmethod change-spec :reg-objects [_]
(s/keys :req-un [::page-id :internal.changes.reg-objects/shapes])) (s/keys :req-un [(or ::page-id ::component-id)
:internal.changes.reg-objects/shapes]))
(defmethod change-spec :mov-objects [_] (defmethod change-spec :mov-objects [_]
(s/keys :req-un [::page-id ::parent-id :internal.shape/shapes] (s/keys :req-un [(or ::page-id ::component-id) ::parent-id :internal.shape/shapes]
:opt-un [::index])) :opt-un [::index]))
(defmethod change-spec :add-page [_] (defmethod change-spec :add-page [_]
@ -701,13 +710,10 @@
(assoc data :options (d/dissoc-in (:options data) path))))))) (assoc data :options (d/dissoc-in (:options data) path)))))))
(defmethod process-change :add-obj (defmethod process-change :add-obj
[data {:keys [id obj page-id frame-id parent-id index] :as change}] [data {:keys [id obj page-id component-id frame-id parent-id index] :as change}]
(d/update-in-when data [:pages-index page-id] (let [update-fn (fn [data]
(fn [data]
(let [parent-id (or parent-id frame-id) (let [parent-id (or parent-id frame-id)
objects (:objects data)] objects (:objects data)]
(when (and (contains? objects parent-id)
(contains? objects frame-id))
(let [obj (assoc obj (let [obj (assoc obj
:frame-id frame-id :frame-id frame-id
:parent-id parent-id :parent-id parent-id
@ -720,7 +726,10 @@
(cond (cond
(some #{id} shapes) shapes (some #{id} shapes) shapes
(nil? index) (conj shapes id) (nil? index) (conj shapes id)
:else (cph/insert-at-index shapes index [id])))))))))))) :else (cph/insert-at-index shapes index [id])))))))))]
(if page-id
(d/update-in-when data [:pages-index page-id] update-fn)
(d/update-in-when data [:components component-id] update-fn))))
(defmethod process-change :mod-obj (defmethod process-change :mod-obj
[data {:keys [id page-id component-id operations] :as change}] [data {:keys [id page-id component-id operations] :as change}]
@ -733,8 +742,8 @@
(d/update-in-when data [:components component-id :objects] update-fn)))) (d/update-in-when data [:components component-id :objects] update-fn))))
(defmethod process-change :del-obj (defmethod process-change :del-obj
[data {:keys [page-id id] :as change}] [data {:keys [page-id component-id id] :as change}]
(letfn [(delete-object [objects id] (letfn [(delete-object [objects]
(if-let [target (get objects id)] (if-let [target (get objects id)]
(let [parent-id (cph/get-parent id objects) (let [parent-id (cph/get-parent id objects)
frame-id (:frame-id target) frame-id (:frame-id target)
@ -752,7 +761,9 @@
; dependend objects ; dependend objects
(as-> $ (reduce delete-object $ (:shapes target))))) (as-> $ (reduce delete-object $ (:shapes target)))))
objects))] objects))]
(d/update-in-when data [:pages-index page-id :objects] delete-object id))) (if page-id
(d/update-in-when data [:pages-index page-id :objects] delete-object)
(d/update-in-when data [:components component-id :objects] delete-object))))
(defn rotation-modifiers (defn rotation-modifiers
[center shape angle] [center shape angle]
@ -765,7 +776,7 @@
;; reg-objects operation "regenerates" the values for the parent groups ;; reg-objects operation "regenerates" the values for the parent groups
(defmethod process-change :reg-objects (defmethod process-change :reg-objects
[data {:keys [page-id shapes]}] [data {:keys [page-id component-id shapes]}]
(letfn [(reg-objects [objects] (letfn [(reg-objects [objects]
(reduce #(update %1 %2 update-group %1) objects (reduce #(update %1 %2 update-group %1) objects
(sequence (comp (sequence (comp
@ -797,10 +808,12 @@
(assoc-in [:modifiers :rotation] (:rotation group 0)) (assoc-in [:modifiers :rotation] (:rotation group 0))
(geom/transform-shape))))] (geom/transform-shape))))]
(d/update-in-when data [:pages-index page-id :objects] reg-objects))) (if page-id
(d/update-in-when data [:pages-index page-id :objects] reg-objects)
(d/update-in-when data [:components component-id :objects] reg-objects))))
(defmethod process-change :mov-objects (defmethod process-change :mov-objects
[data {:keys [parent-id shapes index page-id] :as change}] [data {:keys [parent-id shapes index page-id component-id] :as change}]
(letfn [(is-valid-move? [objects shape-id] (letfn [(is-valid-move? [objects shape-id]
(let [invalid-targets (cph/calculate-invalid-targets shape-id objects)] (let [invalid-targets (cph/calculate-invalid-targets shape-id objects)]
(and (not (invalid-targets parent-id)) (and (not (invalid-targets parent-id))
@ -881,7 +894,9 @@
(reduce (partial update-frame-ids frm-id) $ (get-in $ [parent-id :shapes]))) (reduce (partial update-frame-ids frm-id) $ (get-in $ [parent-id :shapes])))
objects)))] objects)))]
(d/update-in-when data [:pages-index page-id :objects] move-objects))) (if page-id
(d/update-in-when data [:pages-index page-id :objects] move-objects)
(d/update-in-when data [:components component-id :objects] move-objects))))
(defmethod process-change :add-page (defmethod process-change :add-page
[data {:keys [id name page]}] [data {:keys [id name page]}]

View file

@ -42,11 +42,25 @@
objects) objects)
nil))) nil)))
(defn make-container
[page-or-component container-type]
(assoc page-or-component
:container-type container-type))
(defn is-page
[container]
(= (:container-type container) :page))
(defn is-component
[container]
(= (:container-type container) :component))
(defn get-container (defn get-container
[page-id component-id local-file] [container-id container-type local-file]
(if (some? page-id) (-> (if (= container-type :page)
(get-in local-file [:pages-index page-id]) (get-in local-file [:pages-index container-id])
(get-in local-file [:components component-id]))) (get-in local-file [:components container-id]))
(assoc :container-type container-type)))
(defn get-shape (defn get-shape
[container shape-id] [container shape-id]
@ -59,6 +73,12 @@
(get-in libraries [file-id :data]))] (get-in libraries [file-id :data]))]
(get-in file [:components component-id]))) (get-in file [:components component-id])))
(defn is-master-of
[shape-master shape-inst]
(and (:shape-ref shape-inst)
(or (= (:shape-ref shape-inst) (:id shape-master))
(= (:shape-ref shape-inst) (:shape-ref shape-master)))))
(defn get-component-root (defn get-component-root
[component] [component]
(get-in component [:objects (:id component)])) (get-in component [:objects (:id component)]))
@ -75,12 +95,12 @@
(defn get-children-objects (defn get-children-objects
"Retrieve all children objects recursively for a given object" "Retrieve all children objects recursively for a given object"
[id objects] [id objects]
(map #(get objects %) (get-children id objects))) (mapv #(get objects %) (get-children id objects)))
(defn get-object-with-children (defn get-object-with-children
"Retrieve a list with an object and all of its children" "Retrieve a vector with an object and all of its children"
[id objects] [id objects]
(map #(get objects %) (cons id (get-children id objects)))) (mapv #(get objects %) (cons id (get-children id objects))))
(defn is-shape-grouped (defn is-shape-grouped
"Checks if a shape is inside a group" "Checks if a shape is inside a group"
@ -210,17 +230,17 @@
:parent-id parent-id) :parent-id parent-id)
(some? (:shapes object)) (some? (:shapes object))
(assoc :shapes (map :id new-direct-children))) (assoc :shapes (mapv :id new-direct-children)))
new-object (update-new-object new-object object) new-object (update-new-object new-object object)
new-objects (concat [new-object] new-children) new-objects (d/concat [new-object] new-children)
updated-object (update-original-object object new-object) updated-object (update-original-object object new-object)
updated-objects (if (identical? object updated-object) updated-objects (if (identical? object updated-object)
updated-children updated-children
(concat [updated-object] updated-children))] (d/concat [updated-object] updated-children))]
[new-object new-objects updated-objects]) [new-object new-objects updated-objects])
@ -232,9 +252,9 @@
(recur (recur
(next child-ids) (next child-ids)
(concat new-direct-children [new-child]) (d/concat new-direct-children [new-child])
(concat new-children new-child-objects) (d/concat new-children new-child-objects)
(concat updated-children updated-child-objects)))))))) (d/concat updated-children updated-child-objects))))))))
(defn indexed-shapes (defn indexed-shapes

View file

@ -32,6 +32,7 @@
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[potok.core :as ptk])) [potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module
(log/set-level! :warn) (log/set-level! :warn)
(declare sync-file) (declare sync-file)
@ -493,16 +494,18 @@
(ptk/reify ::reset-component (ptk/reify ::reset-component
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
;; ===== Uncomment this to debug =====
(log/info :msg "RESET-COMPONENT of shape" :id (str id)) (log/info :msg "RESET-COMPONENT of shape" :id (str id))
(let [[rchanges uchanges] (let [local-file (get state :workspace-data)
(dwlh/generate-sync-shape-and-children-components (get state :current-page-id) libraries (get state :workspace-libraries)
nil container (cph/get-container (get state :current-page-id)
:page
local-file)
[rchanges uchanges]
(dwlh/generate-sync-shape-direct container
id id
(get state :workspace-data) local-file
(get state :workspace-libraries) libraries
true)] true)]
;; ===== Uncomment this to debug =====
(log/debug :msg "RESET-COMPONENT finished" :js/rchanges rchanges) (log/debug :msg "RESET-COMPONENT finished" :js/rchanges rchanges)
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))))) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
@ -516,7 +519,6 @@
(ptk/reify ::update-component (ptk/reify ::update-component
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
;; ===== Uncomment this to debug =====
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id)) (log/info :msg "UPDATE-COMPONENT of shape" :id (str id))
(let [page-id (:current-page-id state) (let [page-id (:current-page-id state)
objects (dwc/lookup-page-objects state page-id) objects (dwc/lookup-page-objects state page-id)
@ -529,7 +531,6 @@
(get state :workspace-data) (get state :workspace-data)
(get state :workspace-libraries))] (get state :workspace-libraries))]
;; ===== Uncomment this to debug =====
(log/debug :msg "UPDATE-COMPONENT finished" :js/rchanges rchanges) (log/debug :msg "UPDATE-COMPONENT finished" :js/rchanges rchanges)
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))))) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))
@ -552,7 +553,6 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
;; ===== Uncomment this to debug =====
(log/info :msg "SYNC-FILE" :file (str (or file-id "local"))) (log/info :msg "SYNC-FILE" :file (str (or file-id "local")))
(let [library-changes [(dwlh/generate-sync-library :components file-id state) (let [library-changes [(dwlh/generate-sync-library :components file-id state)
(dwlh/generate-sync-library :colors file-id state) (dwlh/generate-sync-library :colors file-id state)
@ -566,7 +566,6 @@
uchanges (d/concat [] uchanges (d/concat []
(->> library-changes (remove nil?) (map second) (flatten)) (->> library-changes (remove nil?) (map second) (flatten))
(->> file-changes (remove nil?) (map second) (flatten)))] (->> file-changes (remove nil?) (map second) (flatten)))]
;; ===== Uncomment this to debug =====
(log/debug :msg "SYNC-FILE finished" :js/rchanges rchanges) (log/debug :msg "SYNC-FILE finished" :js/rchanges rchanges)
(rx/concat (rx/concat
(rx/of (dm/hide-tag :sync-dialog)) (rx/of (dm/hide-tag :sync-dialog))
@ -593,14 +592,12 @@
(ptk/reify ::sync-file-2nd-stage (ptk/reify ::sync-file-2nd-stage
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
;; ===== Uncomment this to debug =====
(log/info :msg "SYNC-FILE (2nd stage)" :file (str (or file-id "local"))) (log/info :msg "SYNC-FILE (2nd stage)" :file (str (or file-id "local")))
(let [[rchanges1 uchanges1] (dwlh/generate-sync-file :components nil state) (let [[rchanges1 uchanges1] (dwlh/generate-sync-file :components nil state)
[rchanges2 uchanges2] (dwlh/generate-sync-library :components file-id state) [rchanges2 uchanges2] (dwlh/generate-sync-library :components file-id state)
rchanges (d/concat rchanges1 rchanges2) rchanges (d/concat rchanges1 rchanges2)
uchanges (d/concat uchanges1 uchanges2)] uchanges (d/concat uchanges1 uchanges2)]
(when rchanges (when rchanges
;; ===== Uncomment this to debug =====
(log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges rchanges) (log/debug :msg "SYNC-FILE (2nd stage) finished" :js/rchanges rchanges)
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}))))))) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})))))))

View file

@ -18,6 +18,7 @@
[app.util.logging :as log] [app.util.logging :as log]
[app.util.text :as ut])) [app.util.text :as ut]))
;; Change this to :info :debug or :trace to debug this module
(log/set-level! :warn) (log/set-level! :warn)
(defonce empty-changes [[] []]) (defonce empty-changes [[] []])
@ -36,14 +37,17 @@
(declare has-asset-reference-fn) (declare has-asset-reference-fn)
(declare get-assets) (declare get-assets)
(declare generate-sync-shape-and-children-components) (declare generate-sync-shape-direct)
(declare generate-sync-shape-and-children-normal) (declare generate-sync-shape-direct-recursive)
(declare generate-sync-shape-and-children-nested)
(declare generate-sync-shape-inverse) (declare generate-sync-shape-inverse)
(declare generate-sync-shape-inverse-normal) (declare generate-sync-shape-inverse-recursive)
(declare generate-sync-shape-inverse-nested)
(declare generate-sync-shape<-component) (declare compare-children)
(declare generate-sync-shape->component) (declare concat-changes)
(declare add-shape-to-instance)
(declare add-shape-to-master)
(declare remove-shape)
(declare move-shape)
(declare remove-component-and-ref) (declare remove-component-and-ref)
(declare remove-ref) (declare remove-ref)
(declare reset-touched) (declare reset-touched)
@ -133,9 +137,7 @@
(generate-sync-container asset-type (generate-sync-container asset-type
library-id library-id
state state
page (cph/make-container page :page))]
(:id page)
nil)]
(recur (next pages) (recur (next pages)
(d/concat rchanges page-rchanges) (d/concat rchanges page-rchanges)
(d/concat uchanges page-uchanges))) (d/concat uchanges page-uchanges)))
@ -165,9 +167,8 @@
(generate-sync-container asset-type (generate-sync-container asset-type
library-id library-id
state state
local-component (cph/make-container local-component
nil :component))]
(:id local-component))]
(recur (next local-components) (recur (next local-components)
(d/concat rchanges comp-rchanges) (d/concat rchanges comp-rchanges)
(d/concat uchanges comp-uchanges))) (d/concat uchanges comp-uchanges)))
@ -176,11 +177,11 @@
(defn- generate-sync-container (defn- generate-sync-container
"Generate changes to synchronize all shapes in a particular container "Generate changes to synchronize all shapes in a particular container
(a page or a component) that are linked to the given library." (a page or a component) that are linked to the given library."
[asset-type library-id state container page-id component-id] [asset-type library-id state container]
(if page-id (if (= (:container-type container) :page)
(log/debug :msg "Sync page in local file" :page-id page-id) (log/debug :msg "Sync page in local file" :page-id (:id container))
(log/debug :msg "Sync component in local library" :component-id component-id)) (log/debug :msg "Sync component in local library" :component-id (:id container)))
(let [has-asset-reference? (has-asset-reference-fn asset-type library-id) (let [has-asset-reference? (has-asset-reference-fn asset-type library-id)
linked-shapes (cph/select-objects has-asset-reference? container)] linked-shapes (cph/select-objects has-asset-reference? container)]
@ -192,9 +193,7 @@
(generate-sync-shape asset-type (generate-sync-shape asset-type
library-id library-id
state state
(get container :objects) container
page-id
component-id
shape)] shape)]
(recur (next shapes) (recur (next shapes)
(d/concat rchanges shape-rchanges) (d/concat rchanges shape-rchanges)
@ -241,12 +240,11 @@
(defmulti generate-sync-shape (defmulti generate-sync-shape
"Generate changes to synchronize one shape, that use the given type "Generate changes to synchronize one shape, that use the given type
of asset of the given library." of asset of the given library."
(fn [type _ _ _ _ _ _ _] type)) (fn [type _ _ _ _] type))
(defmethod generate-sync-shape :components (defmethod generate-sync-shape :components
[_ library-id state objects page-id component-id shape] [_ library-id state container shape]
(generate-sync-shape-and-children-components page-id (generate-sync-shape-direct container
component-id
(:id shape) (:id shape)
(get state :workspace-data) (get state :workspace-data)
(get state :workspace-libraries) (get state :workspace-libraries)
@ -275,11 +273,13 @@
(defmethod generate-sync-shape :colors (defmethod generate-sync-shape :colors
[_ library-id state _ page-id component-id shape] [_ library-id state container shape]
;; Synchronize a shape that uses some colors of the library. The value of the ;; Synchronize a shape that uses some colors of the library. The value of the
;; color in the library is copied to the shape. ;; color in the library is copied to the shape.
(let [colors (get-assets library-id :colors state)] (let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))
colors (get-assets library-id :colors state)]
(if (= :text (:type shape)) (if (= :text (:type shape))
(let [update-node (fn [node] (let [update-node (fn [node]
(if-let [color (get colors (:fill-color-ref-id node))] (if-let [color (get colors (:fill-color-ref-id node))]
@ -325,11 +325,13 @@
(conj uoperations uoperation)))))))))) (conj uoperations uoperation))))))))))
(defmethod generate-sync-shape :typographies (defmethod generate-sync-shape :typographies
[_ library-id state _ page-id component-id shape] [_ library-id state container shape]
;; Synchronize a shape that uses some typographies of the library. The attributes ;; Synchronize a shape that uses some typographies of the library. The attributes
;; of the typography are copied to the shape." ;; of the typography are copied to the shape."
(let [typographies (get-assets library-id :typographies state) (let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))
typographies (get-assets library-id :typographies state)
update-node (fn [node] update-node (fn [node]
(if-let [typography (get typographies (:typography-ref-id node))] (if-let [typography (get typographies (:typography-ref-id node))]
(merge node (d/without-keys typography [:name :id])) (merge node (d/without-keys typography [:name :id]))
@ -345,7 +347,7 @@
(get-in state [:workspace-data asset-type]) (get-in state [:workspace-data asset-type])
(get-in state [:workspace-libraries library-id :data asset-type]))) (get-in state [:workspace-libraries library-id :data asset-type])))
(defn generate-sync-shape-and-children-components (defn generate-sync-shape-direct
"Generate changes to synchronize one shape that the root of a component "Generate changes to synchronize one shape that the root of a component
instance, and all its children, from the given component. instance, and all its children, from the given component.
If reset? is false, all atributes of each component shape that have If reset? is false, all atributes of each component shape that have
@ -353,121 +355,99 @@
be copied to this one. be copied to this one.
If reset? is true, all changed attributes will be copied and the 'touched' If reset? is true, all changed attributes will be copied and the 'touched'
flags in the instance shape will be cleared." flags in the instance shape will be cleared."
[page-id component-id shape-id local-file libraries reset?] [container shape-id local-file libraries reset?]
(log/debug :msg "Sync shape and children" :shape (str shape-id) :reset? reset?) (log/debug :msg "Sync shape direct" :shape (str shape-id) :reset? reset?)
(let [container (cph/get-container page-id component-id local-file) (let [shape-inst (cph/get-shape container shape-id)
shape (cph/get-shape container shape-id) component (cph/get-component (:component-id shape-inst)
component (cph/get-component (:component-id shape) (:component-file shape-inst)
(:component-file shape)
local-file local-file
libraries) libraries)
root-shape shape shape-master (cph/get-shape component (:shape-ref shape-inst))
root-component (cph/get-component-root component)]
(generate-sync-shape-and-children-normal page-id root-inst shape-inst
component-id root-master (cph/get-component-root component)]
container
shape (generate-sync-shape-direct-recursive container
shape-inst
component component
root-shape shape-master
root-component root-inst
reset?))) root-master
{:omit-touched? (not reset?)
:reset-touched? reset?
:set-touched? false})))
(defn- generate-sync-shape-and-children-normal (defn- generate-sync-shape-direct-recursive
[page-id component-id container shape component root-shape root-component reset?] [container shape-inst component shape-master root-inst root-master options]
(log/trace :msg "Sync shape (normal)" (log/trace :msg "Sync shape direct"
:shape (str (:name shape)) :shape (str (:name shape-inst))
:component (:name component)) :component (:name component))
(let [[rchanges uchanges]
(generate-sync-shape<-component shape
root-shape
root-component
component
page-id
component-id
reset?)
children-ids (get shape :shapes [])] (let [root-inst (if (:component-id shape-inst)
shape-inst
(loop [children-ids (seq children-ids) root-inst)
rchanges rchanges root-master (if (:component-id shape-inst)
uchanges uchanges] shape-master
(let [child-id (first children-ids)] root-master)
(if (nil? child-id)
[rchanges uchanges]
(let [child-shape (cph/get-shape container child-id)
[child-rchanges child-uchanges]
(if (nil? (:component-id child-shape))
(generate-sync-shape-and-children-normal page-id
component-id
container
child-shape
component
root-shape
root-component
reset?)
(generate-sync-shape-and-children-nested page-id
component-id
container
child-shape
component
root-shape
root-component
reset?))]
(recur (next children-ids)
(d/concat rchanges child-rchanges)
(d/concat uchanges child-uchanges))))))))
(defn- generate-sync-shape-and-children-nested
[page-id component-id container shape component root-shape root-component reset?]
(log/trace :msg "Sync shape (nested)"
:shape (str (:name shape))
:component (:name component))
(let [component-shape (d/seek #(= (:shape-ref %)
(:shape-ref shape))
(vals (:objects component)))
root-shape (if (:component-id shape)
shape
root-shape)
root-component (if (:component-id shape)
component-shape
root-component)
[rchanges uchanges] [rchanges uchanges]
(update-attrs shape (update-attrs shape-inst
component-shape shape-master
root-shape root-inst
root-component root-master
page-id container
component-id options)
children-inst (mapv #(cph/get-shape container %)
(:shapes shape-inst))
children-master (mapv #(cph/get-shape component %)
(:shapes shape-master))
only-inst (fn [shape-inst]
(remove-shape shape-inst
container))
only-master (fn [shape-master]
(add-shape-to-instance shape-master
component
container
root-inst
root-master))
both (fn [shape-inst shape-master]
(let [options (if-not (:component-id shape-inst)
options
{:omit-touched? false {:omit-touched? false
:reset-touched? false :reset-touched? false
:set-touched? false :set-touched? false
:copy-touched? true}) :copy-touched? true})]
children-ids (get shape :shapes [])] (generate-sync-shape-direct-recursive container
shape-inst
component
shape-master
root-inst
root-master
options)))
(loop [children-ids (seq children-ids) moved (fn [shape-inst shape-master]
rchanges rchanges (move-shape
uchanges uchanges] shape-inst
(let [child-id (first children-ids)] (d/index-of children-inst shape-inst)
(if (nil? child-id) (d/index-of children-master shape-master)
[rchanges uchanges] container))
(let [child-shape (cph/get-shape container child-id)
[child-rchanges child-uchanges] [child-rchanges child-uchanges]
(generate-sync-shape-and-children-nested page-id (compare-children children-inst
component-id children-master
container only-inst
child-shape only-master
component both
root-shape moved
root-component false)]
reset?)]
(recur (next children-ids) [(d/concat rchanges child-rchanges)
(d/concat rchanges child-rchanges) (d/concat uchanges child-uchanges)]))
(d/concat uchanges child-uchanges))))))))
(defn- generate-sync-shape-inverse (defn- generate-sync-shape-inverse
"Generate changes to update the component a shape is linked to, from "Generate changes to update the component a shape is linked to, from
@ -478,157 +458,372 @@
And if the component shapes are, in turn, instances of a second component, And if the component shapes are, in turn, instances of a second component,
their 'touched' flags will be set accordingly." their 'touched' flags will be set accordingly."
[page-id shape-id local-file libraries] [page-id shape-id local-file libraries]
(log/debug :msg "Sync inverse shape and children" :shape (str shape-id)) (log/debug :msg "Sync shape inverse" :shape (str shape-id))
(let [page (cph/get-container page-id nil local-file) (let [container (cph/get-container page-id :page local-file)
shape (cph/get-shape page shape-id) shape-inst (cph/get-shape container shape-id)
component (cph/get-component (:component-id shape) component (cph/get-component (:component-id shape-inst)
(:component-file shape) (:component-file shape-inst)
local-file local-file
libraries) libraries)
root-shape shape shape-master (cph/get-shape component (:shape-ref shape-inst))
root-component (cph/get-component-root component)]
(generate-sync-shape-inverse-normal page root-inst shape-inst
shape root-master (cph/get-component-root component)]
(generate-sync-shape-inverse-recursive container
shape-inst
component component
root-shape shape-master
root-component))) root-inst
root-master
{:omit-touched? false
:reset-touched? false
:set-touched? true})))
(defn- generate-sync-shape-inverse-normal (defn- generate-sync-shape-inverse-recursive
[page shape component root-shape root-component] [container shape-inst component shape-master root-inst root-master options]
(log/trace :msg "Sync shape inverse (normal)" (log/trace :msg "Sync shape inverse"
:shape (str (:name shape)) :shape (str (:name shape-inst))
:component (:name component)) :component (:name component))
(let [[rchanges uchanges]
(generate-sync-shape->component shape
root-shape
root-component
component
(:id page))
children-ids (get shape :shapes [])] (let [root-inst (if (:component-id shape-inst)
shape-inst
root-inst)
root-master (if (:component-id shape-inst)
shape-master
root-master)
(loop [children-ids (seq children-ids) component-container (cph/make-container component :component)
rchanges rchanges
uchanges uchanges]
(let [child-id (first children-ids)]
(if (nil? child-id)
[rchanges uchanges]
(let [child-shape (cph/get-shape page child-id)
[child-rchanges child-uchanges]
(if (nil? (:component-id child-shape))
(generate-sync-shape-inverse-normal page
child-shape
component
root-shape
root-component)
(generate-sync-shape-inverse-nested page
child-shape
component
root-shape
root-component))]
(recur (next children-ids)
(d/concat rchanges child-rchanges)
(d/concat uchanges child-uchanges))))))))
(defn- generate-sync-shape-inverse-nested
[page shape component root-shape root-component]
(log/trace :msg "Sync shape inverse (nested)"
:shape (str (:name shape))
:component (:name component))
(let [component-shape (d/seek #(= (:shape-ref %)
(:shape-ref shape))
(vals (:objects component)))
root-shape (if (:component-id shape)
shape
root-shape)
root-component (if (:component-id shape)
component-shape
root-component)
[rchanges uchanges] [rchanges uchanges]
(update-attrs component-shape (concat-changes
shape (update-attrs shape-master
root-component shape-inst
root-shape root-master
nil root-inst
(:id component) component-container
options)
(if (:set-touched? options)
(reset-touched shape-inst container)
empty-changes))
children-inst (mapv #(cph/get-shape container %)
(:shapes shape-inst))
children-master (mapv #(cph/get-shape component %)
(:shapes shape-master))
only-inst (fn [shape-inst]
(add-shape-to-master shape-inst
component
container
root-inst
root-master))
only-master (fn [shape-master]
(remove-shape shape-master
component-container))
both (fn [shape-inst shape-master]
(let [options (if-not (:component-id shape-inst)
options
{:omit-touched? false {:omit-touched? false
:reset-touched? false :reset-touched? false
:set-touched? false :set-touched? false
:copy-touched? true}) :copy-touched? true})]
children-ids (get shape :shapes [])] (generate-sync-shape-inverse-recursive container
shape-inst
component
shape-master
root-inst
root-master
options)))
(loop [children-ids (seq children-ids) moved (fn [shape-inst shape-master]
rchanges rchanges (move-shape
uchanges uchanges] shape-master
(let [child-id (first children-ids)] (d/index-of children-master shape-master)
(if (nil? child-id) (d/index-of children-inst shape-inst)
[rchanges uchanges] component-container))
(let [child-shape (cph/get-shape page child-id)
[child-rchanges child-uchanges] [child-rchanges child-uchanges]
(generate-sync-shape-inverse-nested page (compare-children children-inst
child-shape children-master
component only-inst
root-shape only-master
root-component)] both
(recur (next children-ids) moved
(d/concat rchanges child-rchanges) true)]
(d/concat uchanges child-uchanges))))))))
(defn- generate-sync-shape<-component [(d/concat rchanges child-rchanges)
"Generate changes to synchronize one shape that is linked to other shape (d/concat uchanges child-uchanges)]))
inside a component. Same considerations as above about reset-touched?"
[shape root-shape root-component component page-id component-id reset?]
(if (nil? component)
(remove-component-and-ref shape page-id component-id)
(let [component-shape (get (:objects component) (:shape-ref shape))]
(if (nil? component-shape)
(remove-ref shape page-id component-id)
(update-attrs shape
component-shape
root-shape
root-component
page-id
component-id
{:omit-touched? (not reset?)
:reset-touched? reset?
:set-touched? false})))))
(defn- generate-sync-shape->component
"Generate changes to synchronize one shape inside a component, with other
shape that is linked to it."
[shape root-shape root-component component page-id]
(if (nil? component)
empty-changes
(let [component-shape (get (:objects component) (:shape-ref shape))]
(if (nil? component-shape)
empty-changes
(let [[rchanges1 uchanges1]
(update-attrs component-shape
shape
root-component
root-shape
nil
(:id root-component)
{:omit-touched? false
:reset-touched? false
:set-touched? true})
[rchanges2 uchanges2]
(reset-touched shape
page-id
nil)]
[(d/concat rchanges1 rchanges2)
(d/concat uchanges2 uchanges2)])))))
; ---- Operation generation helpers ---- ; ---- Operation generation helpers ----
(defn- compare-children
[children-inst children-master only-inst-cb only-master-cb both-cb moved-cb inverse?]
(loop [children-inst (seq (or children-inst []))
children-master (seq (or children-master []))
[rchanges uchanges] [[] []]]
(let [child-inst (first children-inst)
child-master (first children-master)]
(cond
(and (nil? child-inst) (nil? child-master))
[rchanges uchanges]
(nil? child-inst)
(reduce (fn [changes child]
(concat-changes changes (only-master-cb child)))
[rchanges uchanges]
children-master)
(nil? child-master)
(reduce (fn [changes child]
(concat-changes changes (only-inst-cb child)))
[rchanges uchanges]
children-inst)
:else
(if (cph/is-master-of child-master child-inst)
(recur (next children-inst)
(next children-master)
(concat-changes [rchanges uchanges]
(both-cb child-inst child-master)))
(let [child-inst' (d/seek #(cph/is-master-of child-master %)
children-inst)
child-master' (d/seek #(cph/is-master-of % child-inst)
children-master)]
(cond
(nil? child-inst')
(recur children-inst
(next children-master)
(concat-changes [rchanges uchanges]
(only-master-cb child-master)))
(nil? child-master')
(recur (next children-inst)
children-master
(concat-changes [rchanges uchanges]
(only-inst-cb child-inst)))
:else
(if inverse?
(recur (next children-inst)
(remove #(= (:id %) (:id child-master')) children-master)
(-> [rchanges uchanges]
(concat-changes (both-cb child-inst' child-master))
(concat-changes (moved-cb child-inst child-master'))))
(recur (remove #(= (:id %) (:id child-inst')) children-inst)
(next children-master)
(-> [rchanges uchanges]
(concat-changes (both-cb child-inst child-master'))
(concat-changes (moved-cb child-inst' child-master))))))))))))
(defn concat-changes
[[rchanges1 uchanges1] [rchanges2 uchanges2]]
[(d/concat rchanges1 rchanges2)
(d/concat uchanges1 uchanges2)])
(defn- add-shape-to-instance
[component-shape component page root-instance root-master]
(log/info :msg (str "ADD [P] " (:name component-shape)))
(let [component-parent-shape (cph/get-shape component (:parent-id component-shape))
parent-shape (d/seek #(cph/is-master-of component-parent-shape %)
(cph/get-object-with-children (:id root-instance)
(:objects page)))
all-parents (vec (cons (:id parent-shape)
(cph/get-parents parent-shape (:objects page))))
update-new-shape (fn [new-shape original-shape]
(let [new-pos (calc-new-pos new-shape
original-shape
root-instance
root-master)]
(cond-> new-shape
true
(assoc :shape-ref (:id original-shape)
:frame-id (:frame-id parent-shape)
:x (:x new-pos)
:y (:y new-pos))
(:component-id original-shape)
(assoc :component-id (:component-id original-shape))
(:component-file original-shape)
(assoc :component-file (:component-file original-shape))
(:component-root original-shape)
(assoc :component-root (:component-root original-shape))
(:touched original-shape)
(assoc :touched (:touched original-shape)))))
update-original-shape (fn [original-shape new-shape]
original-shape)
[new-shape new-shapes _]
(cph/clone-object component-shape
(:id parent-shape)
(get page :objects)
update-new-shape
update-original-shape)
rchanges (d/concat
(mapv (fn [shape']
{:type :add-obj
:id (:id shape')
:page-id (:id page)
:parent-id (:parent-id shape')
:obj shape'})
new-shapes)
[{:type :reg-objects
:page-id (:id page)
:shapes all-parents}])
uchanges (mapv (fn [shape']
{:type :del-obj
:id (:id shape')
:page-id (:id page)})
new-shapes)]
[rchanges uchanges]))
(defn- add-shape-to-master
[shape component page root-instance root-master]
(log/info :msg (str "ADD [C] " (:name shape)))
(let [parent-shape (cph/get-shape page (:parent-id shape))
component-parent-shape (d/seek #(cph/is-master-of % parent-shape)
(cph/get-object-with-children (:id root-master)
(:objects component)))
all-parents (vec (cons (:id component-parent-shape)
(cph/get-parents component-parent-shape (:objects component))))
update-new-shape (fn [new-shape original-shape]
(let [new-pos (calc-new-pos new-shape
original-shape
root-master
root-instance)]
(assoc new-shape
:x (:x new-pos)
:y (:y new-pos))))
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]
(cph/clone-object shape
(:shape-ref parent-shape)
(get page :objects)
update-new-shape
update-original-shape)
rchanges (d/concat
(mapv (fn [shape']
{:type :add-obj
:id (:id shape')
:component-id (:id component)
:parent-id (:parent-id shape')
:obj shape'})
new-shapes)
[{:type :reg-objects
:component-id (:id component)
:shapes all-parents}]
(mapv (fn [shape']
{: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')}]})
updated-shapes))
uchanges (mapv (fn [shape']
{:type :del-obj
:id (:id shape')
:page-id (:id page)})
new-shapes)]
[rchanges uchanges]))
(defn- remove-shape
[shape container]
(let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))
objects (get container :objects)
parents (cph/get-parents (:id shape) objects)
children (cph/get-children (:id shape) objects)
add-change (fn [id]
(let [shape' (get objects id)]
(d/without-nils {:type :add-obj
:id id
:page-id page-id
:component-id component-id
:index (cph/position-on-parent id objects)
:frame-id (:frame-id shape')
:parent-id (:parent-id shape')
:obj shape'})))
rchanges [(d/without-nils {:type :del-obj
:page-id page-id
:component-id component-id
:id (:id shape)})]
uchanges (d/concat
[(add-change (:id shape))]
(map add-change children)
[(d/without-nils {:type :reg-objects
:page-id page-id
:component-id component-id
:shapes (vec parents)})])]
[rchanges uchanges]))
(defn- move-shape
[shape index-before index-after container]
(log/info :msg (str "MOVE "
(:name shape)
" "
index-before
" -> "
index-after))
(let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))]
(let [rchanges [(d/without-nils {:type :mov-objects
:parent-id (:parent-id shape)
:shapes [(:id shape)]
:index index-after
:page-id page-id
:component-id component-id})]
uchanges [(d/without-nils {:type :mov-objects
:parent-id (:parent-id shape)
:shapes [(:id shape)]
:index index-before
:page-id page-id
:component-id component-id})]]
[rchanges uchanges])))
(defn- remove-component-and-ref (defn- remove-component-and-ref
[shape page-id component-id] [shape container]
(let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))]
[[(d/without-nils {:type :mod-obj [[(d/without-nils {:type :mod-obj
:id (:id shape) :id (:id shape)
:page-id page-id :page-id page-id
@ -664,10 +859,12 @@
:attr :shape-ref :attr :shape-ref
:val (:shape-ref shape)} :val (:shape-ref shape)}
{:type :set-touched {:type :set-touched
:touched (:touched shape)}]})]]) :touched (:touched shape)}]})]]))
(defn- -remove-ref (defn- remove-ref
[shape page-id component-id] [shape container]
(let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))]
[[(d/without-nils {:type :mod-obj [[(d/without-nils {:type :mod-obj
:id (:id shape) :id (:id shape)
:page-id page-id :page-id page-id
@ -685,10 +882,12 @@
:attr :shape-ref :attr :shape-ref
:val (:shape-ref shape)} :val (:shape-ref shape)}
{:type :set-touched {:type :set-touched
:touched (:touched shape)}]})]]) :touched (:touched shape)}]})]]))
(defn- reset-touched (defn- reset-touched
[shape page-id component-id] [shape container]
(let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))]
[[(d/without-nils {:type :mod-obj [[(d/without-nils {:type :mod-obj
:id (:id shape) :id (:id shape)
:page-id page-id :page-id page-id
@ -700,7 +899,7 @@
:page-id page-id :page-id page-id
:component-id component-id :component-id component-id
:operations [{:type :set-touched :operations [{:type :set-touched
:touched (:touched shape)}]})]]) :touched (:touched shape)}]})]]))
(defn- update-attrs (defn- update-attrs
"The main function that implements the sync algorithm. Copy "The main function that implements the sync algorithm. Copy
@ -711,7 +910,7 @@
the dest shape. the dest shape.
If set-touched? is true, the corresponding 'touched' flags will be If set-touched? is true, the corresponding 'touched' flags will be
set in dest shape if they are different than their current values." set in dest shape if they are different than their current values."
[dest-shape origin-shape dest-root origin-root page-id component-id [dest-shape origin-shape dest-root origin-root container
{:keys [omit-touched? reset-touched? set-touched? copy-touched?] {:keys [omit-touched? reset-touched? set-touched? copy-touched?]
:as options :or {omit-touched? false :as options :or {omit-touched? false
reset-touched? false reset-touched? false
@ -721,10 +920,13 @@
(log/info :msg (str "SYNC " (log/info :msg (str "SYNC "
(:name origin-shape) (:name origin-shape)
" -> " " -> "
(if page-id "[W] " "[C] ") (if (cph/is-page container) "[P] " "[C] ")
(:name dest-shape))) (:name dest-shape)))
(let [; The position attributes need a special sync algorith, because we do (let [page-id (when (cph/is-page container) (:id container))
component-id (when (cph/is-component container) (:id container))
; The position attributes need a special sync algorith, because we do
; not synchronize the absolute position, but the position relative of ; not synchronize the absolute position, but the position relative of
; the container shape of the component. ; the container shape of the component.
new-pos (calc-new-pos dest-shape origin-shape dest-root origin-root) new-pos (calc-new-pos dest-shape origin-shape dest-root origin-root)