✨ Refactor modifiers

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

@@ -26,139 +26,14 @@
 ;;                           [(get-in objects [k :name]) v]))
 ;;                    modif-tree))))
 
-(defn set-children-modifiers
+(defn resolve-tree-sequence
-  [modif-tree objects parent ignore-constraints snap-pixel?]
+  "Given the ids that have changed search for layout roots to recalculate"
-  (let [children (map (d/getf objects) (:shapes parent))
+  [ids objects]
-        modifiers (get-in modif-tree [(:id parent) :modifiers])
-        transformed-parent (gtr/transform-shape parent modifiers)
-        parent (gtr/transform-shape parent (ctm/select-parent-modifiers modifiers))
 
-        set-child
+  (assert (or (nil? ids) (set? ids)) (dm/str "tree sequence from not set: " ids))
-        (fn [modif-tree child]
-          (let [child-modifiers (gct/calc-child-modifiers parent child modifiers ignore-constraints transformed-parent)
-                child-modifiers (cond-> child-modifiers snap-pixel? (gpp/set-pixel-precision child))]
-            (cond-> modif-tree
-              (not (ctm/empty-modifiers? child-modifiers))
-              (update-in [(:id child) :modifiers] ctm/add-modifiers child-modifiers))))]
 
-    (reduce set-child modif-tree children)))
+  (letfn [(get-tree-root ;; Finds the tree root for the current id
-
+            [id]
-(defn group? [shape]
-  (or (= :group (:type shape))
-      (= :bool (:type shape))))
-
-(defn frame? [shape]
-  (= :frame (:type shape)))
-
-(defn set-layout-modifiers
-  [modif-tree objects parent process-child?]
-
-  (letfn [(process-child [transformed-parent modif-tree child]
-            (let [modifiers (get-in modif-tree [(:id parent) :modifiers])
-                  child-modifiers (-> modifiers
-                                      (ctm/select-child-geometry-modifiers)
-                                      (gcl/normalize-child-modifiers parent child transformed-parent))]
-              (cond-> modif-tree
-                (not (ctm/empty-modifiers? child-modifiers))
-                (update-in [(:id child) :modifiers] ctm/add-modifiers child-modifiers))))
-
-          (apply-modifiers [modif-tree child]
-            (let [modifiers (get-in modif-tree [(:id child) :modifiers])]
-              (cond-> child
-                (some? modifiers)
-                (gtr/transform-shape modifiers)
-
-                (and (some? modifiers) (group? child))
-                (gtr/apply-group-modifiers objects modif-tree))))
-
-          (set-child-modifiers [parent [layout-line modif-tree] child]
-            (let [[modifiers layout-line]
-                  (gcl/layout-child-modifiers parent child layout-line)
-
-                  modif-tree
-                  (cond-> modif-tree
-                    (d/not-empty? modifiers)
-                    (update-in [(:id child) :modifiers] ctm/add-modifiers modifiers))]
-
-              [layout-line modif-tree]))]
-
-    (let [modifiers (get-in modif-tree [(:id parent) :modifiers])
-          transformed-parent (gtr/transform-shape parent modifiers)
-          children (map (d/getf objects) (:shapes transformed-parent))
-
-          modif-tree   (if process-child?
-                         (reduce (partial process-child transformed-parent) modif-tree children)
-                         modif-tree)
-          children     (->> children (map (partial apply-modifiers modif-tree)))
-
-          layout-data  (gcl/calc-layout-data transformed-parent children)
-          children     (into [] (cond-> children (:reverse? layout-data) reverse))
-          max-idx      (dec (count children))
-
-          layout-lines (:layout-lines layout-data)]
-
-      (loop [modif-tree modif-tree
-             layout-line (first layout-lines)
-             pending (rest layout-lines)
-             from-idx 0]
-        (if (and (some? layout-line) (<= from-idx max-idx))
-          (let [to-idx   (+ from-idx (:num-children layout-line))
-                children (subvec children from-idx to-idx)
-
-                [_ modif-tree]
-                (reduce (partial set-child-modifiers transformed-parent) [layout-line modif-tree] children)]
-            (recur modif-tree (first pending) (rest pending) to-idx))
-
-          modif-tree)))))
-
-(defn set-auto-modifiers
-  [modif-tree objects parent]
-  (letfn [(apply-modifiers [child]
-            (let [modifiers (get-in modif-tree [(:id child) :modifiers])]
-              (cond-> child
-                (some? modifiers)
-                (gtr/transform-shape modifiers)
-
-                (and (some? modifiers) (group? child))
-                (gtr/apply-group-modifiers objects modif-tree))))
-
-          (set-parent-auto-width
-            [modifiers parent auto-width]
-            (let [origin (-> parent :points first)
-                  scale-width (/ auto-width (-> parent :selrect :width) )]
-              (-> modifiers
-                  (ctm/set-resize-parent (gpt/point scale-width 1) origin (:transform parent) (:transform-inverse parent)))))
-
-          (set-parent-auto-height
-            [modifiers parent auto-height]
-            (let [origin (-> parent :points first)
-                  scale-height (/ auto-height (-> parent :selrect :height) )]
-              (-> modifiers
-                  (ctm/set-resize-parent (gpt/point 1 scale-height) origin (:transform parent) (:transform-inverse parent)))))]
-
-    (let [modifiers (get-in modif-tree [(:id parent) :modifiers])
-          transformed-parent (gtr/transform-shape parent modifiers)
-
-          children (->> transformed-parent
-                        :shapes
-                        (map (comp apply-modifiers (d/getf objects))))
-
-          {auto-width :width auto-height :height}
-          (when (and (d/not-empty? children) (or (ctl/auto-height? transformed-parent) (ctl/auto-width? transformed-parent)))
-            (gcl/layout-content-bounds transformed-parent children))
-
-          modifiers
-          (cond-> modifiers
-            (and (some? auto-width) (ctl/auto-width? transformed-parent))
-            (set-parent-auto-width transformed-parent auto-width)
-
-            (and (some? auto-height) (ctl/auto-height? transformed-parent))
-            (set-parent-auto-height transformed-parent auto-height))]
-
-      (assoc-in modif-tree [(:id parent) :modifiers] modifiers))))
-
-(defn get-tree-root
-  [id objects]
 
             (loop [current id
                    result  id]
@@ -181,17 +56,11 @@
                   :else
                   (recur (:id parent) result)))))
 
-(defn resolve-tree-sequence
+          (calculate-common-roots ;; Given some roots retrieves the minimum number of tree roots
-  "Given the ids that have changed search for layout roots to recalculate"
+            [result id]
-  [ids objects]
-
-  (assert (or (nil? ids) (set? ids)) (dm/str "tree sequence from not set: " ids))
-
-  (let [redfn
-        (fn [result id]
             (if (= id uuid/zero)
               result
-            (let [root (get-tree-root id objects)
+              (let [root (get-tree-root id)
 
                     ;; Remove the children from the current root
                     result
@@ -204,81 +73,189 @@
                   (not contains-parent?)
                   (conj root)))))
 
-        generate-tree
+          (generate-tree ;; Generate a tree sequence from a given root id
-        (fn [id]
+            [id]
             (->> (tree-seq
                   #(d/not-empty? (get-in objects [% :shapes]))
                   #(get-in objects [% :shapes])
                   id)
+                 (map #(get objects %))))]
 
-               (map #(get objects %))))
+    (let [roots (->> ids (reduce calculate-common-roots #{}))]
-
-        roots (->> ids (reduce redfn #{}))]
-
       (concat
        (when (contains? ids uuid/zero) [(get objects uuid/zero)])
-     (mapcat generate-tree roots))))
+       (mapcat generate-tree roots)))))
 
-(defn inside-layout?
+(defn- set-children-modifiers
-  [objects shape]
+  "Propagates the modifiers from a parent too its children applying constraints if necesary"
+  [modif-tree objects parent transformed-parent ignore-constraints snap-pixel?]
+  (let [children (map (d/getf objects) (:shapes parent))
+        modifiers (get-in modif-tree [(:id parent) :modifiers])
+        parent (gtr/transform-shape parent (ctm/select-parent-modifiers modifiers))
 
-  (loop [current-id (:id shape)]
+        set-child
-    (let [current (get objects current-id)]
+        (fn [modif-tree child]
-      (cond
+          (let [child-modifiers (gct/calc-child-modifiers parent child modifiers ignore-constraints transformed-parent)
-        (or (nil? current) (= current-id (:parent-id current)))
+                child-modifiers (cond-> child-modifiers snap-pixel? (gpp/set-pixel-precision child))]
-        false
+            (cond-> modif-tree
+              (not (ctm/empty-modifiers? child-modifiers))
+              (update-in [(:id child) :modifiers] ctm/add-modifiers child-modifiers))))]
 
-        (= :frame (:type current))
+    (reduce set-child modif-tree children)))
-        (:layout current)
 
-        :else
+(defn- process-layout-children
-        (recur (:parent-id current))))))
+  [modif-tree objects parent transformed-parent]
+  (letfn [(process-child [modif-tree child]
+            (let [modifiers (get-in modif-tree [(:id parent) :modifiers])
+                  child-modifiers (-> modifiers
+                                      (ctm/select-child-geometry-modifiers)
+                                      (gcl/normalize-child-modifiers parent child transformed-parent))]
+              (cond-> modif-tree
+                (not (ctm/empty-modifiers? child-modifiers))
+                (update-in [(:id child) :modifiers] ctm/add-modifiers child-modifiers))))]
+    (let [children (map (d/getf objects) (:shapes transformed-parent))]
+      (reduce process-child modif-tree children))))
 
-(defn- calculate-modifiers
+(defn- set-layout-modifiers
-  [objects snap-pixel? ignore-constraints [modif-tree recalculate] shape]
+  [modif-tree objects parent]
-  (let [shape-id (:id shape)
+
-        root? (= uuid/zero shape-id)
+  (letfn [(apply-modifiers [modif-tree child]
-        modifiers (get-in modif-tree [shape-id :modifiers])
+            (let [modifiers (get-in modif-tree [(:id child) :modifiers])]
+              (cond-> child
+                (some? modifiers)
+                (gtr/transform-shape modifiers)
+
+                (and (some? modifiers) (cph/group-like-shape? child))
+                (gtr/apply-group-modifiers objects modif-tree))))
+
+          (set-child-modifiers [parent [layout-line modif-tree] child]
+            (let [[modifiers layout-line]
+                  (gcl/layout-child-modifiers parent child layout-line)
+
+                  modif-tree
+                  (cond-> modif-tree
+                    (d/not-empty? modifiers)
+                    (update-in [(:id child) :modifiers] ctm/add-modifiers modifiers))]
+
+              [layout-line modif-tree]))]
+
+    (let [children (map (d/getf objects) (:shapes parent))
+          children     (->> children (map (partial apply-modifiers modif-tree)))
+          layout-data  (gcl/calc-layout-data parent children)
+          children     (into [] (cond-> children (:reverse? layout-data) reverse))
+          max-idx      (dec (count children))
+          layout-lines (:layout-lines layout-data)]
+
+      (loop [modif-tree modif-tree
+             layout-line (first layout-lines)
+             pending (rest layout-lines)
+             from-idx 0]
+        (if (and (some? layout-line) (<= from-idx max-idx))
+          (let [to-idx   (+ from-idx (:num-children layout-line))
+                children (subvec children from-idx to-idx)
+
+                [_ modif-tree]
+                (reduce (partial set-child-modifiers parent) [layout-line modif-tree] children)]
+            (recur modif-tree (first pending) (rest pending) to-idx))
+
+          modif-tree)))))
+
+(defn- set-auto-modifiers
+  "Calculates the modifiers to adjust the bounds for auto-width/auto-height shapes"
+  [modif-tree objects parent]
+  (letfn [(apply-modifiers
+            [child]
+            (let [modifiers (get-in modif-tree [(:id child) :modifiers])]
+              (cond-> child
+                (some? modifiers)
+                (gtr/transform-shape modifiers)
+
+                (and (some? modifiers) (cph/group-like-shape? child))
+                (gtr/apply-group-modifiers objects modif-tree))))
+
+          (set-parent-auto-width
+            [modifiers parent auto-width]
+            (let [origin (-> parent :points first)
+                  scale-width (/ auto-width (-> parent :selrect :width) )]
+              (-> modifiers
+                  (ctm/set-resize-parent (gpt/point scale-width 1) origin (:transform parent) (:transform-inverse parent)))))
+
+          (set-parent-auto-height
+            [modifiers parent auto-height]
+            (let [origin (-> parent :points first)
+                  scale-height (/ auto-height (-> parent :selrect :height) )]
+              (-> modifiers
+                  (ctm/set-resize-parent (gpt/point 1 scale-height) origin (:transform parent) (:transform-inverse parent)))))]
+
+    (let [modifiers (get-in modif-tree [(:id parent) :modifiers])
+          children (->> parent
+                        :shapes
+                        (map (comp apply-modifiers (d/getf objects))))
+
+          {auto-width :width auto-height :height}
+          (when (and (d/not-empty? children) (or (ctl/auto-height? parent) (ctl/auto-width? parent)))
+            (gcl/layout-content-bounds parent children))
+
+          modifiers
+          (cond-> modifiers
+            (and (some? auto-width) (ctl/auto-width? parent))
+            (set-parent-auto-width parent auto-width)
+
+            (and (some? auto-height) (ctl/auto-height? parent))
+            (set-parent-auto-height parent auto-height))]
+
+      (assoc-in modif-tree [(:id parent) :modifiers] modifiers))))
+
+(defn- propagate-modifiers
+  [objects snap-pixel? ignore-constraints [modif-tree recalculate] parent]
+  (let [parent-id (:id parent)
+        root? (= uuid/zero parent-id)
+        modifiers (get-in modif-tree [parent-id :modifiers])
 
         modifiers (cond-> modifiers
                     (and (not root?) (ctm/has-geometry? modifiers) snap-pixel?)
-                    (gpp/set-pixel-precision shape))
+                    (gpp/set-pixel-precision parent))
 
-        modif-tree (-> modif-tree (assoc-in [shape-id :modifiers] modifiers))
+        modif-tree (-> modif-tree (assoc-in [parent-id :modifiers] modifiers))
+
+        transformed-parent (gtr/transform-shape parent modifiers)
 
         has-modifiers? (ctm/child-modifiers? modifiers)
-        is-layout? (ctl/layout? shape)
+        is-layout? (ctl/layout? parent)
-        is-auto?   (or (ctl/auto-height? shape) (ctl/auto-width? shape))
+        is-auto?   (or (ctl/auto-height? transformed-parent) (ctl/auto-width? transformed-parent))
-        is-parent? (or (group? shape) (and (frame? shape) (not (ctl/layout? shape))))
+        is-parent? (or (cph/group-like-shape? parent) (and (cph/frame-shape? parent) (not (ctl/layout? parent))))
 
         ;; If the current child is inside the layout we ignore the constraints
-        is-inside-layout? (inside-layout? objects shape)]
+        is-inside-layout? (ctl/inside-layout? objects parent)]
 
     [(cond-> modif-tree
        (and has-modifiers? is-parent? (not root?))
-       (set-children-modifiers objects shape (or ignore-constraints is-inside-layout?) snap-pixel?)
+       (set-children-modifiers objects parent transformed-parent (or ignore-constraints is-inside-layout?) snap-pixel?)
 
        is-layout?
-       (set-layout-modifiers objects shape true)
+       (-> (process-layout-children objects parent transformed-parent)
+           (set-layout-modifiers objects transformed-parent))
 
        is-auto?
-       (set-auto-modifiers objects shape))
+       (set-auto-modifiers objects transformed-parent))
 
      (cond-> recalculate
        ;; Auto-width/height can change the positions in the parent so we need to recalculate
        is-auto?
-       (conj (:id shape)))]))
+       (conj (:id parent)))]))
 
 (defn- calculate-reflow-layout
-  [objects snap-pixel? modif-tree shape]
+  [objects modif-tree parent]
-  (let [is-layout? (ctl/layout? shape)
+  (let [is-layout? (ctl/layout? parent)
-        is-auto?   (or (ctl/auto-height? shape) (ctl/auto-width? shape))]
+        is-auto?   (or (ctl/auto-height? parent) (ctl/auto-width? parent))
+        modifiers (get-in modif-tree [(:id parent) :modifiers])
+        transformed-parent (gtr/transform-shape parent modifiers)]
     (cond-> modif-tree
       is-layout?
-      (set-layout-modifiers objects shape false)
+      (set-layout-modifiers objects transformed-parent)
 
       is-auto?
-      (set-auto-modifiers objects shape))))
+      (set-auto-modifiers objects transformed-parent))))
 
 (defn set-objects-modifiers
   [modif-tree objects ignore-constraints snap-pixel?]
@@ -286,22 +263,22 @@
   (let [shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
 
         [modif-tree recalculate]
-        (reduce (partial calculate-modifiers objects snap-pixel? ignore-constraints) [modif-tree #{}] shapes-tree)
+        (reduce (partial propagate-modifiers objects snap-pixel? ignore-constraints) [modif-tree #{}] shapes-tree)
 
         shapes-tree (resolve-tree-sequence recalculate objects)
 
         ;; We need to go again and recalculate the layout positions+hug
-        ;; TODO LAYOUT: How to remove this recalculus?
+        ;; TODO LAYOUT: How to remove this recalculation?
         modif-tree
         (->> shapes-tree
              reverse
              (filter ctl/layout?)
-             (reduce (partial calculate-reflow-layout objects snap-pixel?) modif-tree ))
+             (reduce (partial calculate-reflow-layout objects) modif-tree))
 
         modif-tree
         (->> shapes-tree
              (filter ctl/layout?)
-             (reduce (partial calculate-reflow-layout objects snap-pixel?) modif-tree ))]
+             (reduce (partial calculate-reflow-layout objects) modif-tree ))]
 
     ;;#?(:cljs
     ;;   (.log js/console ">result" (modif->js modif-tree objects)))

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

@@ -47,6 +47,10 @@
   [{:keys [type]}]
   (= type :bool))
 
+(defn group-like-shape?
+  [{:keys [type]}]
+  (or (= :group type) (= :bool type)))
+
 (defn text-shape?
   [{:keys [type]}]
   (= type :text))

common/src/app/common/types/shape/layout.cljc

@@ -106,6 +106,22 @@
         parent (get objects parent-id)]
     (layout? parent)))
 
+(defn inside-layout?
+  "Check if the shape is inside a layout"
+  [objects shape]
+
+  (loop [current-id (:id shape)]
+    (let [current (get objects current-id)]
+      (cond
+        (or (nil? current) (= current-id (:parent-id current)))
+        false
+
+        (= :frame (:type current))
+        (:layout current)
+
+        :else
+        (recur (:parent-id current))))))
+
 (defn wrap? [{:keys [layout-wrap-type]}]
   (= layout-wrap-type :wrap))