✨ Path-point calculation

common/app/common/geom/shapes/path.cljc

@@ -225,3 +225,92 @@
                point))
 
       (conj result [prev-point last-start]))))
+
+(defonce path-closest-point-accuracy 0.01)
+(defn curve-closest-point
+  [position start end h1 h2]
+  (let [d (memoize (fn [t] (gpt/distance position (curve-values start end h1 h2 t))))]
+    (loop [t1 0
+           t2 1]
+      (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
+        (curve-values start end h1 h2 t1)
+
+        (let [ht  (+ t1 (/ (- t2 t1) 2))
+              ht1 (+ t1 (/ (- t2 t1) 4))
+              ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
+
+              [t1 t2] (cond
+                        (< (d ht1) (d ht2))
+                        [t1 ht]
+
+                        (< (d ht2) (d ht1))
+                        [ht t2]
+
+                        (and (< (d ht) (d t1)) (< (d ht) (d t2)))
+                        [ht1 ht2]
+                        
+                        (< (d t1) (d t2))
+                        [t1 ht]
+
+                        :else
+                        [ht t2])]
+          (recur t1 t2))))))
+
+(defn line-closest-point
+  "Point on line"
+  [position from-p to-p]
+
+  (let [{v1x :x v1y :y} from-p
+        {v2x :x v2y :y} to-p
+        {px :x py :y} position
+
+        e1 (gpt/point (- v2x v1x) (- v2y v1y))
+        e2 (gpt/point (- px v1x) (- py v1y))
+
+        len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
+        val-dp (/ (gpt/dot e1 e2) len2)]
+
+    (if (and (>= val-dp 0)
+             (<= val-dp 1)
+             (not (mth/almost-zero? len2)))
+      (gpt/point (+ v1x (* val-dp (:x e1))) 
+                 (+ v1y (* val-dp (:y e1))))
+      ;; There is no perpendicular projection in the line so the closest
+      ;; point will be one of the extremes
+      (if (<= (gpt/distance position from-p) (gpt/distance position to-p))
+        from-p
+        to-p))))
+
+(defn path-closest-point
+  "Given a path and a position"
+  [shape position]
+
+  (let [point+distance (fn [[cur-cmd prev-cmd]]
+                         (let [point
+                               (case (:command cur-cmd)
+                                 :line-to (line-closest-point
+                                           position
+                                           (command->point prev-cmd)
+                                           (command->point cur-cmd))
+                                 :curve-to (curve-closest-point
+                                            position
+                                            (command->point prev-cmd)
+                                            (command->point cur-cmd)
+                                            (gpt/point (get-in cur-cmd [:params :c1x])
+                                                       (get-in cur-cmd [:params :c1y]))
+                                            (gpt/point (get-in cur-cmd [:params :c2x])
+                                                       (get-in cur-cmd [:params :c2y])))
+                                 nil)]
+                           (when point
+                             [point (gpt/distance point position)])))
+
+        find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
+                         (if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
+                           [min-p min-dist]
+                           [cur-p cur-dist]))]
+    
+    (->> (:content shape)
+         (d/with-prev)
+         (map point+distance)
+         (reduce find-min-point)
+         (first))))

frontend/src/app/main/data/workspace/path/drawing.cljs

@@ -133,8 +133,11 @@
             (->> stream (rx/filter #(or (helpers/end-path-event? %)
                                         (ms/mouse-up? %))))
 
+            content (get-in state (st/get-path state :content))
+            points (ugp/content->points content)
+            
             drag-events-stream
-            (->> (streams/position-stream)
+            (->> (streams/position-stream points)
                  (rx/take-until stop-stream)
                  (rx/map #(drag-handler %)))]
 
@@ -163,7 +166,10 @@
             zoom (get-in state [:workspace-local :zoom])
             mouse-up    (->> stream (rx/filter #(or (helpers/end-path-event? %)
                                                     (ms/mouse-up? %))))
-            drag-events (->> (streams/position-stream)
+            content (get-in state (st/get-path state :content))
+            points (ugp/content->points content)
+
+            drag-events (->> (streams/position-stream points)
                              (rx/take-until mouse-up)
                              (rx/map #(drag-handler %)))]
 
@@ -183,10 +189,10 @@
        (rx/merge-map #(rx/empty))))
 
 (defn make-drag-stream
-  [stream down-event zoom]
+  [stream down-event zoom points]
   (let [mouse-up    (->> stream (rx/filter #(or (helpers/end-path-event? %)
                                                 (ms/mouse-up? %))))
-        drag-events (->> (streams/position-stream)
+        drag-events (->> (streams/position-stream points)
                          (rx/take-until mouse-up)
                          (rx/map #(drag-handler %)))]
 
@@ -213,9 +219,12 @@
             mouse-down      (->> stream (rx/filter ms/mouse-down?))
             end-path-events (->> stream (rx/filter helpers/end-path-event?))
 
+            content (get-in state (st/get-path state :content))
+            points (ugp/content->points content)
+
             ;; Mouse move preview
             mousemove-events
-            (->> (streams/position-stream)
+            (->> (streams/position-stream points)
                  (rx/take-until end-path-events)
                  (rx/map #(preview-next-point %)))
 
@@ -223,12 +232,12 @@
             mousedown-events
             (->> mouse-down
                  (rx/take-until end-path-events)
-                 (rx/with-latest merge (streams/position-stream))
+                 (rx/with-latest merge (streams/position-stream points))
 
                  ;; We change to the stream that emits the first event
                  (rx/switch-map
                   #(rx/race (make-node-events-stream stream)
-                            (make-drag-stream stream % zoom))))]
+                            (make-drag-stream stream % zoom points))))]
 
         (rx/concat
          (rx/of (common/init-path))
@@ -269,6 +278,12 @@
   "Creates a new path shape"
   []
   (ptk/reify ::handle-new-shape
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [id (st/get-path-id state)]
+        (-> state
+            (assoc-in [:workspace-local :edit-path id :snap-toggled] true))))
+
     ptk/WatchEvent
     (watch [_ state stream]
       (let [shape-id (get-in state [:workspace-drawing :object :id])]

frontend/src/app/main/data/workspace/path/edition.cljs

@@ -118,6 +118,9 @@
             selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
             selected? (contains? selected-points position)
 
+            content (get-in state (st/get-path state :content))
+            points (ugp/content->points content)
+
             mouse-drag-stream
             (rx/concat
              ;; If we're dragging a selected item we don't change the selection
@@ -126,7 +129,7 @@
                (rx/of (selection/select-node position shift?)))
 
              ;; This stream checks the consecutive mouse positions to do the draging
-             (->> (streams/position-stream)
+             (->> (streams/position-stream points)
                   (rx/take-until stopper)
                   (rx/map #(move-selected-path-point start-position %)))
              (rx/of (apply-content-modifiers)))
@@ -151,6 +154,8 @@
             start-delta-y (get-in modifiers [index cy] 0)
 
             content (get-in state (st/get-path state :content))
+            points (ugp/content->points content)
+
             opposite-index   (ugp/opposite-index content index prefix)
             opposite-prefix  (if (= prefix :c1) :c2 :c1)
             opposite-handler (-> content (get opposite-index) (ugp/get-handler opposite-prefix))
@@ -163,7 +168,7 @@
 
         (streams/drag-stream
          (rx/concat
-          (->> (streams/position-stream)
+          (->> (streams/position-stream points)
                (rx/take-until (->> stream (rx/filter ms/mouse-up?)))
                (rx/map
                 (fn [{:keys [x y alt? shift?]}]

frontend/src/app/main/data/workspace/path/streams.cljs

@@ -15,7 +15,8 @@
    [app.main.streams :as ms]
    [beicon.core :as rx]
    [potok.core :as ptk]
-   [app.common.math :as mth]))
+   [app.common.math :as mth]
+   [app.main.snap :as snap]))
 
 (defonce drag-threshold 5)
 
@@ -53,11 +54,17 @@
   (let [k 50]
     (* (mth/floor (/ num k)) k)))
 
-(defn position-stream []
+(defn position-stream
-  (->> ms/mouse-position
+  ([points]
-       ;; TODO: Prueba para el snap
+   (position-stream points #{}))
-       #_(rx/map #(-> %
+
-                    (update :x to-dec)
+  ([points selected-points]
-                    (update :y to-dec)))
+   (let [zoom (get-in @st/state [:workspace-local :zoom] 1)]
+     (->> (snap/path-snap ms/mouse-position points selected-points zoom)
+          (rx/with-latest vector ms/mouse-position)
+          (rx/map (fn [[{[x] :x [y] :y} position]]
+                    (cond-> position
+                      (some? x) (assoc :x x)
+                      (some? y) (assoc :y y))))
           (rx/with-latest merge (->> ms/mouse-position-shift (rx/map #(hash-map :shift? %))))
-       (rx/with-latest merge (->> ms/mouse-position-alt (rx/map #(hash-map :alt? %))))))
+          (rx/with-latest merge (->> ms/mouse-position-alt (rx/map #(hash-map :alt? %))))))))

frontend/src/app/main/snap.cljs

@@ -15,6 +15,7 @@
    [app.main.refs :as refs]
    [app.main.worker :as uw]
    [app.util.geom.snap-points :as sp]
+   [app.util.range-tree :as rt]
    [beicon.core :as rx]
    [clojure.set :as set]))
 
@@ -240,3 +241,32 @@
          (rx/reduce gpt/min)
          (rx/map #(or % (gpt/point 0 0))))))
 
+(defn path-snap [position-stream points selected-points zoom]
+  (let [selected-points (or selected-points #{})
+        into-tree (fn [coord]
+                    (fn [tree point]
+                      (rt/insert tree (get point coord) point)))
+
+        ranges-x (->> points
+                      (filter (comp not selected-points))
+                      (reduce (into-tree :x) (rt/make-tree)))
+
+        ranges-y (->> points
+                      (filter (comp not selected-points))
+                      (reduce (into-tree :y) (rt/make-tree)))
+
+        min-match (fn [matches]
+                    (->> matches
+                         (reduce (fn [[cur-val :as current] [other-val :as other]]
+                                   (if (< cur-val other-val)
+                                     current
+                                     other)))))]
+
+    (->> position-stream
+         (rx/map
+          (fn [{:keys [x y]}]
+            (let [d-pos (/ snap-accuracy zoom)
+                  x-match (rt/range-query ranges-x (- x d-pos) (+ x d-pos))
+                  y-match (rt/range-query ranges-y (- y d-pos) (+ y d-pos))]
+              {:x (min-match x-match)
+               :y (min-match y-match)}))))))

frontend/src/app/main/ui/workspace/shapes/path/editor.cljs

@@ -8,16 +8,19 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.path :as gshp]
    [app.main.data.workspace.path :as drp]
+   [app.main.snap :as snap]
    [app.main.store :as st]
+   [app.main.streams :as ms]
    [app.main.ui.cursors :as cur]
+   [app.main.ui.hooks :as hooks]
    [app.main.ui.workspace.shapes.path.common :as pc]
    [app.util.dom :as dom]
    [app.util.geom.path :as ugp]
+   [app.util.keyboard :as kbd]
    [goog.events :as events]
-   [rumext.alpha :as mf]
+   [rumext.alpha :as mf])
-
-   [app.util.keyboard :as kbd])
   (:import goog.events.EventType))
 
 (mf/defc path-point [{:keys [position zoom edit-mode hover? selected? preview? start-path? last-p?]}]
@@ -131,8 +134,9 @@
   [:g.preview {:style {:pointer-events "none"}}
    (when (not= :move-to (:command command))
      [:path {:style {:fill "transparent"
-                     :stroke pc/secondary-color
+                     :stroke pc/black-color
-                     :stroke-width (/ 1 zoom)}
+                     :stroke-width (/ 1 zoom)
+                     :stroke-dasharray (/ 4 zoom)}
              :d (ugp/content->path [{:command :move-to
                                      :params {:x (:x from)
                                               :y (:y from)}}
@@ -141,11 +145,23 @@
                    :preview? true
                    :zoom zoom}]])
 
+(mf/defc snap-path-points [{:keys [snaps zoom]}]
+  [:g.snap-paths
+   (for [[from to] snaps]
+     [:line {:x1 (:x from)
+             :y1 (:y from)
+             :x2 (:x to)
+             :y2 (:y to)
+             :style {:stroke pc/secondary-color
+                     :stroke-width (/ 1 zoom)}}])])
+
 (mf/defc path-editor
   [{:keys [shape zoom]}]
 
   (let [editor-ref (mf/use-ref nil)
         edit-path-ref (pc/make-edit-path-ref (:id shape))
+        hover-point (mf/use-state nil)
+
         {:keys [edit-mode
                 drag-handler
                 prev-handler
@@ -158,9 +174,9 @@
                 hover-points]
          :as edit-path} (mf/deref edit-path-ref)
 
-        {:keys [content]} shape
+        {base-content :content} shape
-        content (ugp/apply-content-modifiers content content-modifiers)
+        content (ugp/apply-content-modifiers base-content content-modifiers)
-        points (->> content ugp/content->points (into #{}))
+        points (mf/use-memo (mf/deps content) #(->> content ugp/content->points (into #{})))
         last-command (last content)
         last-p (->> content last ugp/command->point)
         handlers (ugp/content->handlers content)
@@ -177,12 +193,34 @@
          #(doseq [key keys]
             (events/unlistenByKey key)))))
 
+    #_(hooks/use-stream
+     ms/mouse-position
+     (mf/deps shape)
+     (fn [position]
+       (reset! hover-point (gshp/path-closest-point shape position))))
+
+    (hooks/use-stream
+     (mf/use-memo
+      (mf/deps base-content selected-points zoom)
+      #(snap/path-snap ms/mouse-position points selected-points zoom))
+
+     (fn [result]
+       (prn "??" result)))
+
     [:g.path-editor {:ref editor-ref}
+     #_[:& snap-points {}]
+
+     
      (when (and preview (not drag-handler))
        [:& path-preview {:command preview
                          :from last-p
                          :zoom zoom}])
 
+     (when @hover-point
+       [:g.hover-point
+        [:& path-point {:position @hover-point
+                        :zoom zoom}]])
+
      (for [position points]
        (let [point-selected? (contains? selected-points position)
              point-hover? (contains? hover-points position)

frontend/src/app/main/ui/workspace/viewport.cljs

@@ -171,7 +171,8 @@
        :width (:width vport 0)
        :height (:height vport 0)
        :view-box (utils/format-viewbox vbox)
-       :style {:background-color (get options :background "#E8E9EA")}}
+       :style {:background-color (get options :background "#E8E9EA")
+               :pointer-events "none"}}
 
       [:& (mf/provider muc/embed-ctx) {:value true}
        ;; Render root shape