;; 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.ui.workspace.snap-points (:require [app.common.math :as mth] [app.common.data :as d] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.main.refs :as refs] [app.main.snap :as snap] [app.util.geom.snap-points :as sp] [beicon.core :as rx] [rumext.alpha :as mf])) (def ^:private line-color "#D383DA") (def ^:private line-opacity 0.6) (def ^:private line-width 1) ;; Configuration for debug ;; (def ^:private line-color "red") ;; (def ^:private line-opacity 1 ) ;; (def ^:private line-width 2) (mf/defc snap-point [{:keys [point zoom]}] (let [{:keys [x y]} point x (mth/round x) y (mth/round y) cross-width (/ 3 zoom)] [:g [:line {:x1 (- x cross-width) :y1 (- y cross-width) :x2 (+ x cross-width) :y2 (+ y cross-width) :style {:stroke line-color :stroke-width (str (/ line-width zoom))}}] [:line {:x1 (- x cross-width) :y1 (+ y cross-width) :x2 (+ x cross-width) :y2 (- y cross-width) :style {:stroke line-color :stroke-width (str (/ line-width zoom))}}]])) (mf/defc snap-line [{:keys [snap point zoom]}] [:line {:x1 (mth/round (:x snap)) :y1 (mth/round (:y snap)) :x2 (mth/round (:x point)) :y2 (mth/round (:y point)) :style {:stroke line-color :stroke-width (str (/ line-width zoom))} :opacity line-opacity}]) (defn get-snap [coord {:keys [shapes page-id filter-shapes local]}] (let [shape (if (> (count shapes) 1) (->> shapes (map gsh/transform-shape) gsh/selection-rect) (->> shapes (first))) shape (if (:modifiers local) (-> shape (assoc :modifiers (:modifiers local)) gsh/transform-shape) shape) frame-id (snap/snap-frame-id shapes)] (->> (rx/of shape) (rx/flat-map (fn [shape] (->> (sp/shape-snap-points shape) (map #(vector frame-id %))))) (rx/flat-map (fn [[frame-id point]] (->> (snap/get-snap-points page-id frame-id filter-shapes point coord) (rx/map #(vector point % coord))))) (rx/reduce conj [])))) (defn- flip "Function that reverses the x/y coordinates to their counterpart" [coord] (if (= coord :x) :y :x)) (defn add-point-to-snaps [[point snaps coord]] (let [normalize-coord #(assoc % coord (get point coord))] (cons point (map normalize-coord snaps)))) (defn- process-snap-lines "Gets the snaps for a coordinate and creates lines with a fixed coordinate" [snaps coord] (->> snaps ;; only snap on the `coord` coordinate (filter #(= (nth % 2) coord)) ;; we add the point so the line goes from the point to the snap (mapcat add-point-to-snaps) ;; We flatten because it's a list of from-to points (flatten) ;; Put together the points of the coordinate (group-by coord) ;; Keep only the other coordinate (d/mapm #(map (flip coord) %2)) ;; Finally get the max/min and this will define the line to draw (d/mapm #(vector (apply min %2) (apply max %2))) ;; Change the structure to retrieve a list of lines from/todo (map (fn [[fixedv [minv maxv]]] [(hash-map coord fixedv (flip coord) minv) (hash-map coord fixedv (flip coord) maxv)])))) (mf/defc snap-feedback [{:keys [shapes page-id filter-shapes zoom local] :as props}] (let [state (mf/use-state []) subject (mf/use-memo #(rx/subject)) ;; We use sets to store points/lines so there are no points/lines repeated ;; can cause problems with react keys snap-points (into #{} (mapcat add-point-to-snaps) @state) snap-lines (into (process-snap-lines @state :x) (process-snap-lines @state :y))] (mf/use-effect (fn [] (let [sub (->> subject (rx/switch-map #(rx/combine-latest d/concat (get-snap :y %) (get-snap :x %))) (rx/subs #(let [rs (filter (fn [[_ snaps _]] (> (count snaps) 0)) %)] (reset! state rs))))] ;; On unmount callback #(rx/dispose! sub)))) (mf/use-effect (mf/deps shapes local) (fn [] (rx/push! subject props))) [:g.snap-feedback (for [[from-point to-point] snap-lines] [:& snap-line {:key (str "line-" (:x from-point) "-" (:y from-point) "-" (:x to-point) "-" (:y to-point) "-") :snap from-point :point to-point :zoom zoom}]) (for [point snap-points] [:& snap-point {:key (str "point-" (:x point) "-" (:y point)) :point point :zoom zoom}])])) (mf/defc snap-points {::mf/wrap [mf/memo]} [{:keys [layout zoom selected page-id drawing transform local] :as props}] (let [shapes (mf/deref (refs/objects-by-id selected)) filter-shapes (mf/deref refs/selected-shapes-with-children) 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))))) ;; current-transform (mf/deref refs/current-transform) ;; snap-data (mf/deref refs/workspace-snap-data) shapes (if drawing [drawing] shapes)] (when (or drawing transform) [:& snap-feedback {:shapes shapes :page-id page-id :filter-shapes filter-shapes :zoom zoom :local local}])))