⚡ Reduce commit cost when dropping large selections

Compute the ignore tree in one pass sharing transforms and component
roots, collect children ids into one transient vector, skip the
builder local apply on plain translations and track WASM shape
changes in a JS Map.

common/src/app/common/files/changes_builder.cljc

@@ -187,7 +187,8 @@
   (assert (check-changes changes)
           "expected valid changes")
 
-  (if-let [file-data (::file-data (meta changes))]
+  (if-let [file-data (and (not (::skip-local? (meta changes)))
+                          (::file-data (meta changes)))]
     (let [library-data  (::library-data (meta changes))
           index         (::applied-changes-count (meta changes))
           redo-changes  (:redo-changes changes)
@@ -206,6 +207,11 @@
                  ::applied-changes-count (count redo-changes)))
     changes))
 
+(defn skip-local
+  "Stop applying changes to the builder objects."
+  [changes skip?]
+  (vary-meta changes assoc ::skip-local? skip?))
+
 (defn- without-changes-local
   "Append changes through `f` without applying them to the mounted page's
   working state."

common/src/app/common/files/helpers.cljc

@@ -162,14 +162,15 @@
   ([objects id {:keys [ignore-children-fn]
                 ;;ignore-children-fn should receive a shape and return a boolean
                 :or {ignore-children-fn (constantly false)}}]
-   (letfn [(get-children-ids-rec [id processed]
-             (when-not (contains? processed id)
-               (when-let [shapes (as-> (get objects id) $
-                                   (:shapes $)
-                                   (remove ignore-children-fn $)
-                                   (some-> $ vec))]
-                 (into shapes (mapcat #(get-children-ids-rec % (conj processed id))) shapes))))]
-     (get-children-ids-rec id #{}))))
+   (letfn [(collect [result id processed]
+             (if (contains? processed id)
+               result
+               (let [shapes    (into [] (remove ignore-children-fn) (dm/get-in objects [id :shapes]))
+                     processed (conj processed id)]
+                 (reduce #(collect %1 %2 processed)
+                         (reduce conj! result shapes)
+                         shapes))))]
+     (persistent! (collect (transient []) id #{})))))
 
 (defn get-children-ids-with-self
   [objects id]

frontend/src/app/main/data/changes.cljs

@@ -133,14 +133,14 @@
 
         (if (and (not ignore-wasm?) (features/active-feature? state "render-wasm/v1"))
           ;; Update the wasm model
-          (let [shape-changes (volatile! {})
+          (let [shape-changes (js/Map.)
 
                 state
                 (binding [cts/*shape-changes* shape-changes]
                   (update-in state [:files file-id :data] apply-changes))]
 
             (let [objects (dm/get-in state [:files file-id :data :pages-index (:current-page-id state) :objects])]
-              (wasm.shape/process-shape-changes! objects @shape-changes))
+              (wasm.shape/process-shape-changes! objects (es6-iterator-seq (.entries shape-changes))))
 
             state)
 

frontend/src/app/main/data/workspace/modifiers.cljs

@@ -232,55 +232,78 @@
          (map #(get objects %))
          (reduce get-ignore-tree nil))))
 
+(defn- cached-transform
+  [transforms]
+  (let [cache (js/Map.)]
+    (fn [shape]
+      (let [id     (dm/get-prop shape :id)
+            cached (.get cache id)]
+        (if (and (some? cached) (identical? shape (aget cached 0)))
+          (aget cached 1)
+          (let [result (gsh/apply-transform shape (get transforms id))]
+            (.set cache id #js [shape result])
+            result))))))
+
 (defn calculate-ignore-tree-wasm
   "Retrieves a map with the flag `ignore-geometry?` given a tree of modifiers"
-  [transforms objects]
+  ([transforms objects]
+   (calculate-ignore-tree-wasm transforms objects (cached-transform transforms)))
+  ([transforms objects transform]
+   (let [order (into {} (map-indexed (fn [i id] [id i])) (keys transforms))
 
-  (letfn [(get-ignore-tree
-            ([ignore-tree shape]
-             (let [shape-id (dm/get-prop shape :id)
-                   transformed-shape (gsh/apply-transform shape (get transforms shape-id))
+         component-shape
+         (fn [shape parent parent-component]
+           (cond
+             (cfh/root? shape) nil
+             (ctk/instance-root? shape) shape
+             (and (ctk/instance-head? shape) (not (ctk/in-component-copy? parent))) shape
+             :else parent-component))
 
-                   root
-                   (if (:component-root shape)
-                     shape
-                     (ctn/get-component-shape objects shape {:allow-main? true}))
+         walk
+         (fn walk [ignore-tree shape component latest]
+           (let [index  (get order (dm/get-prop shape :id))
+                 latest (if (and (some? index) (or (nil? latest) (> index (nth latest 0))))
+                          (if (some? component)
+                            [index component (transform component)]
+                            latest)
+                          latest)
+                 ignore-tree
+                 (if (and (some? latest) (ctk/in-component-copy? shape))
+                   (let [[_ root transformed-root] latest]
+                     (assoc ignore-tree
+                            (dm/get-prop shape :id)
+                            (check-delta shape root (transform shape) transformed-root)))
+                   ignore-tree)]
+             (reduce (fn [ignore-tree child]
+                       (walk ignore-tree child (component-shape child shape component) latest))
+                     ignore-tree
+                     (map (d/getf objects) (:shapes shape)))))
 
-                   transformed-root
-                   (if (:component-root shape)
-                     transformed-shape
-                     (gsh/apply-transform root (get transforms (:id root))))]
+         under-transform (volatile! {})
 
-               (get-ignore-tree ignore-tree shape transformed-shape root transformed-root)))
-
-            ([ignore-tree shape root transformed-root]
-             (let [shape-id (dm/get-prop shape :id)
-                   transformed-shape (gsh/apply-transform shape (get transforms shape-id))]
-               (get-ignore-tree ignore-tree shape transformed-shape root transformed-root)))
-
-            ([ignore-tree shape transformed-shape root transformed-root]
-             (let [shape-id (dm/get-prop shape :id)
-
-                   ignore-tree
-                   (cond-> ignore-tree
-                     (and (some? root) (ctk/in-component-copy? shape))
-                     (assoc
-                      shape-id
-                      (check-delta shape root transformed-shape transformed-root)))
-
-                   set-child
-                   (fn [ignore-tree child]
-                     (get-ignore-tree ignore-tree child root transformed-root))]
-
-               (->> (:shapes shape)
-                    (map (d/getf objects))
-                    (reduce set-child ignore-tree)))))]
-
-    ;; we check twice because we want only to search parents of components but once the
-    ;; tree is traversed we only want to process the objects in components
-    (->> (keys transforms)
-         (map #(get objects %))
-         (reduce get-ignore-tree nil))))
+         under-transform?
+         (fn under-transform? [id]
+           (let [parent-id (dm/get-in objects [id :parent-id])]
+             (cond
+               (or (nil? parent-id) (= parent-id id)) false
+               (contains? order parent-id) true
+               :else
+               (let [cached (get @under-transform parent-id ::none)]
+                 (if (= cached ::none)
+                   (let [result (under-transform? parent-id)]
+                     (vswap! under-transform assoc parent-id result)
+                     result)
+                   cached)))))]
+     (->> (keys transforms)
+          (remove under-transform?)
+          (keep #(get objects %))
+          (reduce (fn [ignore-tree shape]
+                    (let [parent (get objects (:parent-id shape))]
+                      (walk ignore-tree
+                            shape
+                            (component-shape shape parent (ctn/get-component-shape objects parent {:allow-main? true}))
+                            nil)))
+                  nil)))))
 
 (defn assoc-position-data
   [shape position-data old-shape]
@@ -865,8 +888,11 @@
                   :else
                   (into {} (wasm.api/propagate-modifiers geometry-entries snap-pixel? snap-ignore-axis)))
 
+                transform-shape
+                (cached-transform transforms)
+
                 ignore-tree
-                (calculate-ignore-tree-wasm transforms objects)
+                (calculate-ignore-tree-wasm transforms objects transform-shape)
 
                 options
                 (-> params
@@ -897,12 +923,9 @@
 
                 update-shape
                 (fn [shape]
-                  (let [shape-id  (dm/get-prop shape :id)
-                        transform (get transforms shape-id)
-                        modifiers (dm/get-in modif-tree [shape-id :modifiers])]
-                    (-> shape
-                        (gsh/apply-transform transform)
-                        (ctm/apply-structure-modifiers modifiers))))
+                  (-> shape
+                      (transform-shape)
+                      (ctm/apply-structure-modifiers (dm/get-in modif-tree [(dm/get-prop shape :id) :modifiers]))))
 
                 undo-id (js/Symbol)]
 

frontend/src/app/main/data/workspace/shapes.cljs

@@ -212,10 +212,19 @@
                objects   (dsh/lookup-page-objects state page-id)
                ids       (into [] (filter some?) ids)
 
+               skip-local?
+               (and translation?
+                    (some? resize-ids)
+                    (not-any? (fn [id]
+                                (some #(cfh/group-like-shape? objects %)
+                                      (cons id (cfh/get-parent-ids objects id))))
+                              resize-ids))
+
                changes
                (-> (pcb/empty-changes it page-id)
                    (pcb/set-save-undo? save-undo?)
                    (pcb/set-stack-undo? stack-undo?)
+                   (pcb/skip-local skip-local?)
                    (cls/generate-update-shapes ids
                                                update-fn
                                                objects

frontend/src/app/render_wasm/shape.cljs

@@ -347,10 +347,15 @@
 ;; `conj` empty set initialization
 (def conj* (fnil conj (d/ordered-set)))
 
+(defn- track-change!
+  [self k]
+  (when-let [changes shape/*shape-changes*]
+    (let [id (:id self)]
+      (.set changes id (conj* (.get changes id) k)))))
+
 (defn- impl-assoc
   [self k v]
-  (when shape/*shape-changes*
-    (vswap! shape/*shape-changes* update (:id self) conj* k))
+  (track-change! self k)
 
   (case k
     :id
@@ -378,8 +383,7 @@
 
 (defn- impl-dissoc
   [self k]
-  (when shape/*shape-changes*
-    (vswap! shape/*shape-changes* update (:id self) conj* k))
+  (track-change! self k)
 
   (case k
     :id

frontend/test/frontend_tests/logic/ignore_tree_test.cljs

@@ -0,0 +1,56 @@
+;; 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 SUBSIDIARY SL
+
+(ns frontend-tests.logic.ignore-tree-test
+  (:require
+   [app.common.files.helpers :as cfh]
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.test-helpers.compositions :as ctho]
+   [app.common.test-helpers.files :as cthf]
+   [app.common.test-helpers.ids-map :as cthi]
+   [app.common.types.component :as ctk]
+   [app.main.data.workspace.modifiers :as dwm]
+   [cljs.test :as t :include-macros true]))
+
+(t/use-fixtures :each {:before cthi/reset-idmap!})
+
+(defn- setup
+  []
+  (let [file (-> (cthf/sample-file :file1)
+                 (ctho/add-frame :board)
+                 (ctho/add-nested-component-with-copy :component1 :main1-root :main1-child
+                                                      :component2 :main2-root :nested-head
+                                                      :copy2-root
+                                                      :copy2-root-params {:parent-label :board}))]
+    (:objects (cthf/current-page file))))
+
+(defn- ignore-tree
+  [objects moved-ids]
+  (let [move (gmt/translate-matrix (gpt/point 10 20))]
+    (dwm/calculate-ignore-tree-wasm (zipmap moved-ids (repeat move)) objects)))
+
+(defn- copy-ids
+  [objects]
+  (->> (cfh/get-children-ids-with-self objects (cthi/id :copy2-root))
+       (filter #(ctk/in-component-copy? (get objects %)))))
+
+(t/deftest moving-a-board-keeps-its-copies-untouched
+  (let [objects (setup)
+        tree    (ignore-tree objects (cfh/get-children-ids-with-self objects (cthi/id :board)))]
+    (t/is (seq (copy-ids objects)))
+    (t/is (every? #(true? (get tree %)) (copy-ids objects)))))
+
+(t/deftest moving-a-copy-keeps-its-children-untouched
+  (let [objects (setup)
+        tree    (ignore-tree objects (cfh/get-children-ids-with-self objects (cthi/id :copy2-root)))]
+    (t/is (every? #(true? (get tree %)) (copy-ids objects)))))
+
+(t/deftest moving-a-shape-inside-a-copy-touches-it
+  (let [objects (setup)
+        rect-id (last (copy-ids objects))
+        tree    (ignore-tree objects [rect-id])]
+    (t/is (false? (get tree rect-id)))))

frontend/test/frontend_tests/runner.cljs

@@ -46,6 +46,7 @@
    [frontend-tests.logic.copying-and-duplicating-test]
    [frontend-tests.logic.frame-guides-test]
    [frontend-tests.logic.groups-test]
+   [frontend-tests.logic.ignore-tree-test]
    [frontend-tests.logic.nudge-selected-shapes-test]
    [frontend-tests.logic.pasting-in-containers-test]
    [frontend-tests.logic.path-actions-test]
@@ -181,6 +182,7 @@
    'frontend-tests.logic.copying-and-duplicating-test
    'frontend-tests.logic.frame-guides-test
    'frontend-tests.logic.groups-test
+   'frontend-tests.logic.ignore-tree-test
    'frontend-tests.logic.nudge-selected-shapes-test
    'frontend-tests.logic.path-actions-test
    'frontend-tests.logic.path-clipboard-test