penpot/frontend/src/uxbox/main/snap.cljs

;; 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 uxbox.main.snap
  (:require
   [beicon.core :as rx]
   [uxbox.common.uuid :refer [zero]]
   [uxbox.util.math :as mth]
   [uxbox.util.geom.point :as gpt]
   [uxbox.main.worker :as uw]
   [uxbox.util.geom.snap-points :as sp]))

(def ^:private snap-accuracy 5)

(defn- remove-from-snap-points [ids-to-remove]
  (fn [query-result]
    (->> query-result
         (map (fn [[value data]] [value (remove (comp ids-to-remove 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 (coord point)]
    (->> (uw/ask! {:cmd :snaps/range-query
                   :page-id page-id
                   :frame-id frame-id
                   :coord coord
                   :ranges [[(- value 1) (+ value 1)]]})
         (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]
  (let [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- closest-snap
  [page-id frame-id points filter-shapes]
  (let [snap-x (search-snap page-id frame-id points :x filter-shapes)
        snap-y (search-snap page-id frame-id points :y filter-shapes)
        snap-as-vector (fn [[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)))]
    ;; snap-x is the second parameter because is the "source" to combine
    (rx/combine-latest snap-as-vector snap-y snap-x)))

(defn closest-snap-point
  [page-id shapes layout point]
  (if (layout :dynamic-alignment)
    (let [frame-id (snap-frame-id shapes)
          filter-shapes (into #{} (map :id shapes))]
      (->> (closest-snap page-id frame-id [point] filter-shapes)
           (rx/map #(gpt/add point %))))
    (rx/of point)))

(defn closest-snap-move
  [page-id shapes layout movev]
  (if (layout :dynamic-alignment)
    (let [frame-id (snap-frame-id shapes)
          filter-shapes (into #{} (map :id shapes))
          shapes-points (->> shapes
                             ;; Unroll all the possible snap-points
                             (mapcat (partial sp/shape-snap-points))

                             ;; Move the points in the translation vector
                             (map #(gpt/add % movev)))]
      (->> (closest-snap page-id frame-id shapes-points filter-shapes)
           (rx/map #(gpt/add movev %))))
    (rx/of movev)))