From 718a187c1e146157adfcbc86559010f22afcb2b2 Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Thu, 3 Dec 2020 13:12:29 +0100
Subject: [PATCH] :sparkles: Reduces the snap-distances feedback

---
 common/app/common/geom/shapes.cljc            | 20 +++++++---
 .../app/main/ui/workspace/snap_distances.cljs | 37 +++++++++++--------
 frontend/src/app/worker.cljs                  |  1 +
 3 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/common/app/common/geom/shapes.cljc b/common/app/common/geom/shapes.cljc
index 4f633ed60f..5dbb6260e7 100644
--- a/common/app/common/geom/shapes.cljc
+++ b/common/app/common/geom/shapes.cljc
@@ -201,14 +201,22 @@
 (defn selrect->areas [bounds selrect]
   (let [make-selrect
         (fn [x1 y1 x2 y2]
-          {:x1 x1 :y1 y1 :x2 x2 :y2 y2 :x x1 :y y1
-           :width (- x2 x1) :height (- y2 y1) :type :rect})
+          (let [x1 (min x1 x2)
+                x2 (max x1 x2)
+                y1 (min y1 y2)
+                y2 (max y1 y2)]
+            {:x1 x1 :y1 y1
+             :x2 x2 :y2 y2
+             :x x1  :y y1
+             :width (- x2 x1)
+             :height (- y2 y1)
+             :type :rect}))
         {frame-x1 :x1 frame-x2 :x2 frame-y1 :y1 frame-y2 :y2} bounds
         {sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect]
-    {:left   (make-selrect frame-x1 sr-y1 sr-x1 sr-y2)
-     :top    (make-selrect sr-x1 frame-y1 sr-x2 sr-y1)
-     :right  (make-selrect sr-x2 sr-y1 frame-x2 sr-y2)
-     :bottom (make-selrect sr-x1 sr-y2 sr-x2 frame-y2)}))
+    {:left   (make-selrect frame-x1 sr-y1 (- sr-x1 2) sr-y2)
+     :top    (make-selrect sr-x1 frame-y1 sr-x2 (- sr-y1 2))
+     :right  (make-selrect (+ sr-x2 2) sr-y1 frame-x2 sr-y2)
+     :bottom (make-selrect sr-x1 (+ sr-y2 2) sr-x2 frame-y2)}))
 
 (defn distance-selrect [selrect other]
   (let [{:keys [x1 y1]} other
diff --git a/frontend/src/app/main/ui/workspace/snap_distances.cljs b/frontend/src/app/main/ui/workspace/snap_distances.cljs
index 442131450e..139b9c289e 100644
--- a/frontend/src/app/main/ui/workspace/snap_distances.cljs
+++ b/frontend/src/app/main/ui/workspace/snap_distances.cljs
@@ -145,12 +145,15 @@
                                      (gsh/rect->selrect @refs/vbox))
                 areas (gsh/selrect->areas container-selrec selrect)
                 query-side (fn [side]
-                             (->> (uw/ask! {:cmd :selection/query
-                                            :page-id page-id
-                                            :frame-id (:id frame)
-                                            :rect (gsh/pad-selrec (areas side))})
-                                  (rx/map #(set/difference % selected))
-                                  (rx/map #(->> % (map (partial get @refs/workspace-page-objects))))))]
+                             (let [rect (gsh/pad-selrec (areas side))]
+                               (if (and (> (:width rect) 0) (> (:height rect) 0))
+                                 (->> (uw/ask! {:cmd :selection/query
+                                                :page-id page-id
+                                                :frame-id (:id frame)
+                                                :rect rect})
+                                      (rx/map #(set/difference % selected))
+                                      (rx/map #(->> % (map (partial get @refs/workspace-page-objects)))))
+                                 (rx/of nil))))]
 
             (->> (query-side lt-side)
                  (rx/combine-latest vector (query-side gt-side)))))
@@ -193,25 +196,29 @@
         distance-coincidences (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
+                             #{}
+                             (map first distance-coincidences)
+                             (filter #(check-in-set % lt-distances) gt-distances)
+                             (filter #(check-in-set % gt-distances) lt-distances))
+
+        ;; Of these candidates we keep only the smaller to be displayed
+        min-distance (apply min distance-candidates)
 
         ;; Show the distances that either match one of the distances from the selrect
         ;; or are from the selrect and go to a shape on the left and to the right
-        show-distance?
-        (fn [dist]
-          (let [distances-to-show
-                (->> (d/concat #{}
-                               (map first distance-coincidences)
-                               (filter #(check-in-set % lt-distances) gt-distances)
-                               (filter #(check-in-set % gt-distances) lt-distances)))]
-            (check-in-set dist distances-to-show)))
+        show-distance? #(check-in-set % #{min-distance})
 
         ;; These are the segments whose distance will be displayed
 
-        ;; First segments from segments different that the selectio
+        ;; First segments from segments different that the selection
         other-shapes-segments (->> distance-coincidences
+                                   (filter #(show-distance? (first %)))
                                    (map second) ;; Retrieves list of [shape,shape] tuples
                                    (map #(mapv :selrect %))) ;; Changes [shape,shape] to [selrec,selrec]
 
+
         ;; Segments from the selection to the other shapes
         selection-segments (->> (concat lt-shapes gt-shapes)
                                 (filter #(show-distance? (distance-to-selrect %)))
diff --git a/frontend/src/app/worker.cljs b/frontend/src/app/worker.cljs
index 952d5e184a..d26963dfd2 100644
--- a/frontend/src/app/worker.cljs
+++ b/frontend/src/app/worker.cljs
@@ -62,6 +62,7 @@
                                {:reply-to sender-id
                                 :payload result}))))
     (catch :default e
+      (.error js/console "error" e)
       (let [message {:reply-to sender-id
                      :error {:data (ex-data e)
                              :message (ex-message e)}}]