diff --git a/common/app/common/data.cljc b/common/app/common/data.cljc index 994b0a82e..25d0e9ca8 100644 --- a/common/app/common/data.cljc +++ b/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. diff --git a/common/app/common/geom/shapes.cljc b/common/app/common/geom/shapes.cljc index 113cc741b..d40ab6114 100644 --- a/common/app/common/geom/shapes.cljc +++ b/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)] diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs index a62761cc0..1fbf6dc35 100644 --- a/frontend/src/app/main/data/workspace/transforms.cljs +++ b/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 %})))) diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs index d12ed81bf..4a77fc6b9 100644 --- a/frontend/src/app/main/snap.cljs +++ b/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)))))) diff --git a/frontend/src/app/main/ui/workspace/snap_distances.cljs b/frontend/src/app/main/ui/workspace/snap_distances.cljs index f501a71d6..41d36fba0 100644 --- a/frontend/src/app/main/ui/workspace/snap_distances.cljs +++ b/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