diff --git a/common/src/app/common/geom/matrix.cljc b/common/src/app/common/geom/matrix.cljc
index ac7443f2d..0158fe7df 100644
--- a/common/src/app/common/geom/matrix.cljc
+++ b/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]
diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc
index 5421af3ce..e15f0fff0 100644
--- a/common/src/app/common/geom/point.cljc
+++ b/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"
diff --git a/common/src/app/common/geom/shapes/constraints.cljc b/common/src/app/common/geom/shapes/constraints.cljc
index 35ddd66a8..6275e673f 100644
--- a/common/src/app/common/geom/shapes/constraints.cljc
+++ b/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
diff --git a/common/src/app/common/geom/shapes/flex_layout/modifiers.cljc b/common/src/app/common/geom/shapes/flex_layout/modifiers.cljc
index 8ad936478..481d27390 100644
--- a/common/src/app/common/geom/shapes/flex_layout/modifiers.cljc
+++ b/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
diff --git a/common/src/app/common/geom/shapes/modifiers.cljc b/common/src/app/common/geom/shapes/modifiers.cljc
index d0588cfa9..0677a4293 100644
--- a/common/src/app/common/geom/shapes/modifiers.cljc
+++ b/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)
diff --git a/common/src/app/common/geom/shapes/transforms.cljc b/common/src/app/common/geom/shapes/transforms.cljc
index 38a4ee7e6..4383b28e8 100644
--- a/common/src/app/common/geom/shapes/transforms.cljc
+++ b/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]
diff --git a/common/src/app/common/types/modifiers.cljc b/common/src/app/common/types/modifiers.cljc
index 608d78ab1..b0c882700 100644
--- a/common/src/app/common/types/modifiers.cljc
+++ b/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))))))
diff --git a/common/test/common_tests/geom_point_test.cljc b/common/test/common_tests/geom_point_test.cljc
index b83d70e7c..c98052315 100644
--- a/common/test/common_tests/geom_point_test.cljc
+++ b/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)))))
diff --git a/common/test/common_tests/geom_shapes_test.cljc b/common/test/common_tests/geom_shapes_test.cljc
index a9d1e2df7..07f971e6f 100644
--- a/common/test/common_tests/geom_shapes_test.cljc
+++ b/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)]
diff --git a/frontend/dev/bench.cljs b/frontend/dev/bench.cljs
index 41171bafe..bc1b6cdf8 100644
--- a/frontend/dev/bench.cljs
+++ b/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))
+
diff --git a/frontend/src/app/main/ui/workspace/shapes/text/viewport_texts_html.cljs b/frontend/src/app/main/ui/workspace/shapes/text/viewport_texts_html.cljs
index 6798a4a5e..673f47a35 100644
--- a/frontend/src/app/main/ui/workspace/shapes/text/viewport_texts_html.cljs
+++ b/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