;; This Source Code Form is subject to the terms of the Mozilla Public ;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; ;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; defined by the Mozilla Public License, v. 2.0. ;; ;; Copyright (c) 2020 UXBOX Labs SL (ns app.main.snap (:require [clojure.set :as set] [beicon.core :as rx] [app.common.uuid :refer [zero]] [app.common.math :as mth] [app.common.data :as d] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.main.worker :as uw] [app.main.refs :as refs] [app.util.geom.snap-points :as sp])) (defonce ^:private snap-accuracy 5) (defonce ^:private snap-distance-accuracy 10) (defn- remove-from-snap-points [remove-id?] (fn [query-result] (->> query-result (map (fn [[value data]] [value (remove (comp remove-id? second) data)])) (filter (fn [[_ data]] (not (empty? data))))))) (defn- flatten-to-points [query-result] (mapcat (fn [[v data]] (map (fn [[point _]] point) data)) query-result)) (defn- calculate-distance [query-result point coord] (->> query-result (map (fn [[value data]] [(mth/abs (- value (coord point))) [(coord point) value]])))) (defn- get-min-distance-snap [points coord] (fn [query-result] (->> points (mapcat #(calculate-distance query-result % coord)) (apply min-key first) second))) (defn- snap-frame-id [shapes] (let [frames (into #{} (map :frame-id shapes))] (cond ;; Only shapes from one frame. The common is the only one (= 0 (count frames)) (first frames) ;; Frames doesn't contain zero. So we take the first frame (not (frames zero)) (-> shapes first :frame-id) ;; Otherwise the root frame is the common :else zero))) (defn get-snap-points [page-id frame-id filter-shapes point coord] (let [value (get point coord)] (->> (uw/ask! {:cmd :snaps/range-query :page-id page-id :frame-id frame-id :coord coord :ranges [[(- value 0.5) (+ value 0.5)]]}) (rx/first) (rx/map (remove-from-snap-points filter-shapes)) (rx/map flatten-to-points)))) (defn- search-snap [page-id frame-id points coord filter-shapes zoom] (let [snap-accuracy (/ snap-accuracy zoom) ranges (->> points (map coord) (mapv #(vector (- % snap-accuracy) (+ % snap-accuracy))))] (->> (uw/ask! {:cmd :snaps/range-query :page-id page-id :frame-id frame-id :coord coord :ranges ranges}) (rx/first) (rx/map (remove-from-snap-points filter-shapes)) (rx/map (get-min-distance-snap points coord))))) (defn snap->vector [[from-x to-x] [from-y to-y]] (when (or from-x to-x from-y to-y) (let [from (gpt/point (or from-x 0) (or from-y 0)) to (gpt/point (or to-x 0) (or to-y 0))] (gpt/to-vec from to)))) (defn- closest-snap [page-id frame-id points filter-shapes zoom] (let [snap-x (search-snap page-id frame-id points :x filter-shapes zoom) snap-y (search-snap page-id frame-id points :y filter-shapes zoom)] ;; 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 zoom] (let [snap-distance-accuracy (/ snap-distance-accuracy zoom) 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 (fn [[sh-lt sh-gt]] ;; To calculate the middle snap. ;; Given x, the distance to a left shape and y to a right shape ;; x - v = y + v => v = (x - y)/2 ;; v will be the vector that we need to move the shape so it "snaps" ;; in the middle (/ (- (dist-gt sh-gt) (dist-lt sh-lt)) 2)) ;; Calculates the distance between all the shapes given as argument inner-distance (fn [selrects] (->> selrects (sort-by coord) (d/map-perm #(sr-distance coord %1 %2) #(overlap? coord %1 %2) #{}))) best-snap (fn [acc val] ;; Using a number is faster than accesing the variable. ;; Keep up to date with `snap-distance-accuracy` (if (and (<= val snap-distance-accuracy) (>= val (- snap-distance-accuracy))) (min acc val) acc)) ;; Distance between the elements in an area, these are the snap ;; candidates to either side 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 (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 -) gt-snap (d/join gt-dist gt-cand -) ;; Calculate snap-between between-snap (->> (d/join shapes-lt shapes-gt) (map between-snap)) ;; 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))) (defn search-snap-distance [selrect coord shapes-lt shapes-gt zoom] (->> shapes-lt (rx/combine-latest vector shapes-gt) (rx/map (fn [[shapes-lt shapes-gt]] (calculate-snap coord selrect shapes-lt shapes-gt zoom))))) (defn select-shapes-area [page-id shapes objects area-selrect] (->> (uw/ask! {:cmd :selection/query :page-id page-id :frame-id (->> shapes first :frame-id) :rect area-selrect}) (rx/map #(set/difference % (into #{} (map :id shapes)))) (rx/map (fn [ids] (map #(get objects %) ids))))) (defn closest-distance-snap [page-id shapes objects zoom movev] (let [frame-id (snap-frame-id shapes) frame (get objects frame-id) selrect (->> shapes (map #(gsh/move % movev)) gsh/selection-rect)] (->> (rx/of (vector frame selrect)) (rx/merge-map (fn [[frame selrect]] (let [areas (->> (gsh/selrect->areas (or (:selrect frame) (gsh/rect->selrect @refs/vbox)) selrect) (d/mapm #(select-shapes-area page-id shapes objects %2))) snap-x (search-snap-distance selrect :x (:left areas) (:right areas) zoom) snap-y (search-snap-distance selrect :y (:top areas) (:bottom areas) zoom)] (rx/combine-latest snap->vector snap-y snap-x))))))) (defn closest-snap-point [page-id shapes layout zoom point] (let [frame-id (snap-frame-id shapes) filter-shapes (into #{} (map :id shapes)) filter-shapes (fn [id] (if (= id :layout) (or (not (contains? layout :display-grid)) (not (contains? layout :snap-grid))) (or (filter-shapes id) (not (contains? layout :dynamic-alignment)))))] (->> (closest-snap page-id frame-id [point] filter-shapes zoom) (rx/map #(or % (gpt/point 0 0))) (rx/map #(gpt/add point %))))) (defn closest-snap-move [page-id shapes objects layout zoom movev] (let [frame-id (snap-frame-id shapes) filter-shapes (into #{} (map :id shapes)) filter-shapes (fn [id] (if (= id :layout) (or (not (contains? layout :display-grid)) (not (contains? layout :snap-grid))) (or (filter-shapes id) (not (contains? layout :dynamic-alignment))))) shape (if (> (count shapes) 1) (->> shapes (map gsh/transform-shape) gsh/selection-rect (gsh/setup {:type :rect})) (->> shapes (first))) shapes-points (->> shape (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 zoom) (when (contains? layout :dynamic-alignment) (closest-distance-snap page-id shapes objects zoom movev))) (rx/reduce gpt/min) (rx/map #(or % (gpt/point 0 0))))))