✨ Change modifiers to records

common/src/app/common/geom/matrix.cljc

@@ -9,6 +9,7 @@
    #?(:cljs [cljs.pprint :as pp]
       :clj  [clojure.pprint :as pp])
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
    [app.common.math :as mth]
    [app.common.spec :as us]
@@ -123,6 +124,35 @@
   ([m1 m2 & others]
    (reduce multiply (multiply m1 m2) others)))
 
+(defn multiply!
+  [^Matrix m1 ^Matrix m2]
+  (let [m1a (.-a m1)
+        m1b (.-b m1)
+        m1c (.-c m1)
+        m1d (.-d m1)
+        m1e (.-e m1)
+        m1f (.-f m1)
+        m2a (.-a m2)
+        m2b (.-b m2)
+        m2c (.-c m2)
+        m2d (.-d m2)
+        m2e (.-e m2)
+        m2f (.-f m2)]
+    #?@(:cljs [(set! (.-a m1) (+ (* m1a m2a) (* m1c m2b)))
+               (set! (.-b m1) (+ (* m1b m2a) (* m1d m2b)))
+               (set! (.-c m1) (+ (* m1a m2c) (* m1c m2d)))
+               (set! (.-d m1) (+ (* m1b m2c) (* m1d m2d)))
+               (set! (.-e m1) (+ (* m1a m2e) (* m1c m2f) m1e))
+               (set! (.-f m1) (+ (* m1b m2e) (* m1d m2f) m1f))
+               m1]
+        :clj  [(Matrix.
+                (+ (* m1a m2a) (* m1c m2b))
+                (+ (* m1b m2a) (* m1d m2b))
+                (+ (* m1a m2c) (* m1c m2d))
+                (+ (* m1b m2c) (* m1d m2d))
+                (+ (* m1a m2e) (* m1c m2f) m1e)
+                (+ (* m1b m2e) (* m1d m2f) m1f))])))
+
 (defn add-translate
   "Given two TRANSLATE matrixes (only e and f have significative
   values), combine them. Quicker than multiplying them, for this
@@ -147,26 +177,31 @@
   (= v base))
 
 (defn translate-matrix
-  ([{x :x y :y :as pt}]
+  ([pt]
    (assert (gpt/point? pt))
-   (Matrix. 1 0 0 1 x y))
+   (Matrix. 1 0 0 1
+            (dm/get-prop pt :x)
+            (dm/get-prop pt :y)))
 
   ([x y]
-   (translate-matrix (gpt/point x y))))
+   (Matrix. 1 0 0 1 x y)))
 
 (defn scale-matrix
   ([pt center]
-   (multiply (translate-matrix center)
-             (scale-matrix pt)
-             (translate-matrix (gpt/negate center))))
-  ([{x :x y :y :as pt}]
+   (-> (matrix)
+       (multiply! (translate-matrix center))
+       (multiply! (scale-matrix pt))
+       (multiply! (translate-matrix (gpt/negate center)))))
+  ([pt]
    (assert (gpt/point? pt))
-   (Matrix. x 0 0 y 0 0)))
+   (Matrix. (dm/get-prop pt :x) 0 0 (dm/get-prop pt :y) 0 0)))
 
 (defn rotate-matrix
-  ([angle point] (multiply (translate-matrix point)
-                           (rotate-matrix angle)
-                           (translate-matrix (gpt/negate point))))
+  ([angle point]
+   (-> (matrix)
+       (multiply! (translate-matrix point))
+       (multiply! (rotate-matrix angle))
+       (multiply! (translate-matrix (gpt/negate point)))))
   ([angle]
    (let [a (mth/radians angle)]
      (Matrix. (mth/cos a)
@@ -200,11 +235,23 @@
   ([m scale center]
    (multiply m (scale-matrix scale center))))
 
+(defn scale!
+  "Apply scale transformation to the matrix."
+  ([m scale]
+   (multiply! m (scale-matrix scale)))
+  ([m scale center]
+   (multiply! m (scale-matrix scale center))))
+
 (defn translate
   "Apply translate transformation to the matrix."
   [m pt]
   (multiply m (translate-matrix pt)))
 
+(defn translate!
+  "Apply translate transformation to the matrix."
+  [m pt]
+  (multiply! m (translate-matrix pt)))
+
 (defn skew
   "Apply translate transformation to the matrix."
   ([m angle-x angle-y]

common/src/app/common/geom/point.cljc

@@ -323,8 +323,9 @@
             (/ (dm/get-prop p1 :y) p-length))))
 
 (defn perpendicular
-  [{:keys [x y]}]
-  (Point. (- y) x))
+  [pt]
+  (Point. (- (dm/get-prop pt :y))
+          (dm/get-prop pt :x)))
 
 (defn project
   "V1 perpendicular projection on vector V2"

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

@@ -282,7 +282,7 @@
 (defn calc-child-modifiers
   [parent child modifiers ignore-constraints child-bounds parent-bounds transformed-parent-bounds]
 
-  (let [modifiers (ctm/select-child-modifiers modifiers)
+  (let [modifiers (ctm/select-child modifiers)
 
         constraints-h
         (if-not ignore-constraints
@@ -299,7 +299,7 @@
 
       (let [transformed-parent-bounds @transformed-parent-bounds
 
-            modifiers (ctm/select-child-modifiers modifiers)
+            modifiers (ctm/select-child modifiers)
             transformed-child-bounds (gtr/transform-bounds child-bounds modifiers)
             modifiers (normalize-modifiers constraints-h constraints-v
                                            modifiers parent

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

@@ -34,7 +34,7 @@
         resize-origin (gpo/origin transformed-child-bounds)]
 
     (-> modifiers
-        (ctm/select-child-modifiers)
+        (ctm/select-child)
         (ctm/resize
          resize-vector
          resize-origin

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

@@ -107,7 +107,7 @@
 
       ;; Check the constraints, then resize
       (let [parent-id (:id parent)
-            parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent-modifiers modifiers))]
+            parent-bounds (gtr/transform-bounds @(get bounds parent-id) (ctm/select-parent modifiers))]
         (loop [modif-tree modif-tree
                children (seq children)]
           (if (empty? children)

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

@@ -483,9 +483,9 @@
 
   ([points center modifiers]
    (let [transform (ctm/modifiers->transform modifiers)]
-    (cond-> points
-      (some? transform)
-      (gco/transform-points center transform)))))
+     (cond-> points
+       (some? transform)
+       (gco/transform-points center transform)))))
 
 (defn transform-selrect
   [selrect modifiers]

common/src/app/common/types/modifiers.cljc

@@ -7,7 +7,6 @@
 (ns app.common.types.modifiers
   (:refer-clojure :exclude [empty empty?])
   (:require
-   [app.common.perf :as perf]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.matrix :as gmt]
@@ -40,44 +39,123 @@
 ;;     * rotation
 ;;     * change-properties
 
+(defrecord Modifiers
+    [geometry-parent
+     geometry-child
+     structure-parent
+     structure-child])
+
+(defrecord GeometricOperation
+    [type
+     vector
+     origin
+     transform
+     transform-inverse
+     rotation
+     center])
+
+(defrecord StructureOperation
+    [type
+     property
+     value
+     index])
+
+;; Record constructors
+
+(defn move-op
+  [vector]
+  (GeometricOperation. :move vector nil nil nil nil nil))
+
+(defn resize-op
+  ([vector origin]
+   (GeometricOperation. :resize vector origin nil nil nil nil))
+  ([vector origin transform transform-inverse]
+   (GeometricOperation. :resize vector origin transform transform-inverse nil nil)))
+
+(defn rotation-geom-op
+  [center angle]
+  (GeometricOperation. :rotation nil nil nil nil angle center))
+
+(defn rotation-struct-op
+  [angle]
+  (StructureOperation. :rotation nil angle nil))
+
+(defn remove-children-op
+  [shapes]
+  (StructureOperation. :remove-children nil shapes nil))
+
+(defn add-children-op
+  [shapes index]
+  (StructureOperation. :add-children nil shapes index))
+
+(defn reflow-op
+  []
+  (StructureOperation. :reflow nil nil nil))
+
+(defn scale-content-op
+  [value]
+  (StructureOperation. :scale-content nil value nil))
+
+(defn change-property-op
+  [property value]
+  (StructureOperation. :change-property property value nil))
+
+
 ;; Private aux functions
 
-(def conjv (fnil conj []))
+(defn- move-vec?
+  [vector]
+  (or (not (mth/almost-zero? (dm/get-prop vector :x)))
+      (not (mth/almost-zero? (dm/get-prop vector :y)))))
 
-(defn- move-vec? [vector]
-  (or (not (mth/almost-zero? (:x vector)))
-      (not (mth/almost-zero? (:y vector)))))
-
-(defn- resize-vec? [vector]
-  (or (not (mth/almost-zero? (- (:x vector) 1)))
-      (not (mth/almost-zero? (- (:y vector) 1)))))
+(defn- resize-vec?
+  [vector]
+  (or (not (mth/almost-zero? (- (dm/get-prop vector :x) 1)))
+      (not (mth/almost-zero? (- (dm/get-prop vector :y) 1)))))
 
 (defn- mergeable-move?
   [op1 op2]
-  (and (= :move (:type op1))
-       (= :move (:type op2))))
+  (let [type-op1 (dm/get-prop op1 :type)
+        type-op2 (dm/get-prop op2 :type)]
+    (and (= :move type-op1) (= :move type-op2))))
 
 (defn- mergeable-resize?
   [op1 op2]
-  (and (= :resize (:type op1))
-       (= :resize (:type op2))
+  (let [type-op1          (dm/get-prop op1 :type)
+        transform-op1     (or (dm/get-prop op1 :transform) (gmt/matrix))
+        transform-inv-op1 (or (dm/get-prop op1 :transform-inverse) (gmt/matrix))
+        origin-op1        (dm/get-prop op1 :origin)
 
-       ;; Same transforms
-       (gmt/close? (or (:transform op1) (gmt/matrix)) (or (:transform op2) (gmt/matrix)))
-       (gmt/close? (or (:transform-inverse op1) (gmt/matrix)) (or (:transform-inverse op2) (gmt/matrix)))
+        type-op2          (dm/get-prop op2 :type)
+        transform-op2     (or (dm/get-prop op2 :transform) (gmt/matrix))
+        transform-inv-op2 (or (dm/get-prop op2 :transform-inverse) (gmt/matrix))
+        origin-op2        (dm/get-prop op2 :origin)]
+    (and (= :resize type-op1) (= :resize type-op2)
 
-       ;; Same origin
-       (gpt/close? (:origin op1) (:origin op2))))
+         ;; Same origin
+         (gpt/close? origin-op1 origin-op2)
+
+         ;; Same transforms
+         (gmt/close? transform-op1 transform-op2)
+         (gmt/close? transform-inv-op1 transform-inv-op2))))
 
 (defn- merge-move
   [op1 op2]
-  {:type :move
-   :vector (gpt/add (:vector op1) (:vector op2))})
+  (let [vector-op1 (dm/get-prop op1 :vector)
+        vector-op2 (dm/get-prop op2 :vector)]
+    (move-op (gpt/add vector-op1 vector-op2))))
 
 (defn- merge-resize
   [op1 op2]
-  (let [vector (gpt/point (* (-> op1 :vector :x) (-> op2 :vector :x))
-                          (* (-> op1 :vector :y) (-> op2 :vector :y)))]
+  (let [op1-vector (dm/get-prop op1 :vector)
+        op1-x (dm/get-prop op1-vector :x)
+        op1-y (dm/get-prop op1-vector :y)
+
+        op2-vector (dm/get-prop op2 :vector)
+        op2-x (dm/get-prop op2-vector :x)
+        op2-y (dm/get-prop op2-vector :y)
+
+        vector (gpt/point (* op1-x op2-x) (* op1-y op2-y))]
     (assoc op1 :vector vector)))
 
 (defn- maybe-add-move
@@ -89,7 +167,7 @@
       (if (mergeable-move? head op)
         (let [item (merge-move head op)]
           (cond-> (pop operations)
-            (move-vec? (:vector item))
+            (move-vec? (dm/get-prop item :vector))
             (conj item)))
         (conj operations op)))))
 
@@ -103,21 +181,23 @@
       (if (mergeable-resize? head op)
         (let [item (merge-resize head op)]
           (cond-> (pop operations)
-            (resize-vec? (:vector item))
+            (resize-vec? (dm/get-prop item :vector))
             (conj item)))
         (conj operations op)))))
 
 (defn valid-vector?
-  [{:keys [x y]}]
-  (and (some? x)
-       (some? y)
-       (not (mth/nan? x))
-       (not (mth/nan? y))))
+  [vector]
+  (let [x (dm/get-prop vector :x)
+        y (dm/get-prop vector :y)]
+    (and (some? x)
+         (some? y)
+         (not (mth/nan? x))
+         (not (mth/nan? y)))))
 
 ;; Public builder API
 
 (defn empty []
-  {})
+  (Modifiers. [] [] [] []))
 
 (defn move-parent
   ([modifiers x y]
@@ -125,143 +205,118 @@
 
   ([modifiers vector]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (move-vec? vector)
-     (update :geometry-parent maybe-add-move {:type :move :vector vector}))))
+     (update :geometry-parent maybe-add-move (move-op vector)))))
 
 (defn resize-parent
   ([modifiers vector origin]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (resize-vec? vector)
-     (update :geometry-parent maybe-add-resize {:type :resize
-                                                :vector vector
-                                                :origin origin})))
+     (update :geometry-parent maybe-add-resize (resize-op vector origin))))
 
   ([modifiers vector origin transform transform-inverse]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (resize-vec? vector)
-     (update :geometry-parent maybe-add-resize {:type :resize
-                                                :vector vector
-                                                :origin origin
-                                                :transform transform
-                                                :transform-inverse transform-inverse}))))
+     (update :geometry-parent maybe-add-resize (resize-op vector origin transform transform-inverse)))))
+
 (defn move
   ([modifiers x y]
    (move modifiers (gpt/point x y)))
 
   ([modifiers vector]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (move-vec? vector)
-     (update :geometry-child maybe-add-move {:type :move :vector vector}))))
+     (update :geometry-child maybe-add-move (move-op vector)))))
 
 (defn resize
   ([modifiers vector origin]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (resize-vec? vector)
-     (update :geometry-child maybe-add-resize {:type :resize
-                                               :vector vector
-                                               :origin origin})))
+     (update :geometry-child maybe-add-resize (resize-op vector origin))))
 
   ([modifiers vector origin transform transform-inverse]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
-   (cond-> modifiers
+   (cond-> (or modifiers (empty))
      (resize-vec? vector)
-     (update :geometry-child maybe-add-resize {:type :resize
-                                               :vector vector
-                                               :origin origin
-                                               :transform transform
-                                               :transform-inverse transform-inverse}))))
+     (update :geometry-child maybe-add-resize (resize-op vector origin transform transform-inverse)))))
 
 (defn rotation
   [modifiers center angle]
-  (cond-> modifiers
+  (cond-> (or modifiers (empty))
     (not (mth/close? angle 0))
-    (-> (update :structure-child conjv {:type :rotation
-                                        :rotation angle})
-        (update :geometry-child conjv {:type :rotation
-                                       :center center
-                                       :rotation angle}))))
+    (-> (update :structure-child conj (rotation-struct-op angle))
+        (update :geometry-child conj (rotation-geom-op center angle)))))
 
 (defn remove-children
   [modifiers shapes]
-  (cond-> modifiers
+  (cond-> (or modifiers (empty))
     (d/not-empty? shapes)
-    (update :structure-parent conjv {:type :remove-children
-                                     :value shapes})))
+    (update :structure-parent conj (remove-children-op shapes))))
 
 (defn add-children
   [modifiers shapes index]
-  (cond-> modifiers
+  (cond-> (or modifiers (empty))
     (d/not-empty? shapes)
-    (update :structure-parent conjv {:type :add-children
-                                     :value shapes
-                                     :index index})))
+    (update :structure-parent conj (add-children-op shapes index))))
 
 (defn reflow
   [modifiers]
-  (-> modifiers
-      (update :structure-parent conjv {:type :reflow})))
+  (-> (or modifiers (empty))
+      (update :structure-parent conj (reflow-op))))
 
 (defn scale-content
   [modifiers value]
-  (-> modifiers
-      (update :structure-child conjv {:type :scale-content :value value})))
+  (-> (or modifiers (empty))
+      (update :structure-child conj (scale-content-op value))))
 
 (defn change-property
   [modifiers property value]
-  (-> modifiers
-      (update :structure-child conjv {:type :change-property
-                                      :property property
-                                      :value value})))
+  (-> (or modifiers (empty))
+      (update :structure-child conj (change-property-op property value))))
 
 (defn- merge-geometry
-  [geometry other]
+  [operations other]
 
   (cond
-    (c/empty? geometry)
+    (c/empty? operations)
     other
 
     (c/empty? other)
-    geometry
+    operations
 
     :else
-    (loop [result geometry
-           modifiers (seq other)]
-      (if (c/empty? modifiers)
+    (loop [result operations
+           operations (seq other)]
+      (if (c/empty? operations)
         result
-        (let [current (first modifiers)
+        (let [current (first operations)
               result
               (cond
-                (= :move (:type current))
+                (= :move (dm/get-prop current :type))
                 (maybe-add-move result current)
 
-                (= :resize (:type current))
+                (= :resize (dm/get-prop current :type))
                 (maybe-add-resize result current)
 
                 :else
                 (conj result current))]
 
-          (recur result (rest modifiers)))))))
+          (recur result (rest operations)))))))
 
 (defn add-modifiers
   [modifiers new-modifiers]
-
-  (cond-> modifiers
-    (some? (:geometry-child new-modifiers))
-    (update :geometry-child merge-geometry (:geometry-child new-modifiers))
-
-    (some? (:geometry-parent new-modifiers))
-    (update :geometry-parent merge-geometry (:geometry-parent new-modifiers))
-
-    (some? (:structure-parent new-modifiers))
-    (update :structure-parent #(d/concat-vec [] % (:structure-parent new-modifiers)))
-
-    (some? (:structure-child new-modifiers))
-    (update :structure-child #(d/concat-vec [] % (:structure-child new-modifiers)))))
+  (let [modifiers (or modifiers (empty))
+        new-modifiers (or new-modifiers (empty))]
+    (-> modifiers
+        (update :geometry-child merge-geometry (dm/get-prop new-modifiers :geometry-child))
+        (update :geometry-parent merge-geometry (dm/get-prop new-modifiers :geometry-parent))
+        (update :structure-parent #(d/concat-vec [] % (dm/get-prop new-modifiers :structure-parent)))
+        (update :structure-child #(d/concat-vec [] % (dm/get-prop new-modifiers :structure-child))))))
 
 
 ;; These are convenience methods to create single operation modifiers without the builder
@@ -385,27 +440,27 @@
 
 (defn empty?
   [modifiers]
-  (and (c/empty? (:geometry-child modifiers))
-       (c/empty? (:geometry-parent modifiers))
-       (c/empty? (:structure-parent modifiers))
-       (c/empty? (:structure-child modifiers))))
+  (and (c/empty? (dm/get-prop modifiers :geometry-child))
+       (c/empty? (dm/get-prop modifiers :geometry-parent))
+       (c/empty? (dm/get-prop modifiers :structure-parent))
+       (c/empty? (dm/get-prop modifiers :structure-child))))
 
 (defn child-modifiers?
-  [{:keys [geometry-child structure-child]}]
-  (or (d/not-empty? geometry-child)
-      (d/not-empty? structure-child)))
+  [modifiers]
+  (or (d/not-empty? (dm/get-prop modifiers :geometry-child))
+      (d/not-empty? (dm/get-prop modifiers :structure-child))))
 
 (defn only-move?
   "Returns true if there are only move operations"
-  [{:keys [geometry-child geometry-parent]}]
-  (let [move-op? #(= :move (:type %))]
-    (and (every? move-op? geometry-child)
-         (every? move-op? geometry-parent))))
+  [modifiers]
+  (let [move-op? #(= :move (dm/get-prop % :type))]
+    (and (every? move-op? (dm/get-prop modifiers :geometry-child))
+         (every? move-op? (dm/get-prop modifiers :geometry-parent)))))
 
 (defn has-geometry?
-  [{:keys [geometry-parent geometry-child]}]
-  (or (d/not-empty? geometry-parent)
-      (d/not-empty? geometry-child)))
+  [modifiers]
+  (or (d/not-empty? (dm/get-prop modifiers :geometry-parent))
+      (d/not-empty? (dm/get-prop modifiers :geometry-child))))
 
 (defn has-structure?
   [{:keys [structure-parent structure-child]}]
@@ -414,25 +469,25 @@
 
 ;; Extract subsets of modifiers
 
-(defn select-child-modifiers
+(defn select-child
   [modifiers]
-  (select-keys modifiers [:geometry-child :structure-child]))
+  (assoc (or modifiers (empty)) :geometry-parent [] :structure-parent []))
 
-(defn select-child-geometry-modifiers
+(defn select-parent
   [modifiers]
-  (select-keys modifiers [:geometry-child]))
-
-(defn select-parent-modifiers
-  [modifiers]
-  (select-keys modifiers [:geometry-parent :structure-parent]))
+  (assoc (or modifiers (empty)) :geometry-child [] :structure-child []))
 
 (defn select-structure
   [modifiers]
-  (select-keys modifiers [:structure-parent :structure-child]))
+  (assoc (or modifiers (empty)) :geometry-child [] :geometry-parent []))
 
 (defn select-geometry
   [modifiers]
-  (select-keys modifiers [:geometry-parent :geometry-child]))
+  (assoc (or modifiers (empty)) :structure-child [] :structure-parent []))
+
+(defn select-child-geometry-modifiers
+  [modifiers]
+  (-> modifiers select-child select-geometry))
 
 (defn added-children-frames
   "Returns the frames that have an 'add-children' operation"
@@ -456,46 +511,53 @@
 (defn modifiers->transform
   "Given a set of modifiers returns its transformation matrix"
   [modifiers]
+  (let [modifiers (concat (dm/get-prop modifiers :geometry-parent)
+                          (dm/get-prop modifiers :geometry-child))]
 
-  (let [modifiers
-        (if (d/not-empty? (:geometry-parent modifiers))
-          (concat (:geometry-parent modifiers) (:geometry-child modifiers))
-          (:geometry-child modifiers))]
+    (loop [matrix    (gmt/matrix)
+           modifiers (seq modifiers)]
+      (if (c/empty? modifiers)
+        matrix
+        (let [modifier (first modifiers)
+              type   (dm/get-prop modifier :type)
 
-    (when (d/not-empty? modifiers)
-      (loop [matrix (gmt/matrix)
-             modifiers (seq modifiers)]
-        (if (c/empty? modifiers)
-          matrix
-          (let [{:keys [type vector rotation center origin transform transform-inverse] :as modifier} (first modifiers)
-                matrix
-                (case type
-                  :move
-                  (gmt/multiply (gmt/translate-matrix vector) matrix)
+              matrix
+              (case type
+                :move
+                (-> (dm/get-prop modifier :vector)
+                    (gmt/translate-matrix)
+                    (gmt/multiply! matrix))
 
-                  :resize
-                  (let [origin (cond-> origin
-                                 (or (some? transform-inverse)(some? transform))
-                                 (gpt/transform transform-inverse))]
-                    (gmt/multiply
-                     (-> (gmt/matrix)
-                         (cond-> (some? transform)
-                           (gmt/multiply transform))
-                         (gmt/translate origin)
-                         (gmt/scale vector)
-                         (gmt/translate (gpt/negate origin))
-                         (cond-> (some? transform-inverse)
-                           (gmt/multiply transform-inverse)))
-                     matrix))
+                :resize
+                (let [tf     (dm/get-prop modifier :transform)
+                      tfi    (dm/get-prop modifier :transform-inverse)
+                      vector (dm/get-prop modifier :vector)
+                      origin (dm/get-prop modifier :origin)
+                      origin (if ^boolean (some? tfi)
+                               (gpt/transform origin tfi)
+                               origin)]
 
-                  :rotation
-                  (gmt/multiply
+                  (gmt/multiply!
                    (-> (gmt/matrix)
-                       (gmt/translate center)
-                       (gmt/multiply (gmt/rotate-matrix rotation))
-                       (gmt/translate (gpt/negate center)))
-                   matrix))]
-            (recur matrix (rest modifiers))))))))
+                       (cond-> ^boolean (some? tf)
+                         (gmt/multiply! tf))
+                       (gmt/translate! origin)
+                       (gmt/scale! vector)
+                       (gmt/translate! (gpt/negate origin))
+                       (cond-> ^boolean (some? tfi)
+                         (gmt/multiply! tfi)))
+                   matrix))
+
+                :rotation
+                (let [center   (dm/get-prop modifier :center)
+                      rotation (dm/get-prop modifier :rotation)]
+                  (gmt/multiply!
+                   (-> (gmt/matrix)
+                       (gmt/translate! center)
+                       (gmt/multiply! (gmt/rotate-matrix rotation))
+                       (gmt/translate! (gpt/negate center)))
+                   matrix)))]
+          (recur matrix (next modifiers)))))))
 
 (defn apply-structure-modifiers
   "Apply structure changes to a shape"
@@ -519,36 +581,48 @@
             (cond-> shape
               (cph/text-shape? shape)
               (update :content scale-text-content value)))]
+
     (let [remove-children
           (fn [shapes children-to-remove]
             (let [remove? (set children-to-remove)]
               (d/removev remove? shapes)))
 
           apply-modifier
-          (fn [shape {:keys [type property value index rotation]}]
-            (cond-> shape
-              (= type :rotation)
-              (update :rotation #(mod (+ % rotation) 360))
+          (fn [shape operation]
+            (let [type (dm/get-prop operation :type)]
+              (case type
+                :rotation
+                (let [rotation (dm/get-prop operation :value)]
+                  (update shape :rotation #(mod (+ (or % 0) rotation) 360)))
 
-              (and (= type :add-children) (some? index))
-              (update :shapes
-                      (fn [shapes]
-                        (if (vector? shapes)
-                          (cph/insert-at-index shapes index value)
-                          (d/concat-vec shapes value))))
+                :add-children
+                (let [value (dm/get-prop operation :value)
+                      index (dm/get-prop operation :index)]
+                  (if (some? index)
+                    (update shape :shapes
+                            (fn [shapes]
+                              (if (vector? shapes)
+                                (cph/insert-at-index shapes index value)
+                                (d/concat-vec shapes value))))
+                    (update shape :shapes d/concat-vec value)))
 
-              (and (= type :add-children) (nil? index))
-              (update :shapes d/concat-vec value)
+                :remove-children
+                (let [value (dm/get-prop operation :value)]
+                  (update shape :shapes remove-children value))
 
-              (= type :remove-children)
-              (update :shapes remove-children value)
 
-              (= type :scale-content)
-              (apply-scale-content value)
+                :scale-content
+                (let [value (dm/get-prop operation :value)]
+                  (apply-scale-content shape value))
 
-              (= type :change-property)
-              (assoc property value)))]
+                :change-property
+                (let [property (dm/get-prop operation :property)
+                      value (dm/get-prop operation :value)]
+                  (assoc shape property value))
+
+                ;; :default => no change to shape
+                shape)))]
 
       (as-> shape $
-        (reduce apply-modifier $ (:structure-parent modifiers))
-        (reduce apply-modifier $ (:structure-child modifiers))))))
+        (reduce apply-modifier $ (dm/get-prop modifiers :structure-parent))
+        (reduce apply-modifier $ (dm/get-prop modifiers :structure-child))))))

common/test/common_tests/geom_point_test.cljc

@@ -6,6 +6,7 @@
 
 (ns common-tests.geom-point-test
   (:require
+   [app.common.math :as mth]
    [app.common.geom.point :as gpt]
    [clojure.test :as t]))
 
@@ -14,32 +15,32 @@
         p2 (gpt/point 2 3)
         rs (gpt/add p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= 3 (:x rs)))
-    (t/is (= 5 (:y rs)))))
+    (t/is (mth/close? 3 (:x rs)))
+    (t/is (mth/close? 5 (:y rs)))))
 
 (t/deftest substract-points
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 2 3)
         rs (gpt/subtract p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= -1 (:x rs)))
-    (t/is (= -1 (:y rs)))))
+    (t/is (mth/close? -1 (:x rs)))
+    (t/is (mth/close? -1 (:y rs)))))
 
 (t/deftest multiply-points
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 2 3)
         rs (gpt/multiply p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= 2 (:x rs)))
-    (t/is (= 6 (:y rs)))))
+    (t/is (mth/close? 2 (:x rs)))
+    (t/is (mth/close? 6 (:y rs)))))
 
 (t/deftest divide-points
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 2 5)
         rs (gpt/divide p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= 0.5 (:x rs)))
-    (t/is (= 0.4 (:y rs)))))
+    (t/is (mth/close? 0.5 (:x rs)))
+    (t/is (mth/close? 0.4 (:y rs)))))
 
 (t/deftest min-point
   (let [p1 (gpt/point 1 2)
@@ -49,19 +50,19 @@
       (t/is (nil? rs)))
 
     (let [rs (gpt/min p1)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/min nil p1)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/min p1 nil)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/min p1 p2)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/min p2 p1)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
     ))
 
 (t/deftest max-point
@@ -72,140 +73,140 @@
       (t/is (nil? rs)))
 
     (let [rs (gpt/max p1)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/max nil p1)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/max p1 nil)]
-      (t/is (= rs p1)))
+      (t/is (gpt/close? rs p1)))
 
     (let [rs (gpt/max p1 p2)]
-      (t/is (= rs p2)))
+      (t/is (gpt/close? rs p2)))
 
     (let [rs (gpt/max p2 p1)]
-      (t/is (= rs p2)))
+      (t/is (gpt/close? rs p2)))
     ))
 
 (t/deftest inverse-point
   (let [p1 (gpt/point 1 2)
         rs (gpt/inverse p1)]
     (t/is (gpt/point? rs))
-    (t/is (= 1 (:x rs)))
-    (t/is (= 0.5 (:y rs)))))
+    (t/is (mth/close? 1 (:x rs)))
+    (t/is (mth/close? 0.5 (:y rs)))))
 
 (t/deftest negate-point
   (let [p1 (gpt/point 1 2)
         rs (gpt/negate p1)]
     (t/is (gpt/point? rs))
-    (t/is (= -1 (:x rs)))
-    (t/is (= -2 (:y rs)))))
+    (t/is (mth/close? -1 (:x rs)))
+    (t/is (mth/close? -2 (:y rs)))))
 
 (t/deftest distance-between-two-points
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 4 6)
         rs (gpt/distance p1 p2)]
     (t/is (number? rs))
-    (t/is (= 5 rs))))
+    (t/is (mth/close? 5 rs))))
 
 (t/deftest distance-vector-between-two-points
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 2 3)
         rs (gpt/distance-vector p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= 1 (:x rs)))
-    (t/is (= 1 (:y rs)))))
+    (t/is (mth/close? 1 (:x rs)))
+    (t/is (mth/close? 1 (:y rs)))))
 
 (t/deftest point-length
   (let [p1 (gpt/point 1 10)
         rs (gpt/length p1)]
     (t/is (number? rs))
-    (t/is (= 10.04987562112089 rs))))
+    (t/is (mth/close? 10.04987562112089 rs))))
 
 (t/deftest point-angle-1
   (let [p1 (gpt/point 1 3)
         rs (gpt/angle p1)]
     (t/is (number? rs))
-    (t/is (= 71.56505117707799 rs))))
+    (t/is (mth/close? 71.56505117707799 rs))))
 
 (t/deftest point-angle-2
   (let [p1 (gpt/point 1 3)
         p2 (gpt/point 2 4)
         rs (gpt/angle p1 p2)]
     (t/is (number? rs))
-    (t/is (= -135 rs))))
+    (t/is (mth/close? -135 rs))))
 
 (t/deftest point-angle-with-other
   (let [p1 (gpt/point 1 3)
         p2 (gpt/point 1 5)
         rs (gpt/angle-with-other p1 p2)]
     (t/is (number? rs))
-    (t/is (= 7.125016348901757 rs))))
+    (t/is (mth/close? 7.125016348901757 rs))))
 
 (t/deftest point-angle-sign
   (let [p1 (gpt/point 1 3)
         p2 (gpt/point 1 5)
         rs (gpt/angle-sign p1 p2)]
     (t/is (number? rs))
-    (t/is (= 1 rs)))
+    (t/is (mth/close? 1 rs)))
 
   (let [p1 (gpt/point -11 -3)
         p2 (gpt/point 1 5)
         rs (gpt/angle-sign p1 p2)]
     (t/is (number? rs))
-    (t/is (= -1 rs)))
+    (t/is (mth/close? -1 rs)))
   )
 
 (t/deftest update-angle
   (let [p1 (gpt/point 1 3)
         rs (gpt/update-angle p1 10)]
     (t/is (gpt/point? rs))
-    (t/is (= 3.1142355569111246 (:x rs)))
-    (t/is (= 0.5491237529650835 (:y rs)))))
+    (t/is (mth/close? 3.1142355569111246 (:x rs)))
+    (t/is (mth/close? 0.5491237529650835 (:y rs)))))
 
 
 (t/deftest point-quadrant
   (let [p1 (gpt/point 1 3)
         rs (gpt/quadrant p1)]
     (t/is (number? rs))
-    (t/is (= 1 rs)))
+    (t/is (mth/close? 1 rs)))
 
   (let [p1 (gpt/point 1 -3)
         rs (gpt/quadrant p1)]
     (t/is (number? rs))
-    (t/is (= 4 rs)))
+    (t/is (mth/close? 4 rs)))
 
   (let [p1 (gpt/point -1 3)
         rs (gpt/quadrant p1)]
     (t/is (number? rs))
-    (t/is (= 2 rs)))
+    (t/is (mth/close? 2 rs)))
 
   (let [p1 (gpt/point -1 -3)
         rs (gpt/quadrant p1)]
     (t/is (number? rs))
-    (t/is (= 3 rs)))
+    (t/is (mth/close? 3 rs)))
   )
 
 (t/deftest round-point
   (let [p1 (gpt/point 1.34567 3.34567)
         rs (gpt/round p1)]
     (t/is (gpt/point? rs))
-    (t/is (= 1 (:x rs)))
-    (t/is (= 3 (:y rs))))
+    (t/is (mth/close? 1 (:x rs)))
+    (t/is (mth/close? 3 (:y rs))))
 
   (let [p1 (gpt/point 1.34567 3.34567)
         rs (gpt/round p1 2)]
     (t/is (gpt/point? rs))
-    (t/is (= 1.35 (:x rs)))
-    (t/is (= 3.35 (:y rs))))
+    (t/is (mth/close? 1.35 (:x rs)))
+    (t/is (mth/close? 3.35 (:y rs))))
   )
 
 (t/deftest halft-round-point
   (let [p1 (gpt/point 1.34567 3.34567)
         rs (gpt/half-round p1)]
     (t/is (gpt/point? rs))
-    (t/is (= 1.5 (:x rs)))
-    (t/is (= 3.5 (:y rs)))))
+    (t/is (mth/close? 1.5 (:x rs)))
+    (t/is (mth/close? 3.5 (:y rs)))))
 
 (t/deftest transform-point
   ;;todo
@@ -215,30 +216,30 @@
   (let [p1 (gpt/point 1.5 3)
         rs (gpt/scale p1 2)]
     (t/is (gpt/point? rs))
-    (t/is (= 3 (:x rs)))
-    (t/is (= 6 (:y rs)))))
+    (t/is (mth/close? 3 (:x rs)))
+    (t/is (mth/close? 6 (:y rs)))))
 
 (t/deftest dot-point
   (let [p1 (gpt/point 1.5 3)
         p2 (gpt/point 2 6)
         rs (gpt/dot p1 p2)]
     (t/is (number? rs))
-    (t/is (= 21 rs))))
+    (t/is (mth/close? 21 rs))))
 
 (t/deftest unit-point
   (let [p1 (gpt/point 2 3)
         rs (gpt/unit p1)]
     (t/is (gpt/point? rs))
-    (t/is (= 0.5547001962252291 (:x rs)))
-    (t/is (= 0.8320502943378437 (:y rs)))))
+    (t/is (mth/close? 0.5547001962252291 (:x rs)))
+    (t/is (mth/close? 0.8320502943378437 (:y rs)))))
 
 (t/deftest project-point
   (let [p1 (gpt/point 1 3)
         p2 (gpt/point 1 6)
         rs (gpt/project p1 p2)]
     (t/is (gpt/point? rs))
-    (t/is (= 0.5135135135135135 (:x rs)))
-    (t/is (= 3.081081081081081 (:y rs)))))
+    (t/is (mth/close? 0.5135135135135135 (:x rs)))
+    (t/is (mth/close? 3.081081081081081 (:y rs)))))
 
 (t/deftest center-points
   (let [points [(gpt/point 0.5 0.5)
@@ -246,22 +247,22 @@
                 (gpt/point 20 65.2)
                 (gpt/point 12 -10)]
         rs     (gpt/center-points points)]
-    (t/is (= 7.875 (:x rs)))
-    (t/is (= 13.425 (:y rs)))))
+    (t/is (mth/close? 7.875 (:x rs)))
+    (t/is (mth/close? 13.425 (:y rs)))))
 
 (t/deftest normal-left-point
   (let [p1 (gpt/point 2 3)
         rs (gpt/normal-left p1)]
     (t/is (gpt/point? rs))
-    (t/is (= -0.8320502943378437 (:x rs)))
-    (t/is (= 0.5547001962252291 (:y rs)))))
+    (t/is (mth/close? -0.8320502943378437 (:x rs)))
+    (t/is (mth/close? 0.5547001962252291 (:y rs)))))
 
 (t/deftest normal-right-point
   (let [p1 (gpt/point 2 3)
         rs (gpt/normal-right p1)]
     (t/is (gpt/point? rs))
-    (t/is (= 0.8320502943378437 (:x rs)))
-    (t/is (= -0.5547001962252291 (:y rs)))))
+    (t/is (mth/close? 0.8320502943378437 (:x rs)))
+    (t/is (mth/close? -0.5547001962252291 (:y rs)))))
 
 (t/deftest point-line-distance
   (let [p1 (gpt/point 2 -3)
@@ -269,7 +270,7 @@
         p3 (gpt/point 5 6)
         rs (gpt/point-line-distance p1 p2 p3)]
     (t/is (number? rs))
-    (t/is (= 7.58946638440411 rs))))
+    (t/is (mth/close? 7.58946638440411 rs))))
 
 (t/deftest almost-zero-predicate
   (let [p1 (gpt/point 0.000001 0.0000002)
@@ -282,14 +283,14 @@
         p2 (gpt/point 2 3)
         rs (gpt/lerp p1 p2 2)]
     (t/is (gpt/point? rs))
-    (t/is (= 3 (:x rs)))
-    (t/is (= 4 (:y rs)))))
+    (t/is (mth/close? 3 (:x rs)))
+    (t/is (mth/close? 4 (:y rs)))))
 
 (t/deftest rotate-point
   (let [p1 (gpt/point 1 2)
         p2 (gpt/point 2 3)
         rs (gpt/rotate p1 p2 11)]
     (t/is (gpt/point? rs))
-    (t/is (= 1.2091818119288809 (:x rs)))
-    (t/is (= 1.8275638211757912 (:y rs)))))
+    (t/is (mth/close? 1.2091818119288809 (:x rs)))
+    (t/is (mth/close? 1.8275638211757912 (:y rs)))))
 

common/test/common_tests/geom_shapes_test.cljc

@@ -140,7 +140,7 @@
   (t/testing "Transform shape with rotation modifiers"
     (t/are [type]
         (let [shape-before (create-test-shape type)
-              modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 30 )
+              modifiers (ctm/rotation-modifiers shape-before (gsh/center-shape shape-before) 30)
               shape-before (assoc shape-before :modifiers modifiers)
               shape-after  (gsh/transform-shape shape-before)]
 

frontend/dev/bench.cljs

@@ -3,8 +3,10 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.geom.point :as gpt]
+   [app.common.geom.point :as gpt]
    [app.common.geom.shapes.rect :as gsr]
    [app.common.perf :as perf]
+   [app.common.types.modifiers :as ctm]
    [clojure.spec.alpha :as s]
    [clojure.test.check.generators :as gen]))
 
@@ -24,8 +26,40 @@
    :samples 20
    :name "optimized"))
 
+(def modifiers
+  (-> (ctm/empty)
+      (ctm/move (gpt/point 100 200))
+      (ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
+      (ctm/move (gpt/point -100 -200))
+      (ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))
+      (ctm/rotation (gpt/point 0 0) -100)
+      (ctm/resize (gpt/point 100 200) (gpt/point 2.0 0.5))))
+
+(defn bench-modifiers
+  []
+  (perf/benchmark
+   :f #(ctm/modifiers->transform modifiers)
+   :max-iterations 50000
+   :samples 20
+   :name "current")
+
+  #_(perf/benchmark
+   :f #(ctm/modifiers->transform-2 modifiers)
+   :max-iterations 50000
+   :samples 20
+   :name "optimized"))
+
+;; (ctm/modifiers->transform-2 modifiers)
+
+(defn ^:dev/after-load after-load
+  []
+  #_(bench-modifiers))
+
 (defn main
   [& [name]]
   (case name
     "points" (bench-points)
-    (println "available: points")))
+    "modifiers" (bench-modifiers)
+    (println "available: points"))
+  #_(.exit js/process 0))
+

frontend/src/app/main/ui/workspace/shapes/text/viewport_texts_html.cljs

@@ -47,10 +47,8 @@
 (defn process-shape [modifiers {:keys [id] :as shape}]
   (let [modifier (dm/get-in modifiers [id :modifiers])]
     (-> shape
-        (cond-> (and (some? modifier)
-                     (not (ctm/only-move? modifier)))
+        (cond-> (and (some? modifier) (not (ctm/only-move? modifier)))
           (fix-position modifier))
-
         (cond-> (nil? (:position-data shape))
           (assoc :migrate true))
         strip-position-data)))
@@ -132,6 +130,21 @@
                          :shape shape
                          :grow-type (:grow-type shape)}]))
 
+(defn text-properties-equal?
+  [shape other]
+  (or (identical? shape other)
+      (and
+       ;; Check if both shapes are equivalent removing their geometry data
+       (= (dissoc shape :migrate :points :selrect :height :width :x :y)
+          (dissoc other :migrate :points :selrect :height :width :x :y))
+
+       ;; Check if the position and size is close. If any of these changes the shape has changed
+       ;; and if not there is no geometry relevant change
+       (mth/close? (:x shape) (:x other))
+       (mth/close? (:y shape) (:y other))
+       (mth/close? (:width shape) (:width other))
+       (mth/close? (:height shape) (:height other)))))
+
 (mf/defc viewport-texts-wrapper
   {::mf/wrap-props false
    ::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]}
@@ -149,12 +162,9 @@
                 old-modifiers (ctm/select-geometry (get prev-modifiers id))
                 new-modifiers (ctm/select-geometry (get modifiers id))
 
-                remote? (some? (-> new-shape meta :session-id)) ]
-
+                remote? (some? (-> new-shape meta :session-id))]
             (or (and (not remote?)
-                     (not (identical? old-shape new-shape))
-                     (not= (dissoc old-shape :migrate)
-                           (dissoc new-shape :migrate)))
+                     (not (text-properties-equal? old-shape new-shape)))
 
                 (and (not= new-modifiers old-modifiers)
                      (or (not (ctm/only-move? new-modifiers))
@@ -172,6 +182,7 @@
 
         handle-update-modifier (mf/use-callback update-text-modifier)
         handle-update-shape (mf/use-callback update-text-shape)]
+
     [:*
      (for [{:keys [id] :as shape} changed-texts]
        [:& text-container {:shape shape