diff --git a/common/app/common/geom/shapes/path.cljc b/common/app/common/geom/shapes/path.cljc index 5ab3a340a..eaa177254 100644 --- a/common/app/common/geom/shapes/path.cljc +++ b/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)))) diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs index feadd1a9e..09633ec17 100644 --- a/frontend/src/app/main/data/workspace/path/drawing.cljs +++ b/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])] diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs index c40c99259..4f723b8fb 100644 --- a/frontend/src/app/main/data/workspace/path/edition.cljs +++ b/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?]}] diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs index eb061f0b2..2f5c27a85 100644 --- a/frontend/src/app/main/data/workspace/path/streams.cljs +++ b/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 [] - (->> ms/mouse-position - ;; TODO: Prueba para el snap - #_(rx/map #(-> % - (update :x to-dec) - (update :y to-dec))) - (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? %)))))) +(defn position-stream + ([points] + (position-stream points #{})) + + ([points selected-points] + (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? %)))))))) diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs index e82c67f00..36570576e 100644 --- a/frontend/src/app/main/snap.cljs +++ b/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)})))))) diff --git a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs index 85fb3ce86..66fcdf63f 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/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] - - [app.util.keyboard :as kbd]) + [rumext.alpha :as mf]) (: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-width (/ 1 zoom)} + :stroke pc/black-color + :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 - content (ugp/apply-content-modifiers content content-modifiers) - points (->> content ugp/content->points (into #{})) + {base-content :content} shape + content (ugp/apply-content-modifiers base-content content-modifiers) + 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) diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs index c9f3779ab..fda4afe53 100644 --- a/frontend/src/app/main/ui/workspace/viewport.cljs +++ b/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