✨ Snap distances performance improvements

common/app/common/data.cljc

@@ -162,14 +162,37 @@
 (defn map-perm
   "Maps a function to each pair of values that can be combined inside the
   function without repetition.
+
+  Optional parmeters:
+  `pred?`   A predicate that if not satisfied won't process the pair
+  `target?` A collection that will be used as seed to be stored
+
   Example:
   (map-perm vector [1 2 3 4]) => [[1 2] [1 3] [1 4] [2 3] [2 4] [3 4]]"
-  [mfn coll]
-  (if (empty? coll)
-    []
-    (core/concat
-     (map (partial mfn (first coll)) (rest coll))
-     (map-perm mfn (rest coll)))))
+  ([mfn coll]
+   (map-perm mfn (constantly true) [] coll))
+  ([mfn pred? coll]
+   (map-perm mfn pred? [] coll))
+  ([mfn pred? target coll]
+   (loop [result (transient target)
+          current (first coll)
+          coll (rest coll)]
+     (if (not current)
+       (persistent! result)
+       (let [result
+             (loop [result result
+                    other (first coll)
+                    coll (rest coll)]
+               (if (not other)
+                 result
+                 (recur (cond-> result
+                          (pred? current other)
+                          (conj! (mfn current other)))
+                        (first coll)
+                        (rest coll))))]
+         (recur result
+                (first coll)
+                (rest coll)))))))
 
 (defn join
   "Returns a new collection with the cartesian product of both collections.

common/app/common/geom/shapes.cljc

@@ -218,27 +218,6 @@
 (defn distance-shapes [shape other]
   (distance-selrect (:selrect shape) (:selrect other)))
 
-(defn overlap-coord?
-  "Checks if two shapes overlap in one axis"
-  [coord shape other]
-  (let [[s1c1 s1c2 s2c1 s2c2]
-        ;; If checking if overlaps in x-axis we need to check the y
-        ;; coordinates, and the other way around
-        (if (= coord :x)
-          [(get-in shape [:selrect :y1])
-           (get-in shape [:selrect :y2])
-           (get-in other [:selrect :y1])
-           (get-in other [:selrect :y2])]
-          [(get-in shape [:selrect :x1])
-           (get-in shape [:selrect :x2])
-           (get-in other [:selrect :x1])
-           (get-in other [:selrect :x2])])]
-    (or (and (>= s2c1 s1c1) (<= s2c1 s1c2))
-        (and (>= s2c2 s1c1) (<= s2c2 s1c2))
-        (and (>= s1c1 s2c1) (<= s1c1 s2c2))
-        (and (>= s1c2 s2c1) (<= s1c2 s2c2)))))
-
-
 (defn setup-selrect [shape]
   (let [selrect (gpr/rect->selrect shape)
         points  (gpr/rect->points shape)]

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

@@ -283,13 +283,19 @@
              ids     (if (nil? ids) (get-in state [:workspace-local :selected]) ids)
              shapes  (mapv #(get objects %) ids)
              stopper (rx/filter ms/mouse-up? stream)
-             layout  (get state :workspace-layout)]
+             layout  (get state :workspace-layout)
+
+
+             position (->> ms/mouse-position
+                           (rx/take-until stopper)
+                           (rx/map #(gpt/to-vec from-position %)))
+
+             snap-delta (->> position
+                             (rx/switch-map #(snap/closest-snap-move page-id shapes objects layout %)))]
          (rx/concat
-          (->> ms/mouse-position
-               (rx/take-until stopper)
-               (rx/map #(gpt/to-vec from-position %))
-               (rx/switch-map #(snap/closest-snap-move page-id shapes objects layout %))
-               (rx/map #(gpt/round % 0))
+          (->> snap-delta
+               (rx/with-latest vector position)
+               (rx/map (fn [[delta pos]] (-> (gpt/add pos delta) (gpt/round 0))))
                (rx/map gmt/translate-matrix)
                (rx/map #(fn [state] (assoc-in state [:workspace-local :modifiers] {:displacement %}))))
 

frontend/src/app/main/snap.cljs

@@ -96,10 +96,27 @@
     ;; snap-x is the second parameter because is the "source" to combine
     (rx/combine-latest snap->vector snap-y snap-x)))
 
+(defn sr-distance [coord sr1 sr2]
+  (let [c1 (if (= coord :x) :x1 :y1)
+        c2 (if (= coord :x) :x2 :y2)
+        dist (- (c1 sr2) (c2 sr1))]
+    dist))
+
+(defn overlap? [coord sr1 sr2]
+  (let [c1 (if (= coord :x) :y1 :x1)
+        c2 (if (= coord :x) :y2 :x2)
+        s1c1 (c1 sr1)
+        s1c2 (c2 sr1)
+        s2c1 (c1 sr2)
+        s2c2 (c2 sr2)]
+    (or (and (>= s2c1 s1c1) (<= s2c1 s1c2))
+        (and (>= s2c2 s1c1) (<= s2c2 s1c2))
+        (and (>= s1c1 s2c1) (<= s1c1 s2c2))
+        (and (>= s1c2 s2c1) (<= s1c2 s2c2)))))
+
 (defn calculate-snap [coord selrect shapes-lt shapes-gt]
-  (let [dist (fn [[sh1 sh2]] (-> sh1 (gsh/distance-shapes sh2) coord))
-        dist-lt (fn [other] (-> (:selrect other) (gsh/distance-selrect selrect) coord))
-        dist-gt (fn [other] (-> selrect (gsh/distance-selrect (:selrect other)) coord))
+  (let [dist-lt (fn [other] (sr-distance coord (:selrect other) selrect))
+        dist-gt (fn [other] (sr-distance coord selrect (:selrect other)))
 
         ;; Calculates the snap distance when in the middle of two shapes
         between-snap
@@ -114,13 +131,12 @@
 
         ;; Calculates the distance between all the shapes given as argument
         inner-distance
-        (fn [shapes]
-          (->> shapes
+        (fn [selrects]
+          (->> selrects
                (sort-by coord)
-               (d/map-perm vector)
-               (filter (fn [[sh1 sh2]] (gsh/overlap-coord? coord sh1 sh2)))
-               (map dist)
-               (filterv #(> % 0))))
+               (d/map-perm #(sr-distance coord %1 %2)
+                           #(overlap? coord %1 %2)
+                           #{})))
 
         best-snap
         (fn [acc val]
@@ -132,13 +148,13 @@
 
         ;; Distance between the elements in an area, these are the snap
         ;; candidates to either side
-        lt-cand (inner-distance shapes-lt)
-        gt-cand (inner-distance shapes-gt)
+        lt-cand (inner-distance (mapv :selrect shapes-lt))
+        gt-cand (inner-distance (mapv :selrect shapes-gt))
 
         ;; Distance between the elements to either side and the current shape
         ;; this is the distance that will "snap"
-        lt-dist (mapv dist-lt shapes-lt)
-        gt-dist (mapv dist-gt shapes-gt)
+        lt-dist (into #{} (map dist-lt) shapes-lt)
+        gt-dist (into #{} (map dist-gt) shapes-gt)
 
         ;; Calculate the snaps, we need to reverse depending on area
         lt-snap (d/join lt-cand lt-dist -)
@@ -150,6 +166,7 @@
 
         ;; Search the minimum snap
         snap-list (-> [] (d/concat lt-snap) (d/concat gt-snap) (d/concat between-snap))
+
         min-snap (reduce best-snap ##Inf snap-list)]
 
     (if (mth/finite? min-snap) [0 min-snap] nil)))
@@ -214,11 +231,10 @@
                            (sp/shape-snap-points)
                            ;; Move the points in the translation vector
                            (map #(gpt/add % movev)))]
+
     (->> (rx/merge (closest-snap page-id frame-id shapes-points filter-shapes)
                    (when (contains? layout :dynamic-alignment)
                      (closest-distance-snap page-id shapes objects movev)))
          (rx/reduce gpt/min)
-         (rx/map #(or % (gpt/point 0 0)))
-         (rx/map #(gpt/add movev %))
-         (rx/map #(gpt/round % 0)))))
+         (rx/map #(or % (gpt/point 0 0))))))
 

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

@@ -112,12 +112,30 @@
                :x2 x2 :y2 y2
                :style {:stroke line-color :stroke-width (str (/ 1 zoom))}}])]))
 
-(defn calculate-segments [coord selrect lt-shapes gt-shapes]
-  (let [pair->distance+pair
-        (fn [[sh1 sh2]]
-          [(-> (gsh/distance-shapes sh1 sh2) coord (mth/precision 0)) [sh1 sh2]])
+(defn add-distance [coord sh1 sh2]
+  (let [sr1 (:selrect sh1)
+        sr2 (:selrect sh2)
+        c1 (if (= coord :x) :x1 :y1)
+        c2 (if (= coord :x) :x2 :y2)
+        dist (mth/precision (- (c1 sr2) (c2 sr1)) 0)]
+    [dist [sh1 sh2]]))
 
-        distance-to-selrect
+(defn overlap? [coord sh1 sh2]
+  (let [sr1 (:selrect sh1)
+        sr2 (:selrect sh2)
+        c1 (if (= coord :x) :y1 :x1)
+        c2 (if (= coord :x) :y2 :x2)
+        s1c1 (c1 sr1)
+        s1c2 (c2 sr1)
+        s2c1 (c1 sr2)
+        s2c2 (c2 sr2)]
+    (or (and (>= s2c1 s1c1) (<= s2c1 s1c2))
+        (and (>= s2c2 s1c1) (<= s2c2 s1c2))
+        (and (>= s1c1 s2c1) (<= s1c1 s2c2))
+        (and (>= s1c2 s2c1) (<= s1c2 s2c2)))))
+
+(defn calculate-segments [coord selrect lt-shapes gt-shapes]
+  (let [distance-to-selrect
         (fn [shape]
           (let [sr (:selrect shape)]
             (-> (if (<= (coord sr) (coord selrect))
@@ -129,11 +147,10 @@
         get-shapes-match
         (fn [pred? shapes]
           (->> shapes
-               (sort-by coord)
-               (d/map-perm vector)
-               (filter (fn [[sh1 sh2]] (gsh/overlap-coord? coord sh1 sh2)))
-               (map pair->distance+pair)
-               (filter (comp pred? first))))
+               (sort-by (comp coord :selrect))
+               (d/map-perm #(add-distance coord %1 %2)
+                           #(overlap? coord %1 %2))
+               (filterv (comp pred? first))))
 
         ;; Checks if the value is in a set of numbers with an error margin
         check-in-set
@@ -144,15 +161,17 @@
         ;; Left/Top shapes and right/bottom shapes (depends on `coord` parameter
 
         ;; Gets the distance to the current selection
-        lt-distances (->> lt-shapes (map distance-to-selrect) (filter pos?) (into #{}))
-        gt-distances (->> gt-shapes (map distance-to-selrect) (filter pos?) (into #{}))
+        distances-xf (comp (map distance-to-selrect) (filter pos?))
+        lt-distances (into #{} distances-xf lt-shapes)
+        gt-distances (into #{} distances-xf gt-shapes)
+        distances (set/union lt-distances gt-distances)
 
         ;; We'll show the distances that match a distance from the selrect
-        show-candidate? #(check-in-set % (set/union lt-distances gt-distances))
+        show-candidate? #(check-in-set % distances)
 
         ;; Checks the distances between elements for distances that match the set of distances
-        distance-coincidences (concat (get-shapes-match show-candidate? lt-shapes)
-                                      (get-shapes-match show-candidate? gt-shapes))
+        distance-coincidences (d/concat (get-shapes-match show-candidate? lt-shapes)
+                                        (get-shapes-match show-candidate? gt-shapes))
 
         ;; Stores the distance candidates to be shown
         distance-candidates (d/concat
@@ -219,14 +238,16 @@
             (->> (query-side lt-side)
                  (rx/combine-latest vector (query-side gt-side)))))
 
-
         [lt-shapes gt-shapes] @to-measure
 
-        segments-to-display (calculate-segments coord selrect lt-shapes gt-shapes)]
+        segments-to-display (mf/use-memo
+                             (mf/deps @to-measure)
+                             #(calculate-segments coord selrect lt-shapes gt-shapes))]
 
     (mf/use-effect
      (fn []
        (let [sub (->> subject
+                      (rx/throttle 100)
                       (rx/switch-map query-worker)
                       (rx/subs #(reset! to-measure %)))]
          ;; On unmount dispose