⚡ Performance improvements

common/src/app/common/geom/shapes/modifiers.cljc

@@ -46,46 +46,51 @@
    :expr (or (nil? ids) (set? ids))
    :hint (dm/str "tree sequence from not set: " ids))
 
-  (letfn [(get-tree-root ;; Finds the tree root for the current id
+  (let [get-tree-root
-            [id]
+        (fn ;; Finds the tree root for the current id
+          [id]
 
-            (loop [current id
+          (loop [current id
-                   result  id]
+                 result  id]
-              (let [shape (get objects current)
+            (let [shape (get objects current)
-                    parent (get objects (:parent-id shape))]
+                  parent (get objects (:parent-id shape))]
-                (cond
+              (cond
-                  (or (not shape) (= uuid/zero current))
+                (or (not shape) (= uuid/zero current))
+                result
+
+                ;; Frame found, but not layout we return the last layout found (or the id)
+                (and (= :frame (:type parent))
+                     (not (ctl/any-layout? parent)))
+                result
+
+                ;; Layout found. We continue upward but we mark this layout
+                (ctl/any-layout? parent)
+                (recur (:id parent) (:id parent))
+
+                ;; If group or boolean or other type of group we continue with the last result
+                :else
+                (recur (:id parent) result)))))
+
+        is-child? #(cph/is-child? objects %1 %2)
+
+        calculate-common-roots
+        (fn ;; Given some roots retrieves the minimum number of tree roots
+          [result id]
+          (if (= id uuid/zero)
+            result
+            (let [root (get-tree-root id)
+
+                  ;; Remove the children from the current root
                   result
+                  (if (cph/has-children? objects root)
+                    (into #{} (remove #(is-child? root %)) result)
+                    result)
 
-                  ;; Frame found, but not layout we return the last layout found (or the id)
+                  root-parents (cph/get-parent-ids objects root)
-                  (and (= :frame (:type parent))
+                  contains-parent? (some #(contains? result %) root-parents)]
-                       (not (ctl/layout? parent)))
+              (cond-> result
-                  result
+                (not contains-parent?)
-
+                (conj root)))))]
-                  ;; Layout found. We continue upward but we mark this layout
-                  (ctl/layout? parent)
-                  (recur (:id parent) (:id parent))
-
-                  ;; If group or boolean or other type of group we continue with the last result
-                  :else
-                  (recur (:id parent) result)))))
-
-          (calculate-common-roots ;; Given some roots retrieves the minimum number of tree roots
-            [result id]
-            (if (= id uuid/zero)
-              result
-              (let [root (get-tree-root id)
-
-                    ;; Remove the children from the current root
-                    result
-                    (into #{} (remove #(cph/is-child? objects root %)) result)
-
-                    contains-parent?
-                    (some #(cph/is-child? objects % root) result)]
-
-                (cond-> result
-                  (not contains-parent?)
-                  (conj root)))))]
 
     (let [roots (->> ids (reduce calculate-common-roots #{}))]
       (concat

common/src/app/common/pages/helpers.cljc

@@ -76,6 +76,12 @@
   (and (not (frame-shape? shape))
        (= (:frame-id shape) uuid/zero)))
 
+(defn has-children?
+  ([objects id]
+   (has-children? (get objects id)))
+  ([shape]
+   (d/not-empty? (:shapes shape))))
+
 (defn get-children-ids
   [objects id]
   (letfn [(get-children-ids-rec
@@ -487,8 +493,17 @@
 
 (defn is-child?
   [objects parent-id candidate-child-id]
-  (let [parents (get-parent-ids objects candidate-child-id)]
+  (loop [cur-id candidate-child-id]
-    (some? (d/seek #(= % parent-id) parents))))
+    (let [cur-parent-id (dm/get-in objects [cur-id :parent-id])]
+      (cond
+        (= parent-id cur-parent-id)
+        true
+
+        (or (= cur-parent-id uuid/zero) (nil? cur-parent-id))
+        false
+
+        :else
+        (recur cur-parent-id)))))
 
 (defn reduce-objects
   ([objects reducer-fn init-val]

frontend/src/app/main/ui/workspace/viewport.cljs

@@ -51,17 +51,20 @@
 
 (defn apply-modifiers-to-selected
   [selected objects text-modifiers modifiers]
-  (into []
+  (reduce
-        (comp
+   (fn [objects id]
-         (keep (d/getf objects))
+     (update
-         (map (fn [{:keys [id] :as shape}]
+      objects id
-                (cond-> shape
+      (fn [shape]
-                  (and (cph/text-shape? shape) (contains? text-modifiers id))
+        (cond-> shape
-                  (dwm/apply-text-modifier (get text-modifiers id))
+          (and (cph/text-shape? shape) (contains? text-modifiers id))
+          (dwm/apply-text-modifier (get text-modifiers id))
 
-                  (contains? modifiers id)
+          (contains? modifiers id)
-                  (gsh/transform-shape (dm/get-in modifiers [id :modifiers]))))))
+          (gsh/transform-shape (dm/get-in modifiers [id :modifiers]))))))
-        selected))
+
+   objects
+   selected))
 
 (mf/defc viewport
   [{:keys [wlocal wglobal selected layout file] :as props}]
@@ -97,8 +100,11 @@
         modifiers         (mf/deref refs/workspace-modifiers)
         text-modifiers    (mf/deref refs/workspace-text-modifier)
 
-        objects-modified  (mf/with-memo [base-objects modifiers]
+        objects-modified  (mf/with-memo
-                            (gsh/apply-objects-modifiers base-objects modifiers selected))
+                            [base-objects text-modifiers modifiers]
+                            (apply-modifiers-to-selected selected base-objects text-modifiers modifiers))
+
+        selected-shapes   (->> selected (keep (d/getf objects-modified)))
 
         background        (get options :background clr/canvas)
 
@@ -138,7 +144,6 @@
         drawing-tool      (:tool drawing)
         drawing-obj       (:object drawing)
 
-        selected-shapes   (apply-modifiers-to-selected selected base-objects text-modifiers modifiers)
 
         selected-frames   (into #{} (map :frame-id) selected-shapes)