diff --git a/common/src/app/common/types/path.cljc b/common/src/app/common/types/path.cljc
index 2b1188682f..5b186c2edd 100644
--- a/common/src/app/common/types/path.cljc
+++ b/common/src/app/common/types/path.cljc
@@ -18,6 +18,7 @@
[app.common.types.path.helpers :as helpers]
[app.common.types.path.impl :as impl]
[app.common.types.path.segment :as segment]
+ [app.common.types.path.selection :as selection]
[app.common.types.path.shape-to-path :as stp]
[app.common.types.path.subpath :as subpath]))
@@ -209,6 +210,120 @@
(let [content (impl/path-data content)]
(segment/get-points content)))
+(defn segment-entries
+ "Selectable path segments with their command index and endpoints."
+ [content]
+ (let [content (impl/path-data content)]
+ (segment/segment-entries content)))
+
+(defn single-line?
+ "True when the content is a single straight segment: a move-to
+ followed by exactly one line-to."
+ [content]
+ (and (some? content)
+ (= 2 (count content))
+ (= :move-to (:command (nth content 0)))
+ (= :line-to (:command (nth content 1)))))
+
+(defn close-loops
+ "Closes subpaths whose endpoints meet and returns PathData."
+ [content]
+ (-> (subpath/close-loops content)
+ (impl/from-plain)))
+
+(defn extract-content
+ "Extracts selected segments and segments between selected nodes into new
+ subpaths."
+ [content {:keys [nodes segments]}]
+ (let [content (impl/path-data content)
+ nodes (or nodes #{})
+ segments (or segments #{})
+ selected? (fn [{:keys [index from-index to-index]}]
+ (or (contains? segments index)
+ (and (contains? nodes from-index)
+ (contains? nodes to-index))))
+ entries (filterv selected? (segment/segment-entries content))
+ plain (loop [entries (seq entries)
+ prev nil
+ result (transient [])]
+ (if-let [{:keys [from from-index to segment] :as entry} (first entries)]
+ (let [result (cond-> result
+ (not= from-index (:to-index prev))
+ (conj! {:command :move-to
+ :params {:x (:x from) :y (:y from)}}))
+ result (conj! result
+ (if (= :close-path (:command segment))
+ {:command :line-to
+ :params {:x (:x to) :y (:y to)}}
+ segment))]
+ (recur (next entries) entry result))
+ (persistent! result)))]
+ (-> (close-subpaths (impl/path-data plain))
+ (close-loops))))
+
+(defn splice-content
+ "Appends sub-content as new subpaths."
+ [content sub-content]
+ (impl/path-data (into (vec content) (vec sub-content))))
+
+(defn- move-segment-end
+ "Moves a segment endpoint and its incoming handle by `delta`."
+ [segment {dx :x dy :y}]
+ (cond-> (-> segment
+ (update-in [:params :x] + dx)
+ (update-in [:params :y] + dy))
+ (= :curve-to (:command segment))
+ (-> (update-in [:params :c2x] + dx)
+ (update-in [:params :c2y] + dy))))
+
+(defn- segment->end
+ "Returns the command arriving at an entry's end node as a drawable segment."
+ [{:keys [to segment]}]
+ (if (= :close-path (:command segment))
+ {:command :line-to :params {:x (:x to) :y (:y to)}}
+ segment))
+
+(defn- reverse-segment
+ "Reverses a segment toward `from`, swapping curve handles."
+ [segment {fx :x fy :y}]
+ (if (= :curve-to (:command segment))
+ (let [{:keys [c1x c1y c2x c2y]} (:params segment)]
+ {:command :curve-to
+ :params {:x fx :y fy :c1x c2x :c1y c2y :c2x c1x :c2y c1y}})
+ {:command :line-to :params {:x fx :y fy}}))
+
+(defn duplicate-node-content
+ "Copies a node and its incident segments, keeping their far ends attached.
+ Returns copied content and the relative indices of the new node."
+ [content index node-offset]
+ (let [content (impl/path-data content)
+ entries (segment-entries content)
+ incident (filterv #(or (= index (:to-index %))
+ (= index (:from-index %)))
+ entries)]
+ (if (seq incident)
+ (reduce (fn [{:keys [content selected]} {:keys [from to to-index segment] :as entry}]
+ (let [incoming? (= index to-index)
+ start (if incoming? from to)
+ end (if incoming?
+ (segment->end entry)
+ (reverse-segment segment from))
+ end (cond-> end
+ (some? node-offset) (move-segment-end node-offset))]
+ {:content (conj content
+ {:command :move-to
+ :params {:x (:x start) :y (:y start)}}
+ end)
+ :selected (conj selected (inc (count content)))}))
+ {:content [] :selected #{}}
+ incident)
+ (when-let [{:keys [x y]} (:params (nth content index nil))]
+ {:content [{:command :move-to
+ :params (if (some? node-offset)
+ {:x (+ x (:x node-offset)) :y (+ y (:y node-offset))}
+ {:x x :y y})}]
+ :selected #{0}}))))
+
(defn calc-selrect
"Calculate selrect from a content. The content can be in a PathData
instance or plain vector of segments."
@@ -279,6 +394,11 @@
[points & {:keys [close]}]
(segment/points->content points :close close))
+(defn smooth-points->content
+ "Fits smooth path content through `points`."
+ [points tolerance]
+ (segment/smooth-points->content points tolerance))
+
(defn closest-point
"Returns the closest point in the path to position, at a given precision."
[content position precision]
@@ -304,6 +424,30 @@
(let [content (impl/path-data content)]
(segment/split-segments content points value)))
+(defn is-curve-point?
+ "True when a node has at least one visible handler."
+ [content point]
+ (let [content (impl/path-data content)]
+ (boolean (segment/is-curve? content point))))
+
+(defn collapse-handler
+ "Collapses a handler onto its node and simplifies flat curves to lines."
+ [content index prefix]
+ (let [content (impl/path-data content)]
+ (segment/collapse-handler content index prefix)))
+
+(defn toggle-segment-curve
+ "Toggles a segment between a line and a curve."
+ [content index]
+ (let [content (impl/path-data content)]
+ (segment/toggle-segment-curve content index)))
+
+(defn remove-segments
+ "Removes segments, opening their subpaths and dropping empty ones."
+ [content indices]
+ (let [content (impl/path-data content)]
+ (segment/remove-segments content indices)))
+
(defn remove-nodes
"Removes the given points from content, reconstructing paths as needed."
[content points]
@@ -323,10 +467,49 @@
(segment/join-nodes content points)))
(defn separate-nodes
- "Removes the segments between the given points."
- [content points]
+ "Removes segments between points or splits one node into offset open ends."
+ ([content points]
+ (let [content (impl/path-data content)]
+ (segment/separate-nodes content points)))
+ ([content points offset]
+ (let [content (impl/path-data content)]
+ (segment/separate-nodes content points offset))))
+
+(defn flip-content
+ "Flips selected nodes and handles across their bounding box."
+ [content indices axis]
(let [content (impl/path-data content)]
- (segment/separate-nodes content points)))
+ (selection/flip-content content indices axis)))
+
+(defn align-content
+ "Aligns selected nodes and handles within their bounding box."
+ [content indices axis]
+ (let [content (impl/path-data content)]
+ (selection/align-content content indices axis)))
+
+(defn distribute-content
+ "Distributes selected nodes evenly along `axis`."
+ [content indices axis]
+ (let [content (impl/path-data content)]
+ (selection/distribute-content content indices axis)))
+
+(defn set-nodes-coordinate
+ "Sets one coordinate of selected nodes and their handles."
+ [content indices axis value]
+ (let [content (impl/path-data content)]
+ (selection/set-nodes-coordinate content indices axis value)))
+
+(defn set-handler-points
+ "Moves each handler in `pts` to its target point."
+ [content pts]
+ (let [content (impl/path-data content)]
+ (selection/set-handler-points content pts)))
+
+(defn translate-selected-nodes
+ "Moves selected nodes and their handles by `delta`."
+ [content indices delta]
+ (let [content (impl/path-data content)]
+ (selection/translate-selected-nodes content indices delta)))
(defn- calc-bool-content*
"Calculate the boolean content from shape and objects. Returns plain
diff --git a/common/src/app/common/types/path/fit.cljc b/common/src/app/common/types/path/fit.cljc
new file mode 100644
index 0000000000..486822a79f
--- /dev/null
+++ b/common/src/app/common/types/path/fit.cljc
@@ -0,0 +1,209 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+(ns app.common.types.path.fit
+ "Curve fitting helpers."
+ (:require
+ [app.common.geom.point :as gpt]
+ [app.common.math :as mth]
+ [app.common.types.path.helpers :as helpers]))
+
+(defn- chord-length-params
+ "Returns normalized chord-length parameters for `points`."
+ [points]
+ (let [dists (->> (map gpt/distance points (rest points))
+ (reductions + 0)
+ (vec))
+ total (peek dists)]
+ (if (mth/almost-zero? total)
+ (let [n (max 1 (dec (count points)))]
+ (mapv #(/ (double %) n) (range (count points))))
+ (mapv #(/ % total) dists))))
+
+(defn fit-cubic
+ "Fits one cubic through `points` with fixed endpoints and tangents."
+ ([points tan1 tan2]
+ (let [points (vec points)]
+ (fit-cubic points (chord-length-params points) tan1 tan2)))
+ ([points params tan1 tan2]
+ (let [points (vec points)
+ p0 (first points)
+ p3 (peek points)
+
+ [c00 c01 c11 x0 x1]
+ (reduce
+ (fn [[c00 c01 c11 x0 x1] [point u]]
+ (let [u' (- 1.0 u)
+ b0 (* u' u' u')
+ b1 (* 3.0 u u' u')
+ b2 (* 3.0 u u u')
+ b3 (* u u u)
+ a1 (gpt/scale tan1 b1)
+ a2 (gpt/scale tan2 b2)
+ tmp (-> point
+ (gpt/subtract (gpt/scale p0 (+ b0 b1)))
+ (gpt/subtract (gpt/scale p3 (+ b2 b3))))]
+ [(+ c00 (gpt/dot a1 a1))
+ (+ c01 (gpt/dot a1 a2))
+ (+ c11 (gpt/dot a2 a2))
+ (+ x0 (gpt/dot a1 tmp))
+ (+ x1 (gpt/dot a2 tmp))]))
+ [0.0 0.0 0.0 0.0 0.0]
+ (map vector points params))
+
+ det-c (- (* c00 c11) (* c01 c01))
+ alpha1 (when-not (mth/almost-zero? det-c)
+ (/ (- (* x0 c11) (* x1 c01)) det-c))
+ alpha2 (when-not (mth/almost-zero? det-c)
+ (/ (- (* c00 x1) (* c01 x0)) det-c))
+
+ chord (gpt/distance p0 p3)
+ epsilon (* 0.000001 chord)
+
+ [alpha1 alpha2]
+ (if (or (nil? alpha1) (nil? alpha2)
+ (< alpha1 epsilon) (< alpha2 epsilon))
+ [(/ chord 3.0) (/ chord 3.0)]
+ [alpha1 alpha2])]
+
+ [(gpt/add p0 (gpt/scale tan1 alpha1))
+ (gpt/add p3 (gpt/scale tan2 alpha2))])))
+
+(defn- curve-d1
+ "Returns the first derivative at `t`."
+ [[start end h1 h2] t]
+ (let [t' (- 1.0 t)
+ a (* 3.0 t' t')
+ b (* 6.0 t' t)
+ c (* 3.0 t t)]
+ (gpt/point (+ (* a (- (:x h1) (:x start)))
+ (* b (- (:x h2) (:x h1)))
+ (* c (- (:x end) (:x h2))))
+ (+ (* a (- (:y h1) (:y start)))
+ (* b (- (:y h2) (:y h1)))
+ (* c (- (:y end) (:y h2)))))))
+
+(defn- curve-d2
+ "Returns the second derivative at `t`."
+ [[start end h1 h2] t]
+ (let [t' (- 1.0 t)]
+ (gpt/point (+ (* 6.0 t' (+ (:x h2) (* -2.0 (:x h1)) (:x start)))
+ (* 6.0 t (+ (:x end) (* -2.0 (:x h2)) (:x h1))))
+ (+ (* 6.0 t' (+ (:y h2) (* -2.0 (:y h1)) (:y start)))
+ (* 6.0 t (+ (:y end) (* -2.0 (:y h2)) (:y h1)))))))
+
+(defn- refine-parameter
+ "Moves `u` toward the closest point on `curve`."
+ [curve point u]
+ (let [d (gpt/subtract (helpers/curve-values curve u) point)
+ d1 (curve-d1 curve u)
+ d2 (curve-d2 curve u)
+ den (+ (gpt/dot d1 d1) (gpt/dot d d2))]
+ (if (mth/almost-zero? den)
+ u
+ (mth/clamp (- u (/ (gpt/dot d d1) den)) 0.0 1.0))))
+
+(defn- max-fit-error
+ "Returns the largest interior fit error and its index."
+ [points params curve]
+ (let [n (count points)]
+ (loop [i 1
+ max-err 0.0
+ split (quot n 2)]
+ (if (>= i (dec n))
+ [max-err split]
+ (let [d (gpt/subtract (helpers/curve-values curve (nth params i))
+ (nth points i))
+ err (gpt/dot d d)]
+ (if (> err max-err)
+ (recur (inc i) err i)
+ (recur (inc i) max-err split)))))))
+
+(def ^:private ^:const max-fit-iterations 4)
+
+(defn- fit-curve*
+ "Fits one or more curves through at least two points."
+ [points tan1 tan2 tol2]
+ (let [n (count points)
+ p0 (first points)
+ p3 (peek points)]
+ (if (= n 2)
+ (let [alpha (/ (gpt/distance p0 p3) 3.0)]
+ [[p0 p3
+ (gpt/add p0 (gpt/scale tan1 alpha))
+ (gpt/add p3 (gpt/scale tan2 alpha))]])
+
+ (let [params (chord-length-params points)
+ [h1 h2] (fit-cubic points params tan1 tan2)
+ curve [p0 p3 h1 h2]
+ [err split] (max-fit-error points params curve)
+
+ [curve err split]
+ (if (and (> err tol2) (<= err (* 16.0 tol2)))
+ (loop [it 0
+ params params
+ curve curve
+ err err
+ split split]
+ (if (or (>= it max-fit-iterations) (<= err tol2))
+ [curve err split]
+ (let [params (mapv #(refine-parameter curve %1 %2) points params)
+ [h1 h2] (fit-cubic points params tan1 tan2)
+ curve [p0 p3 h1 h2]
+ [err split] (max-fit-error points params curve)]
+ (recur (inc it) params curve err split))))
+ [curve err split])]
+
+ (if (<= err tol2)
+ [curve]
+ (let [split (mth/clamp split 1 (- n 2))
+ center (let [v (gpt/to-vec (nth points (inc split))
+ (nth points (dec split)))]
+ (if (mth/almost-zero? (gpt/length v))
+ (gpt/unit (gpt/to-vec (nth points split)
+ (nth points (dec split))))
+ (gpt/unit v)))]
+ (into (fit-curve* (subvec points 0 (inc split)) tan1 center tol2)
+ (fit-curve* (subvec points split) (gpt/negate center) tan2 tol2))))))))
+
+(def ^:private default-corner-angle 60.0)
+
+(defn- corner-index?
+ "True when point `i` turns more than `corner-angle` degrees."
+ [points i corner-angle]
+ (let [v-in (gpt/to-vec (nth points (dec i)) (nth points i))
+ v-out (gpt/to-vec (nth points i) (nth points (inc i)))]
+ (and (not (mth/almost-zero? (gpt/length v-in)))
+ (not (mth/almost-zero? (gpt/length v-out)))
+ (> (gpt/angle-with-other v-in v-out) corner-angle))))
+
+(defn fit-curve
+ "Fits chained cubic curves through `points` within `tolerance`."
+ ([points tolerance]
+ (fit-curve points tolerance default-corner-angle))
+ ([points tolerance corner-angle]
+ (let [points (reduce (fn [acc point]
+ (if (and (seq acc)
+ (< (gpt/distance (peek acc) point) 0.01))
+ acc
+ (conj acc point)))
+ []
+ points)
+ n (count points)]
+ (when (>= n 2)
+ (let [tol2 (* (double tolerance) (double tolerance))
+ corners (into [] (filter #(corner-index? points % corner-angle))
+ (range 1 (dec n)))
+ bounds (concat [0] corners [(dec n)])]
+ (into []
+ (mapcat (fn [[a b]]
+ (let [span (subvec points a (inc b))
+ m (count span)]
+ (when (>= m 2)
+ (let [tan1 (gpt/unit (gpt/to-vec (nth span 0) (nth span 1)))
+ tan2 (gpt/unit (gpt/to-vec (nth span (dec m)) (nth span (- m 2))))]
+ (fit-curve* span tan1 tan2 tol2))))))
+ (partition 2 1 bounds)))))))
diff --git a/common/src/app/common/types/path/helpers.cljc b/common/src/app/common/types/path/helpers.cljc
index bd0db1640b..2c01580021 100644
--- a/common/src/app/common/types/path/helpers.cljc
+++ b/common/src/app/common/types/path/helpers.cljc
@@ -72,16 +72,9 @@
nil))
(defn- closest-angle
+ "Snaps an angle (in degrees) to the nearest 15° increment."
[angle]
- (cond
- (or (> angle 337.5) (<= angle 22.5)) 0
- (and (> angle 22.5) (<= angle 67.5)) 45
- (and (> angle 67.5) (<= angle 112.5)) 90
- (and (> angle 112.5) (<= angle 157.5)) 135
- (and (> angle 157.5) (<= angle 202.5)) 180
- (and (> angle 202.5) (<= angle 247.5)) 225
- (and (> angle 247.5) (<= angle 292.5)) 270
- (and (> angle 292.5) (<= angle 337.5)) 315))
+ (mth/round angle 15))
(defn position-fixed-angle
[point from-point]
@@ -119,6 +112,13 @@
(gpt/point (-> segment :params :c1x) (-> segment :params :c1y))
(gpt/point (-> segment :params :c2x) (-> segment :params :c2y))]))
+(defn entry->bezier
+ "Returns a segment entry as `[start end h1 h2]`."
+ [{:keys [from to segment]}]
+ (if (= :curve-to (:command segment))
+ (command->bezier segment from)
+ [from to from to]))
+
(declare curve-extremities)
(declare curve-values)
@@ -189,6 +189,70 @@
(gpt/point (coord-v :x) (coord-v :y)))))
+(defn curve-closest-t
+ "Finds the cubic parameter closest to `position`."
+ [[start end h1 h2] position precision]
+ (let [d (fn [t] (gpt/distance position (curve-values start end h1 h2 t)))]
+ (loop [t1 0.0
+ t2 1.0]
+ (if (<= (mth/abs (- t1 t2)) precision)
+ 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 (double t1) (double t2)))))))
+
+(def ^:private arc-length-samples
+ "Samples for approximating a cubic's length."
+ 100)
+
+(defn curve-arc-length-t
+ "Finds the cubic parameter at half its arc length."
+ [[start end h1 h2]]
+ (let [n arc-length-samples
+ pts (mapv (fn [i] (curve-values start end h1 h2 (/ (double i) n)))
+ (range (inc n)))
+ dists (->> (map gpt/distance pts (rest pts))
+ (reductions + 0.0)
+ (vec))
+ total (peek dists)]
+ (if (mth/almost-zero? total)
+ 0.5
+ (let [half (/ total 2.0)
+ i (loop [i 0]
+ (if (and (< (inc i) (count dists))
+ (< (nth dists (inc i)) half))
+ (recur (inc i))
+ i))
+ d0 (nth dists i)
+ d1 (nth dists (inc i))
+ frac (if (mth/almost-zero? (- d1 d0))
+ 0.0
+ (/ (- half d0) (- d1 d0)))]
+ (/ (+ i frac) n)))))
+
+(defn bend-curve-deltas
+ "Returns the smallest handler deltas that move the point at `t` to `target`."
+ [curve t target]
+ (let [t' (- 1.0 t)
+ b (* 3.0 t' t' t)
+ c (* 3.0 t' t t)
+ delta (gpt/subtract target (curve-values curve t))
+ denom (+ (* b b) (* c c))]
+ (if (mth/almost-zero? denom)
+ {:c1x 0.0 :c1y 0.0 :c2x 0.0 :c2y 0.0}
+ (let [k1 (/ b denom)
+ k2 (/ c denom)]
+ {:c1x (* k1 (:x delta)) :c1y (* k1 (:y delta))
+ :c2x (* k2 (:x delta)) :c2y (* k2 (:y delta))}))))
+
(defn solve-roots*
"Solvers a quadratic or cubic equation given by the parameters a b c d.
diff --git a/common/src/app/common/types/path/segment.cljc b/common/src/app/common/types/path/segment.cljc
index d0742ced93..da53193ddb 100644
--- a/common/src/app/common/types/path/segment.cljc
+++ b/common/src/app/common/types/path/segment.cljc
@@ -13,8 +13,10 @@
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
+ [app.common.types.path.fit :as fit]
[app.common.types.path.helpers :as helpers]
[app.common.types.path.impl :as impl]
+ [app.common.types.path.subpath :as subpath]
[clojure.set :as set]))
#?(:clj (set! *warn-on-reflection* true))
@@ -139,6 +141,42 @@
(gpt/point x y)))
[])))
+(defn segment-entries
+ "Returns selectable segments with their command index and endpoints."
+ [content]
+ (loop [index 0
+ pending (seq content)
+ previous nil
+ previous-index nil
+ subpath-start nil
+ subpath-start-index nil
+ result []]
+ (if-let [{:keys [command] :as segment} (first pending)]
+ (let [close-path? (= command :close-path)
+ move-to? (= command :move-to)
+ point (if close-path?
+ subpath-start
+ (helpers/segment->point segment))
+ point-index (if close-path? subpath-start-index index)
+ result (cond-> result
+ (and previous point (not move-to?))
+ (conj {:index index
+ :from previous
+ :from-index previous-index
+ :to point
+ :to-index point-index
+ :segment segment}))
+ subpath-start (if move-to? point subpath-start)
+ subpath-start-index (if move-to? index subpath-start-index)]
+ (recur (inc index)
+ (next pending)
+ point
+ point-index
+ subpath-start
+ subpath-start-index
+ result))
+ result)))
+
;; FIXME: incorrect API, don't need full shape
(defn path->lines
"Given a path returns a list of lines that approximate the path"
@@ -312,34 +350,6 @@
(impl/from-plain content)))
-(defn- line->curve
- [from-p segment]
-
- (let [to-p (helpers/segment->point segment)
-
- v (gpt/to-vec from-p to-p)
- d (gpt/distance from-p to-p)
-
- dv1 (-> (gpt/normal-left v)
- (gpt/scale (/ d 3)))
-
- h1 (gpt/add from-p dv1)
-
- dv2 (-> (gpt/to-vec to-p h1)
- (gpt/unit)
- (gpt/scale (/ d 3)))
-
- h2 (gpt/add to-p dv2)]
- (-> segment
- (assoc :command :curve-to)
- (update :params (fn [params]
- ;; ensure plain map
- (-> (into {} params)
- (assoc :c1x (:x h1))
- (assoc :c1y (:y h1))
- (assoc :c2x (:x h2))
- (assoc :c2y (:y h2))))))))
-
;; FIXME: optimize
(defn is-curve?
[content point]
@@ -353,111 +363,123 @@
(mapcat #(list (:next-p %) (:prev-p %)))
(remove nil?)))
+(defn- curve-neighbourhood
+ "Returns the adjacent segments and points for one node."
+ [content index]
+ (let [segment (get content index)
+ prev-i (dec index)
+ prev (when (not= :move-to (:command segment))
+ (get content prev-i))
+ next-i (inc index)
+ next (get content next-i)
+ next (when (not= :move-to (:command next)) next)]
+ {:index index
+ :prev-i (when (some? prev) prev-i)
+ :prev-c prev
+ :prev-p (helpers/segment->point prev)
+ :next-i (when (some? next) next-i)
+ :next-c next
+ :next-p (helpers/segment->point next)
+ :segment segment}))
+
+(defn- smooth-tangent
+ "Returns tangent data for a smooth curve node."
+ [content point indices neighbourhoods neighbour-points]
+ (let [[first-point second-point] (vec neighbour-points)
+ prev-neighbour (some :prev-p neighbourhoods)
+ next-neighbour (some :next-p neighbourhoods)
+ seam? (and (= 2 (count indices))
+ (= :move-to (:command (get content (first indices))))
+ (let [end-index (last indices)]
+ (or (= end-index (dec (count content)))
+ (= :close-path
+ (:command (get content (inc end-index)))))))
+ first-unit (gpt/unit (gpt/to-vec point first-point))
+ second-unit (gpt/unit (gpt/to-vec point second-point))
+ angle-tangent (let [delta (gpt/subtract second-unit first-unit)]
+ (if (mth/almost-zero? (gpt/length delta))
+ (gpt/perpendicular first-unit)
+ (gpt/unit delta)))
+ tangent (if seam?
+ (let [chord (gpt/to-vec prev-neighbour next-neighbour)]
+ (if (mth/almost-zero? (gpt/length chord))
+ angle-tangent
+ (gpt/unit chord)))
+ angle-tangent)
+ length (/ (min (gpt/distance point first-point)
+ (gpt/distance point second-point))
+ 3)]
+ {:tangent tangent
+ :length length
+ :seam? seam?
+ :prev-neighbour prev-neighbour
+ :next-neighbour next-neighbour}))
+
+(defn- smooth-handle
+ "Returns a smooth handle toward `neighbour`."
+ [point {:keys [tangent length seam? prev-neighbour next-neighbour]} neighbour]
+ (when (some? neighbour)
+ (let [direction (gpt/unit (gpt/to-vec point neighbour))
+ side (cond
+ (and seam? (= neighbour prev-neighbour)) -1
+ (and seam? (= neighbour next-neighbour)) 1
+ :else (if (neg? (gpt/dot direction tangent)) -1 1))]
+ (gpt/add point (gpt/scale tangent (* side length))))))
+
+(defn- apply-smooth-neighbour
+ "Adds smooth handles around one matching node."
+ [content point tangent-data {:keys [index prev-p next-p next-i]}]
+ (let [curr-command (:command (get content index))
+ next-command (:command (get content next-i))
+ prev-h (smooth-handle point tangent-data prev-p)
+ next-h (smooth-handle point tangent-data next-p)]
+ (cond-> content
+ (and (= :line-to curr-command) (some? prev-p))
+ (update index helpers/update-curve-to prev-p prev-h)
+
+ (and (= :line-to next-command) (some? next-p))
+ (update next-i helpers/update-curve-to next-h next-p)
+
+ (and (= :curve-to curr-command) (some? prev-p))
+ (update index update-handler :c2 prev-h)
+
+ (and (= :curve-to next-command) (some? next-p))
+ (update next-i update-handler :c1 next-h))))
+
+(defn- corner-handle
+ [point neighbour]
+ (gpt/add point (gpt/scale (gpt/to-vec point neighbour) (/ 1 3))))
+
+(defn- apply-corner-neighbour
+ "Adds independent handles around one matching node."
+ [content point {:keys [index segment prev-p next-c next-i next-p]}]
+ (cond-> content
+ (and (= :line-to (:command segment)) (some? prev-p))
+ (update index helpers/update-curve-to prev-p (corner-handle point prev-p))
+
+ (and (= :curve-to (:command segment)) (some? prev-p))
+ (update index update-handler :c2 (corner-handle point prev-p))
+
+ (and (= :line-to (:command next-c)) (some? next-p))
+ (update next-i helpers/update-curve-to (corner-handle point next-p) next-p)
+
+ (and (= :curve-to (:command next-c)) (some? next-p))
+ (update next-i update-handler :c1 (corner-handle point next-p))))
+
(defn make-curve-point
- "Changes the content to make the point a 'curve'. The handlers will be
- positioned in the same vector that results from the previous->next
- points but with fixed length; return a plain segments vector"
+ "Adds curve handles to every node at `point`."
[content point]
-
- (let [;; We perform this operation before because it can be
- ;; optimized with internal reduction so is better to use the
- ;; PathData type before converting it to plain vector.
- indices
- (point-indices content point)
-
- ;; We transform content to a plain format for execute the
- ;; algorithm because right now is the only way to execute it
- content
- (vec content)
-
- vectors
- (map (fn [index]
- (let [segment (get content index)
- prev-i (dec index)
- prev (when (not (= :move-to (:command segment)))
- (get content prev-i))
- next-i (inc index)
- next (get content next-i)
- next (when (not (= :move-to (:command next)))
- next)]
- {:index index
- :prev-i (when (some? prev) prev-i)
- :prev-c prev
- :prev-p (helpers/segment->point prev)
- :next-i (when (some? next) next-i)
- :next-c next
- :next-p (helpers/segment->point next)
- :segment segment}))
- indices)
-
- points
- (into #{} xf:mapcat-points vectors)]
-
- (if (= (count points) 2)
- (let [[fpoint spoint] (vec points)
- v1 (gpt/to-vec fpoint point)
- v2 (gpt/to-vec fpoint spoint)
- vp (gpt/project v1 v2)
- vh (gpt/subtract v1 vp)
-
- add-curve
- (fn [content {:keys [index prev-p next-p next-i]}]
- (let [curr-segment (get content index)
- curr-command (get curr-segment :command)
-
- next-segment (get content next-i)
- next-command (get next-segment :command)
-
- ;; New handlers for prev-point and next-point
- prev-h
- (when (some? prev-p) (gpt/add prev-p vh))
-
- next-h
- (when (some? next-p) (gpt/add next-p vh))
-
- ;; Correct 1/3 to the point improves the curve
- prev-correction
- (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
-
- next-correction
- (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
-
- prev-h
- (when (some? prev-h) (gpt/add prev-h prev-correction))
-
- next-h
- (when (some? next-h) (gpt/add next-h next-correction))]
-
- (cond-> content
- (and (= :line-to curr-command) (some? prev-p))
- (update index helpers/update-curve-to prev-p prev-h)
-
- (and (= :line-to next-command) (some? next-p))
- (update next-i helpers/update-curve-to next-h next-p)
-
- (and (= :curve-to curr-command) (some? prev-p))
- (update index update-handler :c2 prev-h)
-
- (and (= :curve-to next-command) (some? next-p))
- (update next-i update-handler :c1 next-h))))]
-
- (reduce add-curve content vectors))
-
- (let [add-curve
- (fn [content {:keys [index segment prev-p next-c next-i]}]
- (cond-> content
- (= :line-to (:command segment))
- (update index #(line->curve prev-p %))
-
- (= :curve-to (:command segment))
- (update index #(line->curve prev-p %))
-
- (= :line-to (:command next-c))
- (update next-i #(line->curve point %))
-
- (= :curve-to (:command next-c))
- (update next-i #(line->curve point %))))]
- (reduce add-curve content vectors)))))
+ (let [indices (vec (point-indices content point))
+ content (vec content)
+ neighbourhoods (mapv #(curve-neighbourhood content %) indices)
+ neighbour-points (into #{} xf:mapcat-points neighbourhoods)]
+ (if (= (count neighbour-points) 2)
+ (let [tangent-data (smooth-tangent
+ content point indices neighbourhoods neighbour-points)]
+ (reduce #(apply-smooth-neighbour %1 point tangent-data %2)
+ content
+ neighbourhoods))
+ (reduce #(apply-corner-neighbour %1 point %2) content neighbourhoods))))
(defn get-segments-with-points
"Given a content and a set of points return all the segments in the path
@@ -528,6 +550,103 @@
(into [] (mapcat process-segments) (d/enumerate content))))
+(defn collapse-handler
+ "Collapses a handler onto its node and simplifies flat curves to lines."
+ [content index prefix]
+ (let [content (vec content)
+ node (handler->node content index prefix)
+ [cx cy] (helpers/prefix->coords prefix)]
+ (if (and (some? node)
+ (= :curve-to (dm/get-in content [index :command])))
+ (impl/from-plain
+ (-> content
+ (assoc-in [index :params cx] (:x node))
+ (assoc-in [index :params cy] (:y node))
+ (remove-line-curves)))
+ (impl/from-plain content))))
+
+(def ^:private curve-toggle-bow
+ "Perpendicular handle offset used when curving a line."
+ 0.25)
+
+(defn toggle-segment-curve
+ "Toggles a segment between a line and a bowed curve."
+ [content index]
+ (let [content (vec content)
+ segment (get content index)
+ from (helpers/segment->point (get content (dec index)))
+ to (helpers/segment->point segment)]
+ (impl/from-plain
+ (case (:command segment)
+ :line-to
+ (if (some? from)
+ (let [v (gpt/to-vec from to)
+ perp (gpt/scale (gpt/point (- (:y v)) (:x v)) curve-toggle-bow)
+ h1 (-> from (gpt/add (gpt/scale v (/ 1 3))) (gpt/add perp))
+ h2 (-> from (gpt/add (gpt/scale v (/ 2 3))) (gpt/add perp))]
+ (update content index helpers/update-curve-to h1 h2))
+ content)
+
+ :curve-to
+ (assoc content index {:command :line-to
+ :params (select-keys (:params segment) [:x :y])})
+
+ content))))
+
+(defn- subpath-start-indices
+ "Returns the starting command index for every command in `content`."
+ [content]
+ (loop [i 0
+ start 0
+ result (transient [])]
+ (if (>= i (count content))
+ (persistent! result)
+ (let [start (if (= :move-to (:command (nth content i))) i start)]
+ (recur (inc i) start (conj! result start))))))
+
+(defn remove-segments
+ "Removes segments and opens their subpaths. Closing segments become
+ lines when needed to preserve geometry."
+ [content indices]
+ (let [content (vec content)
+ indices (set indices)
+ starts (subpath-start-indices content)
+
+ broken (into #{} (keep #(nth starts % nil)) indices)
+
+ content
+ (into []
+ (comp
+ (map-indexed
+ (fn [i cmd]
+ (cond
+ (contains? indices i)
+ (when-not (= :close-path (:command cmd))
+ {:command :move-to
+ :params (select-keys (:params cmd) [:x :y])})
+
+ ;; Preserve the closing edge of broken subpaths.
+ (and (= :close-path (:command cmd))
+ (contains? broken (nth starts i)))
+ {:command :line-to
+ :params (-> (nth content (nth starts i))
+ (get :params)
+ (select-keys [:x :y]))}
+
+ :else cmd)))
+ (remove nil?))
+ content)
+
+ subpaths
+ (reduce (fn [acc cmd]
+ (if (or (= :move-to (:command cmd)) (empty? acc))
+ (conj acc [cmd])
+ (update acc (dec (count acc)) conj cmd)))
+ []
+ content)]
+ (impl/from-plain
+ (into [] (comp (filter #(> (count %) 1)) cat) subpaths))))
+
;; FIXME: rename to next-segment
(defn next-node
"Calculates the next-node to be inserted."
@@ -543,78 +662,237 @@
:params (helpers/make-curve-params position prev-handler)}
:else {:command :move-to
:params position})))
-(defn remove-nodes
- "Removes from content the points given. Will try to reconstruct the paths
- to keep everything consistent"
- [content points]
+(def ^:private ^:const chain-samples-per-segment 8)
+(defn- chain-samples
+ "Returns ordered samples along a segment chain."
+ [chain]
+ (into [(:start (first chain))]
+ (mapcat
+ (fn [{:keys [start end segment]}]
+ (let [ts (map #(/ (double %) chain-samples-per-segment)
+ (range 1 (inc chain-samples-per-segment)))]
+ (if (= :curve-to (:command segment))
+ (let [curve (helpers/command->bezier segment start)]
+ (map #(helpers/curve-values curve %) ts))
+ (map #(helpers/line-values [start end] %) ts)))))
+ chain))
+
+(defn- chain-tangent
+ "Returns an inward unit tangent at one end of a chain."
+ [{:keys [start end segment]} at-start? origin samples]
+ (let [tangent
+ (if (= :curve-to (:command segment))
+ (let [curve (helpers/command->bezier segment start)]
+ (cond-> (helpers/curve-tangent curve (if at-start? 0 1))
+ (not at-start?) (gpt/negate)))
+ (if at-start?
+ (gpt/to-vec start end)
+ (gpt/to-vec end start)))
+ tangent (gpt/unit tangent)]
+ (if (gpt/almost-zero? tangent)
+ (->> samples
+ (map #(gpt/to-vec origin %))
+ (remove gpt/almost-zero?)
+ (map gpt/unit)
+ (first))
+ tangent)))
+
+(defn- flat-chain?
+ "True when a sampled chain is nearly straight."
+ [start end samples]
+ (or (mth/almost-zero? (gpt/distance start end))
+ (every? #(< (gpt/point-line-distance % start end) 0.01) samples)))
+
+(defn- restore-split-curve
+ "Rejoins two untouched De Casteljau pieces into one cubic."
+ [chain]
+ (when (= 2 (count chain))
+ (let [{left-segment :segment left-start :start} (first chain)
+ {right-segment :segment} (second chain)]
+ (when (and (= :curve-to (:command left-segment))
+ (= :curve-to (:command right-segment)))
+ (let [[start split left-h1 left-h2 :as left-curve]
+ (helpers/command->bezier left-segment left-start)
+ [_ end right-h1 right-h2 :as right-curve]
+ (helpers/command->bezier right-segment split)
+ left-length (gpt/distance left-h2 split)
+ right-length (gpt/distance split right-h1)]
+ (when (and (not (mth/almost-zero? left-length))
+ (not (mth/almost-zero? right-length)))
+ (let [t (/ left-length (+ left-length right-length))
+ original-h1 (-> (gpt/to-vec start left-h1)
+ (gpt/scale (/ 1.0 t))
+ (gpt/add start))
+ original-h2 (-> (gpt/to-vec end right-h2)
+ (gpt/scale (/ 1.0 (- 1.0 t)))
+ (gpt/add end))
+ candidate [start end original-h1 original-h2]
+ [left' right'] (helpers/curve-split candidate t)]
+ (when (every? true?
+ (map gpt/close?
+ (concat left-curve right-curve)
+ (concat left' right')))
+ (helpers/make-curve-to end original-h1 original-h2)))))))))
+
+(defn- approximate-chain
+ "Replaces a segment chain with a line or fitted curve."
+ [chain]
+ (or (restore-split-curve chain)
+ (let [start (:start (first chain))
+ end (:end (peek chain))
+ samples (chain-samples chain)
+ tan1 (chain-tangent (first chain) true start (rest samples))
+ tan2 (chain-tangent (peek chain) false end (rest (rseq samples)))]
+ (if (or (flat-chain? start end samples)
+ (nil? tan1)
+ (nil? tan2))
+ (helpers/make-line-to end)
+ (let [[h1 h2] (fit/fit-cubic samples tan1 tan2)]
+ (helpers/make-curve-to end h1 h2))))))
+
+(defn- split-content-subpaths
+ "Splits plain path commands into subpath command vectors."
+ [content]
+ (reduce
+ (fn [subpaths segment]
+ (if (= :move-to (:command segment))
+ (conj subpaths [segment])
+ (if (seq subpaths)
+ (update subpaths (dec (count subpaths)) conj segment)
+ subpaths)))
+ []
+ content))
+
+(defn- removed-point-joins-subpaths?
+ "True when a removed point is an endpoint shared by open subpaths."
+ [subpaths points]
+ (let [open-endpoints
+ (keep (fn [subpath]
+ (let [start (some-> subpath first helpers/segment->point)
+ end (some-> subpath peek helpers/segment->point)]
+ (when (and (some? start)
+ (some? end)
+ (not (subpath/pt= start end)))
+ #{start end})))
+ subpaths)]
+ (some (fn [point]
+ (< 1 (count (filter (fn [endpoints]
+ (some #(subpath/pt= point %) endpoints))
+ open-endpoints))))
+ points)))
+
+(defn- rotate-removed-closed-start
+ "Rotates a closed subpath so a removed seam becomes an interior node."
+ [subpath points]
+ (let [subpath (vec subpath)
+ close? (= :close-path (:command (peek subpath)))
+ body (cond-> subpath close? pop)
+ start (some-> body first helpers/segment->point)
+ end (some-> body peek helpers/segment->point)
+ closed? (or close? (= start end))]
+ (if-not (and closed? (contains? points start))
+ subpath
+ (let [segments (subvec body 1)
+ ;; Materialize an implicit close segment before rotating.
+ segments (cond-> segments
+ (and close? (not= start end))
+ (conj (helpers/make-line-to start)))
+ new-start-index
+ (first
+ (keep-indexed
+ (fn [index segment]
+ (when-not (contains? points (helpers/segment->point segment))
+ index))
+ segments))]
+ (if (nil? new-start-index)
+ []
+ (let [new-start (helpers/segment->point
+ (nth segments new-start-index))
+ rotated (into []
+ (concat
+ (subvec segments (inc new-start-index))
+ (subvec segments 0 (inc new-start-index))))]
+ (cond-> (into [(helpers/make-move-to new-start)] rotated)
+ close? (conj {:command :close-path :params {}}))))))))
+
+(defn- remove-nodes*
+ "Removes interior nodes from prepared content."
+ [content points]
+ (loop [result []
+ pending []
+ subpath-start nil
+ prev-point nil
+ segments (seq content)]
+
+ (if (nil? segments)
+ ;; Drop subpaths left with only a start point.
+ (into [] (comp (filter #(> (count %) 1)) cat) result)
+
+ (let [segment (first segments)
+ move? (= :move-to (:command segment))
+ close? (= :close-path (:command segment))
+ point (if close? subpath-start (helpers/segment->point segment))
+ remove? (and (not close?) (contains? points point))
+
+ ;; Start a result subpath for each move command.
+ result (if move? (conj result []) result)
+ head (dec (count result))
+ subpath (peek result)
+
+ [result pending]
+ (cond
+ ;; Collect removed interior nodes until the next kept node.
+ remove?
+ [result (if (seq subpath)
+ (conj pending {:start prev-point :end point :segment segment})
+ [])]
+
+ move?
+ [(update result head conj segment) []]
+
+ ;; Promote the first kept node to the subpath start.
+ (empty? subpath)
+ [(update result head conj (helpers/make-move-to point)) []]
+
+ (seq pending)
+ (if (and close? (contains? points subpath-start))
+ ;; Close straight onto the new start.
+ [(update result head conj segment) []]
+ (let [chain (conj pending {:start prev-point :end point :segment segment})
+ approx (approximate-chain chain)
+ ;; The close command already draws a zero-length replacement.
+ skip? (and close?
+ (= :line-to (:command approx))
+ (< (gpt/distance (:start (first chain)) point) 0.01))
+ result (cond-> result
+ (not skip?) (update head conj approx)
+ close? (update head conj segment))]
+ [result []]))
+
+ :else
+ [(update result head conj segment) []])]
+
+ (recur result
+ pending
+ (if move? point subpath-start)
+ point
+ (next segments))))))
+
+(defn remove-nodes
+ "Removes nodes and joins surrounding segments with a fitted replacement."
+ [content points]
(if (empty? points)
content
-
- (let [content (d/with-prev content)]
-
- (loop [result []
- last-handler nil
- [cur-segment prev-segment] (first content)
- content (rest content)]
-
- (if (nil? cur-segment)
- ;; The result with be an array of arrays were every entry is a subpath
- (->> result
- ;; remove empty and only 1 node subpaths
- (filter #(> (count %) 1))
- ;; flatten array-of-arrays plain array
- (flatten)
- (into []))
-
- (let [move? (= :move-to (:command cur-segment))
- curve? (= :curve-to (:command cur-segment))
-
- ;; When the old command was a move we start a subpath
- result (if move? (conj result []) result)
-
- subpath (peek result)
-
- point (helpers/segment->point cur-segment)
-
- old-prev-point (helpers/segment->point prev-segment)
- new-prev-point (helpers/segment->point (peek subpath))
-
- remove? (contains? points point)
-
-
- ;; We store the first handler for the first curve to be removed to
- ;; use it for the first handler of the regenerated path
- cur-handler (cond
- (and (not last-handler) remove? curve?)
- (select-keys (:params cur-segment) [:c1x :c1y])
-
- (not remove?)
- nil
-
- :else
- last-handler)
-
- cur-segment (cond-> cur-segment
- ;; If we're starting a subpath and it's not a move make it a move
- (and (not move?) (empty? subpath))
- (assoc :command :move-to
- :params (select-keys (:params cur-segment) [:x :y]))
-
- ;; If have a curve the first handler will be relative to the previous
- ;; point. We change the handler to the new previous point
- (and curve? (seq subpath) (not= old-prev-point new-prev-point))
- (update :params merge last-handler))
-
- head-idx (dec (count result))
-
- result (cond-> result
- (not remove?)
- (update head-idx conj cur-segment))]
- (recur result
- cur-handler
- (first content)
- (rest content))))))))
+ (let [subpaths (split-content-subpaths content)
+ content (if (removed-point-joins-subpaths? subpaths points)
+ (subpath/close-subpaths content)
+ content)
+ content (into []
+ (mapcat #(rotate-removed-closed-start % points))
+ (split-content-subpaths
+ content))]
+ (remove-nodes* content points))))
(defn join-nodes
"Creates new segments between points that weren't previously.
@@ -649,41 +927,119 @@
(into content new-content)))
+(def ^:private separate-node-offset (gpt/point 8 8))
+
+(defn- separate-node
+ "Splits a node into offset open ends, preserving adjacent handles."
+ [content point offset]
+ (let [content (vec content)
+ n (count content)
+ {ox :x oy :y} offset
+ seg? (fn [c] (and (some? c)
+ (not= :move-to (:command c))
+ (not= :close-path (:command c))))]
+ (loop [i 0
+ k 0
+ result (transient [])]
+ (if (>= i n)
+ (persistent! result)
+ (let [cmd (nth content i)
+ nxt (nth content (inc i) nil)
+ at-p? (and (not= :close-path (:command cmd))
+ (= point (helpers/segment->point cmd)))]
+ (cond
+ ;; Offset a subpath start.
+ (and at-p? (= :move-to (:command cmd)))
+ (let [off (gpt/point (* k ox) (* k oy))]
+ (recur (inc i) (inc k)
+ (conj! result (-> cmd
+ (update-in [:params :x] + (:x off))
+ (update-in [:params :y] + (:y off))))))
+
+ ;; Split an interior node into two subpaths.
+ (and at-p? (seg? cmd) (seg? nxt))
+ (let [off (gpt/point (* k ox) (* k oy))
+ cmd' (cond-> (-> cmd
+ (update-in [:params :x] + (:x off))
+ (update-in [:params :y] + (:y off)))
+ (= :curve-to (:command cmd))
+ (-> (update-in [:params :c2x] + (:x off))
+ (update-in [:params :c2y] + (:y off))))
+ k2 (inc k)
+ off2 (gpt/point (* k2 ox) (* k2 oy))
+ mv (helpers/make-move-to (gpt/add point off2))
+ nxt' (cond-> nxt
+ (= :curve-to (:command nxt))
+ (-> (update-in [:params :c1x] + (:x off2))
+ (update-in [:params :c1y] + (:y off2))))]
+ (recur (+ i 2) (inc k2)
+ (-> result (conj! cmd') (conj! mv) (conj! nxt'))))
+
+ ;; Open and offset a closed seam.
+ (and at-p? (seg? cmd) (= :close-path (:command nxt)))
+ (let [off (gpt/point (* k ox) (* k oy))
+ cmd' (cond-> (-> cmd
+ (update-in [:params :x] + (:x off))
+ (update-in [:params :y] + (:y off)))
+ (= :curve-to (:command cmd))
+ (-> (update-in [:params :c2x] + (:x off))
+ (update-in [:params :c2y] + (:y off))))]
+ ;; Drop the close command so the seam stays open.
+ (recur (+ i 2) (inc k) (conj! result cmd')))
+
+ ;; Offset the end of an open subpath.
+ (and at-p? (seg? cmd) (not= :close-path (:command nxt)))
+ (let [off (gpt/point (* k ox) (* k oy))]
+ (recur (inc i) (inc k)
+ (conj! result (cond-> (-> cmd
+ (update-in [:params :x] + (:x off))
+ (update-in [:params :y] + (:y off)))
+ (= :curve-to (:command cmd))
+ (-> (update-in [:params :c2x] + (:x off))
+ (update-in [:params :c2y] + (:y off)))))))
+
+ :else
+ (recur (inc i) k (conj! result cmd))))))))
+
(defn separate-nodes
- "Removes the segments between the points given"
- [content points]
+ "Removes segments between points or splits one node into offset open ends."
+ ([content points]
+ (separate-nodes content points separate-node-offset))
+ ([content points offset]
+ (if (= 1 (count points))
+ (separate-node (vec content) (first points) offset)
- (let [content (d/with-prev content)]
- (loop [result []
- [cur-segment prev-segment] (first content)
- content (rest content)]
+ (let [content (d/with-prev content)]
+ (loop [result []
+ [cur-segment prev-segment] (first content)
+ content (rest content)]
- (if (nil? cur-segment)
- (->> result
- (filter #(> (count %) 1))
- (flatten)
- (into []))
+ (if (nil? cur-segment)
+ (->> result
+ (filter #(> (count %) 1))
+ (flatten)
+ (into []))
- (let [prev-point (helpers/segment->point prev-segment)
- cur-point (helpers/segment->point cur-segment)
+ (let [prev-point (helpers/segment->point prev-segment)
+ cur-point (helpers/segment->point cur-segment)
- cur-segment (cond-> cur-segment
- (and (contains? points prev-point)
- (contains? points cur-point))
+ cur-segment (cond-> cur-segment
+ (and (contains? points prev-point)
+ (contains? points cur-point))
- (assoc :command :move-to
- :params (select-keys (:params cur-segment) [:x :y])))
+ (assoc :command :move-to
+ :params (select-keys (:params cur-segment) [:x :y])))
- move? (= :move-to (:command cur-segment))
+ move? (= :move-to (:command cur-segment))
- result (if move? (conj result []) result)
- head-idx (dec (count result))
+ result (if move? (conj result []) result)
+ head-idx (dec (count result))
- result (-> result
- (update head-idx conj cur-segment))]
- (recur result
- (first content)
- (rest content)))))))
+ result (-> result
+ (update head-idx conj cur-segment))]
+ (recur result
+ (first content)
+ (rest content)))))))))
(defn- add-to-set
@@ -753,9 +1109,10 @@
(mapv replace-command))))
(defn merge-nodes
- "Reduces the contiguous segments in points to a single point"
+ "Joins and merges `points` into one point."
[content points]
- (let [segments (get-segments-with-points content points)]
+ (let [content (join-nodes content points)
+ segments (get-segments-with-points content points)]
(if (seq segments)
(let [point->merge-point (-> segments
(group-segments)
@@ -889,3 +1246,16 @@
(conj result {:command :close-path})
result)]
(impl/from-plain result))))))
+
+(defn smooth-points->content
+ "Fits smooth path content through `points`, falling back to lines."
+ [points tolerance]
+ (let [curves (when (>= (count points) 3)
+ (fit/fit-curve points tolerance))]
+ (if (empty? curves)
+ (points->content points)
+ (impl/from-plain
+ (into [(helpers/make-move-to (ffirst curves))]
+ (map (fn [[_ end h1 h2]]
+ (helpers/make-curve-to end h1 h2)))
+ curves)))))
diff --git a/common/src/app/common/types/path/selection.cljc b/common/src/app/common/types/path/selection.cljc
new file mode 100644
index 0000000000..7b2ffdeee4
--- /dev/null
+++ b/common/src/app/common/types/path/selection.cljc
@@ -0,0 +1,208 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+(ns app.common.types.path.selection
+ "Transforms selected path nodes and handlers."
+ (:require
+ [app.common.data :as d]
+ [app.common.geom.point :as gpt]
+ [app.common.types.path.helpers :as helpers]
+ [app.common.types.path.impl :as impl]))
+
+(def align-nodes-axis
+ "Valid alignment axes."
+ #{:hleft :hcenter :hright :vtop :vcenter :vbottom})
+
+(def distribute-nodes-axis
+ "Valid distribution axes."
+ #{:horizontal :vertical})
+
+(defn- selected-node-entries
+ "Returns selected nodes as `[index point]` pairs."
+ [content indices]
+ (into []
+ (comp (filter (fn [[i seg]]
+ (and (contains? indices i)
+ (not= :close-path (:command seg)))))
+ (map (fn [[i seg]] [i (helpers/segment->point seg)])))
+ (d/enumerate content)))
+
+(defn- expand-coincident-node-indices
+ "Includes every command that represents a selected logical node."
+ [content indices]
+ (let [indices (set indices)
+ points (into #{} (map second) (selected-node-entries content indices))]
+ (into indices
+ (comp
+ (filter (fn [[_ segment]]
+ (and (not= :close-path (:command segment))
+ (contains? points (helpers/segment->point segment)))))
+ (map first))
+ (d/enumerate content))))
+
+(defn- translate-nodes
+ "Moves selected nodes and handlers by their node deltas."
+ [content indices deltas]
+ (let [node-sel? (fn [i] (contains? indices i))
+ add-delta (fn [params xk yk delta]
+ (if (and delta (contains? params xk))
+ (-> params
+ (update xk + (:x delta))
+ (update yk + (:y delta)))
+ params))
+ move-cmd (fn [i {:keys [command params] :as seg}]
+ (let [curve? (= :curve-to command)
+ params (cond-> params
+ (and (not= :close-path command) (node-sel? i))
+ (add-delta :x :y (get deltas i))
+
+ (and curve? (node-sel? (dec i)))
+ (add-delta :c1x :c1y (get deltas (dec i)))
+
+ (and curve? (node-sel? i))
+ (add-delta :c2x :c2y (get deltas i)))]
+ (assoc seg :params params)))]
+ (into [] (map-indexed move-cmd) content)))
+
+(defn flip-content
+ "Flips selected nodes and handlers across their bounds."
+ [content indices axis]
+ (let [content (vec content)
+ indices (set indices)
+ node-sel? (fn [i] (contains? indices i))
+ positions (into []
+ (comp (filter (fn [[i seg]]
+ (and (node-sel? i)
+ (not= :close-path (:command seg)))))
+ (map (fn [[_ seg]] (helpers/segment->point seg))))
+ (d/enumerate content))]
+ (if (empty? positions)
+ (impl/from-plain content)
+ (let [xs (map :x positions)
+ ys (map :y positions)
+ cx (/ (+ (reduce min xs) (reduce max xs)) 2.0)
+ cy (/ (+ (reduce min ys) (reduce max ys)) 2.0)
+ flip-x? (= axis :horizontal)
+ reflect (fn [params xk yk]
+ (if flip-x?
+ (cond-> params
+ (contains? params xk) (update xk #(- (* 2.0 cx) %)))
+ (cond-> params
+ (contains? params yk) (update yk #(- (* 2.0 cy) %)))))
+ flip-cmd (fn [i {:keys [command params] :as seg}]
+ (let [curve? (= :curve-to command)
+ params (cond-> params
+ (and (not= :close-path command) (node-sel? i))
+ (reflect :x :y)
+
+ (and curve? (node-sel? (dec i)))
+ (reflect :c1x :c1y)
+
+ (and curve? (node-sel? i))
+ (reflect :c2x :c2y))]
+ (assoc seg :params params)))]
+ (impl/from-plain
+ (into [] (map-indexed flip-cmd) content))))))
+
+(defn align-content
+ "Aligns two or more selected nodes within their bounds."
+ [content indices axis]
+ (let [content (vec content)
+ indices (set indices)
+ entries (selected-node-entries content indices)]
+ (if (< (count entries) 2)
+ (impl/from-plain content)
+ (let [pts (map second entries)
+ xs (map :x pts)
+ ys (map :y pts)
+ minx (reduce min xs)
+ maxx (reduce max xs)
+ miny (reduce min ys)
+ maxy (reduce max ys)
+ [coord target] (case axis
+ :hleft [:x minx]
+ :hcenter [:x (/ (+ minx maxx) 2.0)]
+ :hright [:x maxx]
+ :vtop [:y miny]
+ :vcenter [:y (/ (+ miny maxy) 2.0)]
+ :vbottom [:y maxy])
+ deltas (into {}
+ (map (fn [[i p]]
+ [i (if (= coord :x)
+ (gpt/point (- target (:x p)) 0)
+ (gpt/point 0 (- target (:y p))))]))
+ entries)]
+ (impl/from-plain (translate-nodes content indices deltas))))))
+
+(defn set-nodes-coordinate
+ "Sets one coordinate of selected nodes and handlers."
+ [content indices axis value]
+ (let [content (vec content)
+ indices (expand-coincident-node-indices content indices)
+ entries (selected-node-entries content indices)
+ deltas (into {}
+ (map (fn [[i p]]
+ [i (if (= axis :x)
+ (gpt/point (- value (:x p)) 0)
+ (gpt/point 0 (- value (:y p))))]))
+ entries)]
+ (impl/from-plain (translate-nodes content indices deltas))))
+
+(defn set-handler-points
+ "Moves handlers to their target points."
+ [content pts]
+ (impl/from-plain
+ (reduce
+ (fn [content [[index prefix] pt]]
+ (if (= :curve-to (:command (get content index)))
+ (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
+ (-> content
+ (assoc-in [index :params cx] (:x pt))
+ (assoc-in [index :params cy] (:y pt))))
+ content))
+ (vec content)
+ pts)))
+
+(defn translate-selected-nodes
+ "Moves selected nodes and handlers by `delta`."
+ [content indices delta]
+ (let [content (vec content)
+ indices (expand-coincident-node-indices content indices)]
+ (impl/from-plain
+ (translate-nodes content indices (into {} (map (fn [i] [i delta])) indices)))))
+
+(defn distribute-content
+ "Distributes three or more selected positions along `axis`."
+ [content indices axis]
+ (let [content (vec content)
+ indices (set indices)
+ entries (selected-node-entries content indices)
+ horizontal? (= axis :horizontal)
+ coord (fn [p] (if horizontal? (:x p) (:y p)))
+ groups (->> entries
+ (group-by (fn [[_ p]] [(:x p) (:y p)]))
+ (mapv (fn [[_ es]]
+ {:point (second (first es))
+ :indices (mapv first es)})))]
+ (if (< (count groups) 3)
+ (impl/from-plain content)
+ (let [sorted (sort-by (comp coord :point) groups)
+ lo (coord (:point (first sorted)))
+ hi (coord (:point (last sorted)))
+ step (/ (- hi lo) (dec (count sorted)))
+ deltas (into {}
+ (comp
+ (map-indexed
+ (fn [k {:keys [point indices]}]
+ (let [target (+ lo (* k step))
+ d (- target (coord point))
+ dp (if horizontal?
+ (gpt/point d 0)
+ (gpt/point 0 d))]
+ (map (fn [i] [i dp]) indices))))
+ cat)
+ sorted)]
+ (impl/from-plain (translate-nodes content indices deltas))))))
diff --git a/common/src/app/common/types/path/subpath.cljc b/common/src/app/common/types/path/subpath.cljc
index 50c0055466..347cf49cf7 100644
--- a/common/src/app/common/types/path/subpath.cljc
+++ b/common/src/app/common/types/path/subpath.cljc
@@ -28,13 +28,17 @@
(defn add-subpath-command
"Adds a command to the subpath"
[subpath command]
- (let [command (if (= :close-path (:command command))
- (helpers/make-line-to (:from subpath))
- command)
- p (helpers/segment->point command)]
- (-> subpath
- (assoc :to p)
- (update :data conj command))))
+ (let [close? (= :close-path (:command command))]
+ (if (and close? (pt= (:from subpath) (:to subpath)))
+ ;; Avoid adding a duplicate node at an already closed seam.
+ subpath
+ (let [command (if close?
+ (helpers/make-line-to (:from subpath))
+ command)
+ p (helpers/segment->point command)]
+ (-> subpath
+ (assoc :to p)
+ (update :data conj command))))))
(defn reverse-command
"Reverses a single command"
@@ -189,6 +193,27 @@
(into [] xf-mapcat-data closed-subpaths)))
+(defn- close-loop
+ "Adds an explicit close command when a subpath's endpoints meet."
+ [{:keys [from to data] :as subpath}]
+ (let [last-seg (peek data)]
+ (if (or (< (count data) 2)
+ (= :close-path (:command last-seg))
+ (not (pt= from to)))
+ subpath
+ (let [data (cond-> data
+ (= :line-to (:command last-seg)) (pop))]
+ (assoc subpath
+ :to from
+ :data (conj data {:command :close-path :params {}}))))))
+
+(defn close-loops
+ "Adds close commands to subpaths whose endpoints meet."
+ [content]
+ (->> (get-subpaths content)
+ (mapv close-loop)
+ (into [] xf-mapcat-data)))
+
;; FIXME: revisit this fn impl for perfromance
(defn reverse-content
"Given a content reverse the order of the commands"
diff --git a/common/src/app/common/types/shape.cljc b/common/src/app/common/types/shape.cljc
index d645e72ae1..773a438fa8 100644
--- a/common/src/app/common/types/shape.cljc
+++ b/common/src/app/common/types/shape.cljc
@@ -532,8 +532,9 @@
{:type :path
:name "Path"
:fills []
+ ;; Paths use centered strokes by default.
:strokes [{:stroke-style :solid
- :stroke-alignment :inner
+ :stroke-alignment :center
:stroke-width 1
:stroke-color clr/black
:stroke-opacity 1}]})
diff --git a/common/test/common_tests/types/path_data_test.cljc b/common/test/common_tests/types/path_data_test.cljc
index 714270cb62..7e381ce2f8 100644
--- a/common/test/common_tests/types/path_data_test.cljc
+++ b/common/test/common_tests/types/path_data_test.cljc
@@ -17,6 +17,7 @@
[app.common.transit :as trans]
[app.common.types.path :as path]
[app.common.types.path.bool :as path.bool]
+ [app.common.types.path.fit :as path.fit]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.impl :as path.impl]
[app.common.types.path.segment :as path.segment]
@@ -656,6 +657,21 @@
(t/testing "content that is already a closed triangle stays closed"
(let [result (path.subpath/close-subpaths simple-closed-content)]
(t/is (seq result))))
+ (t/testing "a close after a curve already landing on the start is not materialized twice"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to
+ :params {:c1x 3.0 :c1y -2.0
+ :c2x 6.0 :c2y -2.0
+ :x 10.0 :y 0.0}}
+ {:command :curve-to
+ :params {:c1x 6.0 :c1y 2.0
+ :c2x 3.0 :c2y 2.0
+ :x 0.0 :y 0.0}}
+ {:command :close-path :params {}}]
+ result (path.subpath/close-subpaths content)]
+ (t/is (= [:move-to :curve-to :curve-to] (mapv :command result)))
+ ;; Rendering/persistence can still recover the explicit SVG close.
+ (t/is (= content (path.subpath/close-loops content)))))
(t/testing "two open fragments that form a closed loop get merged"
;; fragment A: 0,0 → 5,0
;; fragment B: 10,0 → 5,0 (reversed, connects to A's end)
@@ -667,6 +683,65 @@
result (path.subpath/close-subpaths content)]
(t/is (seq result)))))
+(t/deftest subpath-close-loops
+ (t/testing "trailing line-to landing on the subpath start becomes a close-path"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= [:move-to :line-to :line-to :close-path] (mapv :command result)))))
+
+ (t/testing "coincident endpoints within tolerance also close"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 0.05 :y 0.0}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= [:move-to :line-to :close-path] (mapv :command result)))))
+
+ (t/testing "curve landing on the subpath start keeps the curve and appends a close-path"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 10.0 :c1y 5.0 :c2x 5.0 :c2y 5.0 :x 0.0 :y 0.0}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= [:move-to :line-to :curve-to :close-path] (mapv :command result)))))
+
+ (t/testing "already command-closed content is unchanged"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :close-path :params {}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= content (vec result)))))
+
+ (t/testing "open subpaths are left untouched"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= content (vec result)))))
+
+ (t/testing "multi-subpath content closes only the coincident loops"
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :move-to :params {:x 20.0 :y 20.0}}
+ {:command :line-to :params {:x 30.0 :y 20.0}}]
+ result (path.subpath/close-loops content)]
+ (t/is (= [:move-to :line-to :close-path :move-to :line-to]
+ (mapv :command result))))))
+
+(t/deftest path-close-loops-path-data
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}])
+ result (path/close-loops content)]
+ (t/is (path.impl/path-data? result))
+ (t/is (= [:move-to :line-to :line-to :close-path]
+ (mapv :command (vec result))))))
+
(t/deftest subpath-merge-touching-subpaths
(t/testing "adjacent subpaths sharing an endpoint collapse into one chain"
;; Heroicons-style fragment: continuous polyline split as M-L M-L M-L
@@ -785,6 +860,70 @@
(t/is (= 3.0 (get-in cmd [:params :c1x])))
(t/is (= 7.0 (get-in cmd [:params :c2x])))))
+(t/deftest segment-make-curve-point-keeps-neighbors-corners
+ ;; Curving a node leaves its neighbours as corners.
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 100.0 :y 0.0}}
+ {:command :line-to :params {:x 200.0 :y 0.0}}]]
+
+ (t/testing "curving the first (endpoint) node keeps its neighbour a corner"
+ (let [r (vec (seq (path/make-curve-point content (gpt/point 0.0 0.0))))
+ seg1 (get r 1)]
+ (t/is (= :curve-to (:command seg1)))
+ ;; The neighbour's handle stays collapsed.
+ (t/is (= 100.0 (get-in seg1 [:params :c2x])))
+ (t/is (= 0.0 (get-in seg1 [:params :c2y])))
+ ;; The selected node gets a handle.
+ (t/is (not= 0.0 (get-in seg1 [:params :c1x])))))
+
+ (t/testing "curving the last node keeps its neighbour a corner"
+ (let [r (vec (seq (path/make-curve-point content (gpt/point 200.0 0.0))))
+ seg2 (get r 2)]
+ (t/is (= :curve-to (:command seg2)))
+ ;; The neighbour's handle stays collapsed.
+ (t/is (= 100.0 (get-in seg2 [:params :c1x])))
+ (t/is (= 0.0 (get-in seg2 [:params :c1y])))))
+
+ (t/testing "curving a middle node keeps both neighbours corners"
+ (let [r (vec (seq (path/make-curve-point content (gpt/point 100.0 0.0))))
+ seg1 (get r 1)
+ seg2 (get r 2)]
+ (t/is (= 0.0 (get-in seg1 [:params :c1x])))
+ (t/is (= 200.0 (get-in seg2 [:params :c2x])))))))
+
+(t/deftest segment-make-curve-point-acute-corner-is-smooth
+ ;; Acute corners get equal and opposite handles.
+ (let [content [{:command :move-to :params {:x 10.0 :y 1.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y -1.0}}]
+ r (vec (seq (path/make-curve-point (path/content content)
+ (gpt/point 0.0 0.0))))
+ ;; Read the node's incoming and outgoing handles.
+ c2y (get-in (get r 1) [:params :c2y])
+ c1y (get-in (get r 2) [:params :c1y])]
+ ;; Both handles extend from the node.
+ (t/is (not (zero? c2y)))
+ ;; The node is the midpoint between equal-length handles.
+ (t/is (= c2y (- c1y)))))
+
+(t/deftest segment-make-curve-point-closed-seam-follows-neighbour-tangent
+ ;; Closed seams follow the chord between their neighbours.
+ (let [point (gpt/point 0.0 0.0)
+ content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y -8.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 6.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :close-path :params {}}]
+ result (vec (path/make-curve-point (path/content content) point))
+ outgoing (get result 1)
+ incoming (get result 4)]
+ ;; Seam handles lie on the chord and oppose each other.
+ (t/is (mth/close? 0.0 (get-in outgoing [:params :c1x]) 0.001))
+ (t/is (mth/close? 0.0 (get-in incoming [:params :c2x]) 0.001))
+ (t/is (neg? (get-in outgoing [:params :c1y])))
+ (t/is (pos? (get-in incoming [:params :c2y])))))
+
(t/deftest helpers-prefix->coords
(t/is (= [:c1x :c1y] (path.helpers/prefix->coords :c1)))
(t/is (= [:c2x :c2y] (path.helpers/prefix->coords :c2)))
@@ -794,15 +933,22 @@
(t/testing "returns point unchanged when from-point is nil"
(let [pt (gpt/point 5.0 3.0)]
(t/is (= pt (path.helpers/position-fixed-angle pt nil)))))
- (t/testing "snaps to nearest 45-degree angle"
- (let [from (gpt/point 0 0)
- ;; Angle ~30° from from, should snap to 45°
- to (gpt/point 10 6)
- snapped (path.helpers/position-fixed-angle to from)]
- ;; result should have same distance
- (let [d-orig (gpt/distance to from)
- d-snapped (gpt/distance snapped from)]
- (t/is (mth/close? d-orig d-snapped 0.01))))))
+ (t/testing "snaps to nearest 15-degree angle"
+ (let [from (gpt/point 0 0)
+ ;; ~31° from `from`: snaps to 30° (15° granularity), not 45°
+ to (gpt/point 10 6)
+ snapped (path.helpers/position-fixed-angle to from)
+ d-orig (gpt/distance to from)
+ d-snapped (gpt/distance snapped from)
+ snap-ang (gpt/angle snapped from)
+ orig-ang (gpt/angle to from)
+ delta (let [d (mod (- snap-ang orig-ang) 360)] (min d (- 360 d)))]
+ ;; distance preserved
+ (t/is (mth/close? d-orig d-snapped 0.01))
+ ;; snapped onto a 15° multiple
+ (t/is (let [m (mod snap-ang 15)] (or (< m 0.01) (> m 14.99))))
+ ;; Stay within half a 15° bucket of the input angle.
+ (t/is (<= delta 7.5)))))
(t/deftest helpers-command->line
(let [prev {:command :move-to :params {:x 0.0 :y 0.0}}
@@ -821,6 +967,18 @@
(t/is (= (gpt/point 3.0 5.0) h1))
(t/is (= (gpt/point 7.0 5.0) h2))))
+(t/deftest helpers-entry->bezier
+ (let [from (gpt/point 0 0)
+ to (gpt/point 10 0)
+ line {:from from :to to :segment {:command :line-to}}
+ curve {:from from
+ :to to
+ :segment {:command :curve-to
+ :params {:x 10 :y 0 :c1x 3 :c1y 5 :c2x 7 :c2y 5}}}]
+ (t/is (= [from to from to] (path.helpers/entry->bezier line)))
+ (t/is (= [from to (gpt/point 3 5) (gpt/point 7 5)]
+ (path.helpers/entry->bezier curve)))))
+
(t/deftest helpers-line-values
(let [from (gpt/point 0.0 0.0)
to (gpt/point 10.0 0.0)
@@ -1102,6 +1260,596 @@
;; should have fewer segments
(t/is (< (count result) (count simple-open-content)))))
+(t/deftest helpers-fit-cubic-recovers-curve
+ ;; fitting samples of a known cubic recovers control points close to it
+ (let [curve [(gpt/point 0.0 0.0) (gpt/point 30.0 0.0)
+ (gpt/point 10.0 10.0) (gpt/point 20.0 10.0)]
+ samples (mapv #(path.helpers/curve-values curve (/ % 20.0)) (range 21))
+ tan1 (path.helpers/curve-tangent curve 0)
+ tan2 (gpt/negate (path.helpers/curve-tangent curve 1))
+ [h1 h2] (path.fit/fit-cubic samples tan1 tan2)]
+ (t/is (mth/close? 10.0 (:x h1) 1.0))
+ (t/is (mth/close? 10.0 (:y h1) 1.0))
+ (t/is (mth/close? 20.0 (:x h2) 1.0))
+ (t/is (mth/close? 10.0 (:y h2) 1.0))))
+
+(t/deftest helpers-curve-closest-t
+ ;; A degenerate cubic maps points back onto the same line.
+ (let [curve [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)
+ (gpt/point 0.0 0.0) (gpt/point 10.0 0.0)]]
+ (t/is (mth/close? 0.5 (path.helpers/curve-closest-t curve (gpt/point 5.0 0.0) 0.001) 0.01))
+ (doseq [q [(gpt/point 2.5 0.0) (gpt/point 7.0 0.0)]]
+ (let [t (path.helpers/curve-closest-t curve q 0.001)
+ p (path.helpers/curve-values curve t)]
+ (t/is (mth/close? (:x q) (:x p) 0.05))))))
+
+(t/deftest helpers-bend-curve-deltas-passes-through-target
+ ;; the handle deltas move the point at t exactly onto the target, for any t
+ (let [curve [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)
+ (gpt/point 0.0 0.0) (gpt/point 10.0 0.0)]]
+ (doseq [t [0.3 0.5 0.7]
+ target [(gpt/point 5.0 4.0) (gpt/point 3.0 -6.0)]]
+ (let [{:keys [c1x c1y c2x c2y]} (path.helpers/bend-curve-deltas curve t target)
+ bent [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)
+ (gpt/point c1x c1y) (gpt/point (+ 10.0 c2x) c2y)]
+ p (path.helpers/curve-values bent t)]
+ (t/is (mth/close? (:x target) (:x p) 0.001))
+ (t/is (mth/close? (:y target) (:y p) 0.001))))))
+
+(t/deftest segment-flip-content-horizontal
+ ;; mirror every node across the bbox center on the vertical axis
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])
+ result (path/flip-content content #{0 1 2} :horizontal)
+ pts (mapv (comp (juxt :x :y) :params) (vec result))]
+ (t/is (= [[10.0 0.0] [0.0 0.0] [0.0 10.0]] pts))))
+
+(t/deftest segment-flip-content-curve-handles
+ ;; a curve mirrors its anchors and both handles, keeping shape symmetry
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 2.0 :c1y 5.0 :c2x 8.0 :c2y 5.0 :x 10.0 :y 0.0}}])
+ result (vec (path/flip-content content #{0 1} :horizontal))]
+ (t/is (= {:x 10.0 :y 0.0} (:params (first result))))
+ (t/is (= {:c1x 8.0 :c1y 5.0 :c2x 2.0 :c2y 5.0 :x 0.0 :y 0.0}
+ (:params (second result))))))
+
+(t/deftest segment-flip-content-vertical
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 2.0 :c1y 5.0 :c2x 8.0 :c2y 5.0 :x 10.0 :y 0.0}}])
+ result (vec (path/flip-content content #{0 1} :vertical))]
+ (t/is (= {:c1x 2.0 :c1y -5.0 :c2x 8.0 :c2y -5.0 :x 10.0 :y 0.0}
+ (:params (second result))))))
+
+(t/deftest segment-separate-single-node
+ ;; Separating an interior node creates two open ends.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 10.0 0.0)}))]
+ ;; move-to, line-to (to node1 kept at 10,0), move-to (node2 offset), line-to
+ (t/is (= [:move-to :line-to :move-to :line-to] (mapv :command result)))
+ (t/is (= {:x 10.0 :y 0.0} (:params (nth result 1))))
+ (t/is (= {:x 18.0 :y 8.0} (:params (nth result 2))))
+ (t/is (= {:x 20.0 :y 0.0} (:params (nth result 3))))))
+
+(t/deftest segment-separate-single-node-custom-offset
+ ;; The supplied offset controls the gap between split ends.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 10.0 0.0)} (gpt/point 2.0 2.0)))]
+ (t/is (= [:move-to :line-to :move-to :line-to] (mapv :command result)))
+ (t/is (= {:x 10.0 :y 0.0} (:params (nth result 1))))
+ (t/is (= {:x 12.0 :y 2.0} (:params (nth result 2))))
+ (t/is (= {:x 20.0 :y 0.0} (:params (nth result 3))))))
+
+(t/deftest segment-separate-single-node-closed-seam
+ ;; Separating a closed seam creates two endpoints.
+ (let [point (gpt/point 0.0 0.0)
+ content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to
+ :params {:c1x 2.0 :c1y -2.0
+ :c2x 8.0 :c2y -2.0
+ :x 10.0 :y 0.0}}
+ {:command :curve-to
+ :params {:c1x 8.0 :c1y 2.0
+ :c2x 2.0 :c2y 2.0
+ :x 0.0 :y 0.0}}
+ {:command :close-path :params {}}])
+ result (vec (path/separate-nodes content #{point} (gpt/point 2.0 2.0)))]
+ (t/is (= [:move-to :curve-to :curve-to] (mapv :command result)))
+ (t/is (= {:x 0.0 :y 0.0}
+ (select-keys (:params (first result)) [:x :y])))
+ (t/is (= {:x 2.0 :y 2.0}
+ (select-keys (:params (peek result)) [:x :y])))
+ ;; The incoming c2 stays attached to the shifted endpoint.
+ (t/is (= {:c2x 4.0 :c2y 4.0}
+ (select-keys (:params (peek result)) [:c2x :c2y])))))
+
+(t/deftest segment-separate-single-node-endpoint-noop
+ ;; an endpoint node has no following segment, so nothing is split
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 20.0 0.0)}))]
+ (t/is (= [:move-to :line-to :line-to] (mapv :command result)))))
+
+(t/deftest segment-separate-single-node-curve-carries-handler
+ ;; the outgoing curve's leading handler is shifted with the new start
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 12.0 :c1y 0.0 :c2x 18.0 :c2y 0.0 :x 20.0 :y 0.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 10.0 0.0)}))
+ curve (nth result 3)]
+ (t/is (= [:move-to :line-to :move-to :curve-to] (mapv :command result)))
+ (t/is (= {:x 18.0 :y 8.0} (:params (nth result 2))))
+ ;; c1 shifted by the same (8,8) offset, c2/end untouched
+ (t/is (= 20.0 (get-in curve [:params :c1x])))
+ (t/is (= 8.0 (get-in curve [:params :c1y])))
+ (t/is (= 18.0 (get-in curve [:params :c2x])))
+ (t/is (= 20.0 (get-in curve [:params :x])))))
+
+(t/deftest segment-separate-single-node-junction
+ ;; Separating coincident subpaths creates one open end per line.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 5.0 :y 5.0}}
+ {:command :move-to :params {:x 5.0 :y 5.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 5.0 5.0)}))]
+ (t/is (= [:move-to :line-to :move-to :line-to] (mapv :command result)))
+ ;; the first line keeps (5,5); the second subpath's start is offset by (8,8)
+ (t/is (= {:x 5.0 :y 5.0} (:params (nth result 1))))
+ (t/is (= {:x 13.0 :y 13.0} (:params (nth result 2))))
+ (t/is (= {:x 10.0 :y 10.0} (:params (nth result 3))))))
+
+(t/deftest segment-separate-single-node-junction-three-lines
+ ;; three lines meeting at a point separate into three distinct offset ends
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 5.0 :y 5.0}}
+ {:command :move-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 5.0 :y 5.0}}
+ {:command :move-to :params {:x 5.0 :y 5.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])
+ result (vec (path/separate-nodes content #{(gpt/point 5.0 5.0)}))]
+ (t/is (= [{:x 0.0 :y 0.0} {:x 5.0 :y 5.0}
+ {:x 20.0 :y 0.0} {:x 13.0 :y 13.0}
+ {:x 21.0 :y 21.0} {:x 10.0 :y 10.0}]
+ (mapv #(select-keys (:params %) [:x :y]) result)))))
+
+(t/deftest segment-flip-content-partial-selection
+ ;; only the selected nodes and their handles move; others stay put
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])
+ result (path/flip-content content #{0 1} :horizontal)
+ pts (mapv (comp (juxt :x :y) :params) (vec result))]
+ (t/is (= [[10.0 0.0] [0.0 0.0] [10.0 10.0]] pts))))
+
+(t/deftest segment-align-content
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 2.0}}
+ {:command :line-to :params {:x 4.0 :y 20.0}}])
+ pts (fn [c] (mapv (comp (juxt :x :y) :params) (vec c)))]
+ ;; align to the left edge: every selected x becomes the min x
+ (t/is (= [[0.0 0.0] [0.0 2.0] [0.0 20.0]]
+ (pts (path/align-content content #{0 1 2} :hleft))))
+ ;; align to horizontal center: x becomes the bbox center
+ (t/is (= [[5.0 0.0] [5.0 2.0] [5.0 20.0]]
+ (pts (path/align-content content #{0 1 2} :hcenter))))
+ ;; align to the top edge: every selected y becomes the min y
+ (t/is (= [[0.0 0.0] [10.0 0.0] [4.0 0.0]]
+ (pts (path/align-content content #{0 1 2} :vtop))))))
+
+(t/deftest segment-align-content-partial-and-guard
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 2.0}}
+ {:command :line-to :params {:x 4.0 :y 20.0}}])
+ pts (fn [c] (mapv (comp (juxt :x :y) :params) (vec c)))]
+ ;; only the selected nodes align; the unselected node stays put
+ (t/is (= [[0.0 0.0] [0.0 2.0] [4.0 20.0]]
+ (pts (path/align-content content #{0 1} :hleft))))
+ ;; fewer than two selected nodes is a no-op
+ (t/is (= (pts content)
+ (pts (path/align-content content #{0} :hleft))))))
+
+(t/deftest segment-align-content-moves-handles
+ ;; a selected node's attached handles move rigidly with its anchor
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 2.0 :c1y 1.0 :c2x 8.0 :c2y 1.0 :x 10.0 :y 0.0}}])
+ result (vec (path/align-content content #{0 1} :vtop))]
+ ;; both nodes already share y=0, so vtop is a no-op on the anchors and
+ ;; leaves the handles untouched
+ (t/is (= {:c1x 2.0 :c1y 1.0 :c2x 8.0 :c2y 1.0 :x 10.0 :y 0.0}
+ (:params (second result))))))
+
+(t/deftest segment-set-nodes-coordinate
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}])]
+ ;; setting x for two nodes moves each to that x (per-node delta), the
+ ;; unselected node is untouched
+ (t/is (= [[:move-to {:x 5.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 0.0}]
+ [:line-to {:x 5.0 :y 0.0}]]
+ (mapv (juxt :command :params)
+ (vec (path/set-nodes-coordinate content #{0 2} :x 5.0)))))
+ ;; a single node's y moves only that node, and its attached handle moves
+ ;; rigidly with the anchor
+ (let [curved (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 2.0 :c1y 0.0 :c2x 8.0 :c2y 0.0 :x 10.0 :y 0.0}}])
+ r (vec (path/set-nodes-coordinate curved #{1} :y 5.0))]
+ ;; node 1 anchor y 0 -> 5 (delta +5); its :c2 handle (owned by node 1)
+ ;; moves +5 too; :c1 (owned by node 0, unselected) stays
+ (t/is (= {:c1x 2.0 :c1y 0.0 :c2x 8.0 :c2y 5.0 :x 10.0 :y 5.0}
+ (:params (second r)))))))
+
+(t/deftest segment-set-nodes-coordinate-keeps-coincident-nodes-together
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}])
+ result (vec (path/set-nodes-coordinate content #{0} :y 5.0))]
+ ;; The first and last commands are the same logical closed-seam node.
+ (t/is (= (gpt/point 0.0 5.0)
+ (path.helpers/segment->point (nth result 0))))
+ (t/is (= (gpt/point 0.0 5.0)
+ (path.helpers/segment->point (nth result 2))))
+ (t/is (= (gpt/point 10.0 0.0)
+ (path.helpers/segment->point (nth result 1))))))
+
+(t/deftest segment-set-handler-points
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 2.0 :c1y 2.0 :c2x 8.0 :c2y 2.0 :x 10.0 :y 0.0}}])
+ r (vec (path/set-handler-points content {[1 :c2] (gpt/point 7.0 6.0)}))]
+ ;; c2 set to the target point; c1 and the anchor stay put
+ (t/is (= {:c1x 2.0 :c1y 2.0 :c2x 7.0 :c2y 6.0 :x 10.0 :y 0.0}
+ (:params (second r))))))
+
+(t/deftest segment-translate-selected-nodes
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}])
+ ;; translate nodes 1 and 2 by (0, 5): both move down, node 0 stays
+ r (vec (path/translate-selected-nodes content #{1 2} (gpt/point 0.0 5.0)))]
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 5.0}]
+ [:line-to {:x 20.0 :y 5.0}]]
+ (mapv (juxt :command :params) r)))))
+
+(t/deftest segment-distribute-content
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 3.0 :y 5.0}}
+ {:command :line-to :params {:x 10.0 :y 9.0}}])
+ pts (fn [c] (mapv (comp (juxt :x :y) :params) (vec c)))]
+ ;; the middle node is spaced evenly between the two extremes on x
+ (t/is (= [[0.0 0.0] [5.0 5.0] [10.0 9.0]]
+ (pts (path/distribute-content content #{0 1 2} :horizontal))))
+ ;; fewer than three selected nodes is a no-op
+ (t/is (= (pts content)
+ (pts (path/distribute-content content #{0 1} :horizontal))))))
+
+(t/deftest segment-distribute-content-keeps-coincident-nodes-together
+ ;; Coincident selected nodes move as one group.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 3.0 :y 7.0}}
+ {:command :line-to :params {:x 3.0 :y 7.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}])
+ pts (fn [c] (mapv (comp (juxt :x :y) :params) (vec c)))]
+ ;; three distinct positions (0, 3, 10); the coincident pair is one group
+ ;; centred at x=5 and both nodes move there together, staying coincident
+ (t/is (= [[0.0 0.0] [5.0 7.0] [5.0 7.0] [10.0 0.0]]
+ (pts (path/distribute-content content #{0 1 2 3} :horizontal))))
+ ;; only two distinct positions among the selection is a no-op
+ (t/is (= (pts content)
+ (pts (path/distribute-content content #{1 2 3} :horizontal))))))
+
+(t/deftest helpers-curve-arc-length-t
+ (let [arc-len (fn [curve a b]
+ (->> (range 1001)
+ (map #(path.helpers/curve-values
+ curve (+ a (* (/ (double %) 1000) (- b a)))))
+ (partition 2 1)
+ (map (fn [[p q]] (gpt/distance p q)))
+ (reduce +)))]
+ ;; a straight line (degenerate cubic) has its visual middle at t=0.5
+ (let [line [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)
+ (gpt/point 0.0 0.0) (gpt/point 10.0 0.0)]]
+ (t/is (mth/close? 0.5 (path.helpers/curve-arc-length-t line) 0.01)))
+ ;; An uneven curve's arc midpoint differs from its parametric midpoint.
+ (let [curve [(gpt/point 0.0 0.0) (gpt/point 100.0 100.0)
+ (gpt/point 0.0 0.0) (gpt/point 0.0 100.0)]
+ t (path.helpers/curve-arc-length-t curve)
+ total (arc-len curve 0.0 1.0)
+ first-half (arc-len curve 0.0 t)]
+ (t/is (< 0.5 t 1.0))
+ ;; the length up to t is within 1% of half the total
+ (t/is (< (mth/abs (- first-half (/ total 2.0))) (* 0.01 total))))))
+
+(t/deftest helpers-fit-curve-single-curve
+ ;; samples of one gentle cubic are fitted back with a single curve
+ (let [curve [(gpt/point 0.0 0.0) (gpt/point 30.0 0.0)
+ (gpt/point 10.0 10.0) (gpt/point 20.0 10.0)]
+ samples (mapv #(path.helpers/curve-values curve (/ % 24.0)) (range 25))
+ result (path.fit/fit-curve samples 0.5)]
+ (t/is (= 1 (count result)))
+ (let [[start end h1 h2] (first result)]
+ (t/is (= (gpt/point 0.0 0.0) start))
+ (t/is (= (gpt/point 30.0 0.0) end))
+ (t/is (mth/close? 10.0 (:x h1) 1.5))
+ (t/is (mth/close? 10.0 (:y h1) 1.5))
+ (t/is (mth/close? 20.0 (:x h2) 1.5))
+ (t/is (mth/close? 10.0 (:y h2) 1.5)))))
+
+(t/deftest helpers-fit-curve-splits-and-chains
+ ;; Sharp corners split the fit into chained curves.
+ (let [pts (into []
+ (concat
+ (map #(gpt/point (double %) (double %)) (range 0 11))
+ (map #(gpt/point (+ 10.0 %) (- 10.0 %)) (range 1 11))))
+ result (path.fit/fit-curve pts 0.1)]
+ (t/is (> (count result) 1))
+ (t/is (every? (fn [[c1 c2]] (= (nth c1 1) (nth c2 0)))
+ (map vector result (rest result))))
+ (t/is (= (gpt/point 0.0 0.0) (get-in result [0 0])))
+ (t/is (= (gpt/point 20.0 0.0) (nth (peek result) 1)))))
+
+(t/deftest helpers-fit-curve-respects-tolerance
+ ;; every input point stays within tolerance of the fitted sequence
+ (let [pts (mapv #(gpt/point (double %) (* 5.0 (mth/sin (/ % 3.0))))
+ (range 0 31))
+ tol 0.5
+ result (path.fit/fit-curve pts tol)
+ curve-pts (into []
+ (mapcat (fn [c]
+ (map #(path.helpers/curve-values c (/ % 100.0))
+ (range 101))))
+ result)
+ max-dev (reduce max
+ (map (fn [p]
+ (reduce min (map #(gpt/distance p %) curve-pts)))
+ pts))]
+ (t/is (<= max-dev (+ tol 0.05)))))
+
+(t/deftest helpers-fit-curve-keeps-sharp-corners
+ ;; Sharp-corner handles follow their own legs.
+ (let [corner (gpt/point 10.0 10.0)
+ ;; two legs meeting at a 90 degree corner: (0,0)->(10,10)->(20,0)
+ pts (into []
+ (concat
+ (map #(gpt/point (double %) (double %)) (range 0 11))
+ (map #(gpt/point (+ 10.0 %) (- 10.0 %)) (range 1 11))))
+ result (path.fit/fit-curve pts 0.1)
+ ;; the two curves meeting at the corner
+ left (first (filter #(= corner (nth % 1)) result))
+ right (first (filter #(= corner (nth % 0)) result))
+ v-in (gpt/to-vec corner (nth left 3)) ;; incoming handle (h2) direction
+ v-out (gpt/to-vec corner (nth right 2)) ;; outgoing handle (h1) direction
+ angle (gpt/angle-with-other v-in v-out)]
+ (t/is (some? left))
+ (t/is (some? right))
+ ;; The join keeps the corner's angle.
+ (t/is (< angle 135.0))
+ (t/is (mth/close? 90.0 angle 15.0))))
+
+(t/deftest segment-smooth-points->content
+ (t/testing "two points produce a straight segment"
+ (let [content (path.segment/smooth-points->content
+ [(gpt/point 0.0 0.0) (gpt/point 10.0 0.0)] 1.0)]
+ (t/is (= [:move-to :line-to] (mapv :command content)))))
+ (t/testing "freehand-like points produce fewer, fitted curve segments"
+ (let [pts (mapv #(gpt/point (double %) (* 5.0 (mth/sin (/ % 3.0))))
+ (range 0 31))
+ content (path.segment/smooth-points->content pts 1.0)
+ cmds (mapv :command content)]
+ (t/is (= :move-to (first cmds)))
+ (t/is (every? #(= :curve-to %) (rest cmds)))
+ (t/is (< (count cmds) (count pts)))
+ (t/is (= {:x 0.0 :y 0.0} (:params (first (vec content)))))
+ (let [last-params (:params (peek (vec content)))]
+ (t/is (mth/close? 30.0 (:x last-params)))
+ (t/is (mth/close? (* 5.0 (mth/sin 10.0)) (:y last-params)))))))
+
+(t/deftest segment-remove-nodes-collinear-keeps-line
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 10.0 0.0)})]
+ (t/is (= [:move-to :line-to] (mapv :command result)))
+ (t/is (= {:x 20.0 :y 0.0} (:params (second result))))))
+
+(t/deftest segment-remove-nodes-corner-fits-curve
+ ;; Removing a slanted corner keeps both endpoint tangents.
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 10.0 10.0)})
+ curve (second result)]
+ (t/is (= [:move-to :curve-to] (mapv :command result)))
+ (let [{:keys [c1x c1y c2x c2y x y]} (:params curve)
+ mid (path.helpers/curve-values (gpt/point 0.0 0.0) (gpt/point x y)
+ (gpt/point c1x c1y) (gpt/point c2x c2y) 0.5)]
+ (t/is (mth/close? 20.0 x))
+ (t/is (mth/close? 0.0 y))
+ ;; handlers stay on the removed segments' directions (45 degrees)
+ (t/is (mth/close? c1x c1y 0.01))
+ (t/is (mth/close? (- 20.0 c2x) c2y 0.01))
+ ;; the curve bulges towards the removed corner
+ (t/is (< 2.0 (:y mid) 10.0))
+ (t/is (mth/close? 10.0 (:x mid) 0.5)))))
+
+(t/deftest segment-remove-nodes-between-curves-approximates
+ ;; Joined quarter arcs collapse into a fitted semicircle.
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 0.0 :c1y 5.52 :c2x 4.48 :c2y 10.0 :x 10.0 :y 10.0}}
+ {:command :curve-to :params {:c1x 15.52 :c1y 10.0 :c2x 20.0 :c2y 5.52 :x 20.0 :y 0.0}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 10.0 10.0)})
+ curve (second result)]
+ (t/is (= [:move-to :curve-to] (mapv :command result)))
+ (let [{:keys [c1x c1y c2x c2y x y]} (:params curve)
+ mid (path.helpers/curve-values (gpt/point 0.0 0.0) (gpt/point x y)
+ (gpt/point c1x c1y) (gpt/point c2x c2y) 0.5)]
+ ;; The fitted curve keeps the semicircle apex.
+ (t/is (mth/close? 10.0 (:x mid) 0.5))
+ (t/is (mth/close? 10.0 (:y mid) 0.5)))))
+
+(t/deftest segment-remove-node-restores-a-split-curve
+ ;; Removing an untouched split node rejoins the cubic exactly.
+ (let [from (gpt/point 0.0 0.0)
+ original {:command :curve-to
+ :params {:c1x 0.0 :c1y 0.0
+ :c2x 0.0 :c2y 100.0
+ :x 100.0 :y 100.0}}
+ content (path/content [(path.helpers/make-move-to from) original])
+ curve (path.helpers/command->bezier original from)
+ t-val (path.helpers/curve-arc-length-t curve)
+ split (-> (path.segment/split-segments content #{from (gpt/point 100.0 100.0)} t-val)
+ (path/content))
+ inserted (path.helpers/segment->point (nth split 1))
+ result (vec (path.segment/remove-nodes split #{inserted}))
+ healed (second result)]
+ ;; Split at the asymmetric curve's arc midpoint.
+ (t/is (not (mth/close? 0.5 t-val 0.01)))
+ (t/is (= [:move-to :curve-to] (mapv :command result)))
+ (doseq [coord [:c1x :c1y :c2x :c2y :x :y]]
+ (t/is (mth/close? (get-in original [:params coord])
+ (get-in healed [:params coord]))))))
+
+(t/deftest segment-remove-nodes-multiple-consecutive
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 5.0 :y 5.0}}
+ {:command :line-to :params {:x 10.0 :y 7.0}}
+ {:command :line-to :params {:x 15.0 :y 5.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 5.0 5.0)
+ (gpt/point 10.0 7.0)
+ (gpt/point 15.0 5.0)})
+ curve (second result)]
+ (t/is (= [:move-to :curve-to] (mapv :command result)))
+ (let [{:keys [c1x c1y c2x c2y x y]} (:params curve)
+ mid (path.helpers/curve-values (gpt/point 0.0 0.0) (gpt/point x y)
+ (gpt/point c1x c1y) (gpt/point c2x c2y) 0.5)]
+ (t/is (mth/close? 10.0 (:x mid) 1.0))
+ (t/is (< 4.0 (:y mid) 8.5)))))
+
+(t/deftest segment-remove-nodes-endpoints-drop-segments
+ (let [content (path/content simple-open-content)]
+ (t/testing "removing the first node drops the leading segment"
+ (let [result (path.segment/remove-nodes content #{(gpt/point 0.0 0.0)})]
+ (t/is (= [:move-to :line-to] (mapv :command result)))
+ (t/is (= {:x 10.0 :y 0.0} (:params (first result))))))
+ (t/testing "removing the last node drops the trailing segment"
+ (let [result (path.segment/remove-nodes content #{(gpt/point 10.0 10.0)})]
+ (t/is (= [:move-to :line-to] (mapv :command result)))
+ (t/is (= {:x 10.0 :y 0.0} (:params (second result))))))))
+
+(t/deftest segment-remove-nodes-closed-path-keeps-closure
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :close-path :params {}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 10.0 10.0)})]
+ (t/is (= [:move-to :curve-to :line-to :close-path] (mapv :command result)))))
+
+(t/deftest segment-remove-nodes-heals-a-closed-seam
+ (let [line-closed [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 0.0 :y 10.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}]
+ command-closed (conj line-closed {:command :close-path :params {}})
+ seam (gpt/point 0.0 0.0)]
+ (doseq [content [line-closed command-closed]]
+ (let [result (vec (path.segment/remove-nodes (path/content content) #{seam}))
+ commands (mapv :command result)
+ points (mapv path.helpers/segment->point
+ (remove #(= :close-path (:command %)) result))]
+ ;; Both non-seam sides survive and are joined through one fitted segment.
+ (t/is (= [:move-to :line-to :line-to :curve-to]
+ (cond-> commands
+ (= :close-path (peek commands)) pop)))
+ (t/is (= [(gpt/point 10.0 0.0)
+ (gpt/point 10.0 10.0)
+ (gpt/point 0.0 10.0)
+ (gpt/point 10.0 0.0)]
+ points))))))
+
+(t/deftest segment-remove-nodes-heals-a-touching-subpath-seam
+ ;; During path edition, duplicated and merged halves can still be stored as
+ ;; two open subpaths whose endpoints touch. Finalizing the path joins them,
+ ;; but deleting their shared node must behave the same before finalization.
+ (let [content
+ (path/content
+ [{:command :move-to :params {:x 0.0 :y 10.0}}
+ {:command :line-to :params {:x -10.0 :y 7.0}}
+ {:command :line-to :params {:x -10.0 :y 3.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 3.0}}
+ {:command :line-to :params {:x 10.0 :y 7.0}}
+ {:command :line-to :params {:x 0.0 :y 10.0}}])
+ result (vec (path.segment/remove-nodes content #{(gpt/point 0.0 10.0)}))]
+ (t/is (= [:move-to :line-to :line-to :line-to :line-to :curve-to]
+ (mapv :command result)))
+ (t/is (= (gpt/point -10.0 7.0)
+ (path.helpers/segment->point (first result))))
+ (t/is (= (gpt/point -10.0 7.0)
+ (path.helpers/segment->point (peek result))))))
+
+(t/deftest segment-remove-nodes-chain-ending-on-close-path
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :close-path :params {}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 10.0 10.0)})]
+ ;; the geometry back to the start is approximated and the path stays closed
+ (t/is (= [:move-to :line-to :curve-to :close-path] (mapv :command result)))
+ (t/is (mth/close? 0.0 (get-in (vec result) [2 :params :x])))
+ (t/is (mth/close? 0.0 (get-in (vec result) [2 :params :y])))))
+
+(t/deftest segment-remove-nodes-heals-removed-close-target
+ ;; Removing the closed seam preserves both adjacent sides and fits their
+ ;; replacement across the former start point.
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 0.0 :y 0.0}}
+ {:command :close-path :params {}}]
+ result (path.segment/remove-nodes (path/content content)
+ #{(gpt/point 0.0 0.0)})]
+ (t/is (= [:move-to :line-to :curve-to :close-path] (mapv :command result)))
+ (t/is (= (gpt/point 10.0 10.0)
+ (path.helpers/segment->point (first result))))
+ (t/is (= (gpt/point 10.0 10.0)
+ (path.helpers/segment->point (nth result 2))))))
+
(t/deftest segment-join-nodes
(let [content (path/content simple-open-content)
pt1 (gpt/point 0.0 0.0)
@@ -1290,6 +2038,118 @@
(let [result (path/merge-nodes nil #{(gpt/point 0 0)})]
(t/is (some? result)))))
+(t/deftest path-merge-disconnected-nodes
+ ;; Merging separate subpaths joins them at the shared midpoint.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :move-to :params {:x 0.0 :y 10.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])
+ pts #{(gpt/point 10.0 0.0) (gpt/point 0.0 10.0)}
+ result (vec (path/merge-nodes content pts))]
+ (t/is (= [{:x 0.0 :y 0.0} {:x 5.0 :y 5.0}
+ {:x 5.0 :y 5.0} {:x 10.0 :y 10.0}]
+ (mapv :params result)))))
+
+(t/deftest path-duplicate-node-content
+ ;; Duplicating a node copies its incident segments as subpaths.
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 100.0 :y 0.0}}
+ {:command :curve-to :params {:x 200.0 :y 100.0 :c1x 100.0 :c1y 50.0 :c2x 150.0 :c2y 100.0}}])
+ off (gpt/point 10 10)]
+ ;; Interior copies meet at the offset node.
+ (let [{ext :content selected :selected} (path/duplicate-node-content content 1 off)]
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 110.0 :y 10.0}]
+ [:move-to {:x 200.0 :y 100.0}]
+ [:curve-to {:x 110.0 :y 10.0 :c1x 150.0 :c1y 100.0 :c2x 110.0 :c2y 60.0}]]
+ (mapv (juxt :command :params) ext)))
+ (t/is (= #{1 3} selected)))
+ ;; Endpoint copies keep only the incoming curve.
+ (let [{ext :content selected :selected} (path/duplicate-node-content content 2 off)]
+ (t/is (= [[:move-to {:x 100.0 :y 0.0}]
+ [:curve-to {:c1x 100.0 :c1y 50.0 :c2x 160.0 :c2y 110.0 :x 210.0 :y 110.0}]]
+ (mapv (juxt :command :params) ext)))
+ (t/is (= #{1} selected)))
+ ;; Subpath-start copies reverse the outgoing segment.
+ (let [{ext :content selected :selected} (path/duplicate-node-content content 0 off)]
+ (t/is (= [[:move-to {:x 100.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 10.0}]]
+ (mapv (juxt :command :params) ext)))
+ (t/is (= #{1} selected)))
+ ;; a lone point (subpath with only a move-to) is copied as an offset point
+ (let [lone (path/content [{:command :move-to :params {:x 5.0 :y 5.0}}])
+ {ext :content selected :selected} (path/duplicate-node-content lone 0 off)]
+ (t/is (= [[:move-to {:x 15.0 :y 15.0}]]
+ (mapv (juxt :command :params) ext)))
+ (t/is (= #{0} selected)))))
+
+(t/deftest segment-collapse-handler
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:x 100.0 :y 0.0 :c1x 20.0 :c1y 40.0 :c2x 80.0 :c2y 40.0}}])]
+ ;; Collapsing one handler keeps the other handle unchanged.
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:curve-to {:x 100.0 :y 0.0 :c1x 0.0 :c1y 0.0 :c2x 80.0 :c2y 40.0}]]
+ (mapv (juxt :command :params) (path/collapse-handler content 1 :c1))))
+ ;; collapsing the second handler too degenerates the curve into a line-to
+ (let [collapsed (-> content
+ (path/collapse-handler 1 :c1)
+ (path/collapse-handler 1 :c2))]
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 100.0 :y 0.0}]]
+ (mapv (juxt :command :params) collapsed))))))
+
+(t/deftest segment-toggle-segment-curve
+ (let [line (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 90.0 :y 0.0}}])
+ curve (path/toggle-segment-curve line 1)]
+ ;; Curved lines use perpendicular bowed handles.
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:curve-to {:x 90.0 :y 0.0 :c1x 30.0 :c1y 22.5 :c2x 60.0 :c2y 22.5}]]
+ (mapv (juxt :command :params) curve)))
+ ;; curve -> line: drops the control points
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 90.0 :y 0.0}]]
+ (mapv (juxt :command :params) (path/toggle-segment-curve curve 1))))
+ ;; move-to / close-path are untouched
+ (t/is (= (vec line) (vec (path/toggle-segment-curve line 0))))))
+
+(t/deftest segment-remove-segments
+ (let [content (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 30.0 :y 0.0}}])]
+ ;; Removing an interior segment keeps both endpoints.
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 0.0}]
+ [:move-to {:x 20.0 :y 0.0}]
+ [:line-to {:x 30.0 :y 0.0}]]
+ (mapv (juxt :command :params) (path/remove-segments content #{2}))))
+ ;; Removing the first segment drops the dangling start node.
+ (t/is (= [[:move-to {:x 10.0 :y 0.0}]
+ [:line-to {:x 20.0 :y 0.0}]
+ [:line-to {:x 30.0 :y 0.0}]]
+ (mapv (juxt :command :params) (path/remove-segments content #{1}))))
+ ;; a closed subpath broken elsewhere keeps its closing line geometry
+ (let [closed (path/content
+ [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :close-path :params {}}])]
+ (t/is (= [[:move-to {:x 10.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 10.0}]
+ [:line-to {:x 0.0 :y 0.0}]]
+ (mapv (juxt :command :params) (path/remove-segments closed #{1}))))
+ ;; removing the close-path just leaves the subpath open
+ (t/is (= [[:move-to {:x 0.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 0.0}]
+ [:line-to {:x 10.0 :y 10.0}]]
+ (mapv (juxt :command :params) (path/remove-segments closed #{3})))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BOOL OPERATIONS — INTERSECTION / DIFFERENCE / EXCLUSION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1592,3 +2452,85 @@
[])]
(t/is (= max-safe (:x move-res)) "reduce first x should be clamped")
(t/is (= min-safe (:y move-res)) "reduce first y should be clamped")))))
+
+(t/deftest segment-entries-identity
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 12.0 :c1y 0.0 :c2x 18.0 :c2y 0.0 :x 20.0 :y 0.0}}
+ {:command :close-path :params {}}
+ {:command :move-to :params {:x 30.0 :y 30.0}}
+ {:command :line-to :params {:x 40.0 :y 30.0}}]
+ entries (path/segment-entries content)]
+ (t/is (= [1 2 3 5] (mapv :index entries)))
+ ;; The closing segment goes back to the subpath start node
+ (t/is (= 0 (:to-index (nth entries 2))))
+ (t/is (= (gpt/point 0.0 0.0) (:to (nth entries 2))))
+ ;; The second subpath starts from its own move-to
+ (t/is (= 4 (:from-index (nth entries 3))))))
+
+(t/deftest single-line-predicate
+ ;; A move-to followed by exactly one line-to is a single line
+ (t/is (path/single-line?
+ (path/content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}])))
+ ;; A curve, a polyline and a closed loop are not
+ (t/is (not (path/single-line?
+ (path/content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 1.0 :c1y 0.0 :c2x 2.0 :c2y 0.0 :x 10.0 :y 0.0}}]))))
+ (t/is (not (path/single-line?
+ (path/content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}]))))
+ (t/is (not (path/single-line? nil))))
+
+(t/deftest extract-content-chains-and-breaks
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 30.0 :y 0.0}}
+ {:command :line-to :params {:x 40.0 :y 0.0}}]]
+ ;; Adjacent selected segments chain into one subpath
+ (t/is (= [{:command :move-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 30.0 :y 0.0}}]
+ (vec (path/extract-content content {:segments #{2 3}}))))
+ ;; A gap starts a new subpath
+ (t/is (= [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :move-to :params {:x 30.0 :y 0.0}}
+ {:command :line-to :params {:x 40.0 :y 0.0}}]
+ (vec (path/extract-content content {:segments #{1 4}}))))))
+
+(t/deftest extract-content-from-selected-nodes
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 12.0 :c1y 0.0 :c2x 18.0 :c2y 0.0 :x 20.0 :y 0.0}}
+ {:command :line-to :params {:x 30.0 :y 0.0}}]]
+ ;; Segments whose two endpoint nodes are selected are included
+ (t/is (= [{:command :move-to :params {:x 10.0 :y 0.0}}
+ {:command :curve-to :params {:c1x 12.0 :c1y 0.0 :c2x 18.0 :c2y 0.0 :x 20.0 :y 0.0}}]
+ (vec (path/extract-content content {:nodes #{1 2}}))))
+ ;; A single selected node produces no content
+ (t/is (empty? (path/extract-content content {:nodes #{1}})))
+ ;; Non-adjacent selected nodes produce no content
+ (t/is (empty? (path/extract-content content {:nodes #{0 2}})))))
+
+(t/deftest extract-content-closes-full-loops
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 10.0}}
+ {:command :close-path :params {}}]
+ result (vec (path/extract-content content {:nodes #{0 1 2}}))]
+ (t/is (= :move-to (:command (nth result 0))))
+ (t/is (= :line-to (:command (nth result 1))))
+ (t/is (= :line-to (:command (nth result 2))))
+ (t/is (= :close-path (:command (nth result 3))))))
+
+(t/deftest splice-content-appends-subpaths
+ (let [content [{:command :move-to :params {:x 0.0 :y 0.0}}
+ {:command :line-to :params {:x 10.0 :y 0.0}}]
+ sub [{:command :move-to :params {:x 30.0 :y 30.0}}
+ {:command :line-to :params {:x 40.0 :y 30.0}}]
+ result (path/splice-content content sub)]
+ (t/is (path.impl/path-data? result))
+ (t/is (= (into (vec content) sub) (vec result)))))
diff --git a/frontend/playwright/ui/specs/workspace.spec.js b/frontend/playwright/ui/specs/workspace.spec.js
index d7281244c7..702b3b3aef 100644
--- a/frontend/playwright/ui/specs/workspace.spec.js
+++ b/frontend/playwright/ui/specs/workspace.spec.js
@@ -171,10 +171,12 @@ test("Selection size badge shows dimensions for path shapes", async ({ page }) =
// Workaround: hover viewport first to avoid nil mouse position crash
await workspacePage.viewport.hover();
- // Draw a path
+ // Draw a path with two segments; a single straight segment shows
+ // endpoint controls instead of the size badge
await workspacePage.pathButton.click();
await workspacePage.clickAt(779, 163);
await workspacePage.clickAt(951, 258);
+ await workspacePage.clickAt(1050, 163);
// Finish drawing (commits path, path enters edition mode)
await page.keyboard.press("Escape");
@@ -187,6 +189,36 @@ test("Selection size badge shows dimensions for path shapes", async ({ page }) =
await expect(badgeText).toHaveText(/\d+\.?\d* x \d+\.?\d*/);
});
+test("Selection size badge is hidden for straight line paths", async ({
+ page,
+}) => {
+ const workspacePage = new WasmWorkspacePage(page);
+ await workspacePage.setupEmptyFile();
+ await workspacePage.mockRPC(
+ "update-file?id=*",
+ "workspace/update-file-empty.json",
+ );
+
+ await workspacePage.goToWorkspace();
+
+ // Workaround: hover viewport first to avoid nil mouse position crash
+ await workspacePage.viewport.hover();
+
+ // Draw a path with a single straight segment
+ await workspacePage.pathButton.click();
+ await workspacePage.clickAt(779, 163);
+ await workspacePage.clickAt(951, 258);
+
+ // Finish drawing (commits path, path enters edition mode)
+ await page.keyboard.press("Escape");
+
+ // Exit edition mode (path stays selected)
+ await page.keyboard.press("Escape");
+
+ await expect(page.locator(".line-controls")).toBeVisible();
+ await expect(page.locator(".selection-size-badge")).toHaveCount(0);
+});
+
test("User makes a group", async ({ page }) => {
const workspacePage = new WasmWorkspacePage(page);
await workspacePage.setupEmptyFile();
diff --git a/frontend/resources/images/cursors/draw-add.svg b/frontend/resources/images/cursors/draw-add.svg
new file mode 100644
index 0000000000..a2113432fb
--- /dev/null
+++ b/frontend/resources/images/cursors/draw-add.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/draw-node.svg b/frontend/resources/images/cursors/draw-node.svg
new file mode 100644
index 0000000000..5d6290c6bc
--- /dev/null
+++ b/frontend/resources/images/cursors/draw-node.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/draw-remove.svg b/frontend/resources/images/cursors/draw-remove.svg
new file mode 100644
index 0000000000..1d430ca8e5
--- /dev/null
+++ b/frontend/resources/images/cursors/draw-remove.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/draw.svg b/frontend/resources/images/cursors/draw.svg
new file mode 100644
index 0000000000..97e139d4e4
--- /dev/null
+++ b/frontend/resources/images/cursors/draw.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/move-add.svg b/frontend/resources/images/cursors/move-add.svg
new file mode 100644
index 0000000000..3103c58d71
--- /dev/null
+++ b/frontend/resources/images/cursors/move-add.svg
@@ -0,0 +1,8 @@
+
diff --git a/frontend/resources/images/cursors/move-copy.svg b/frontend/resources/images/cursors/move-copy.svg
new file mode 100644
index 0000000000..4c6038f11b
--- /dev/null
+++ b/frontend/resources/images/cursors/move-copy.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/cursors/move-curve.svg b/frontend/resources/images/cursors/move-curve.svg
new file mode 100644
index 0000000000..f898b6cf33
--- /dev/null
+++ b/frontend/resources/images/cursors/move-curve.svg
@@ -0,0 +1,7 @@
+
diff --git a/frontend/resources/images/cursors/move-handles.svg b/frontend/resources/images/cursors/move-handles.svg
new file mode 100644
index 0000000000..852cfe59b9
--- /dev/null
+++ b/frontend/resources/images/cursors/move-handles.svg
@@ -0,0 +1,8 @@
+
diff --git a/frontend/resources/images/cursors/move-move.svg b/frontend/resources/images/cursors/move-move.svg
new file mode 100644
index 0000000000..beb6585cc0
--- /dev/null
+++ b/frontend/resources/images/cursors/move-move.svg
@@ -0,0 +1,8 @@
+
diff --git a/frontend/resources/images/cursors/move-node.svg b/frontend/resources/images/cursors/move-node.svg
new file mode 100644
index 0000000000..66f326aa90
--- /dev/null
+++ b/frontend/resources/images/cursors/move-node.svg
@@ -0,0 +1,7 @@
+
diff --git a/frontend/resources/images/cursors/move-remove.svg b/frontend/resources/images/cursors/move-remove.svg
new file mode 100644
index 0000000000..022d749c07
--- /dev/null
+++ b/frontend/resources/images/cursors/move-remove.svg
@@ -0,0 +1,7 @@
+
diff --git a/frontend/resources/images/cursors/move.svg b/frontend/resources/images/cursors/move.svg
new file mode 100644
index 0000000000..223bb839a6
--- /dev/null
+++ b/frontend/resources/images/cursors/move.svg
@@ -0,0 +1,6 @@
+
diff --git a/frontend/resources/images/icons/handlers-equal.svg b/frontend/resources/images/icons/handlers-equal.svg
new file mode 100644
index 0000000000..645e773d8c
--- /dev/null
+++ b/frontend/resources/images/icons/handlers-equal.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/handlers-independent.svg b/frontend/resources/images/icons/handlers-independent.svg
new file mode 100644
index 0000000000..36e1c06917
--- /dev/null
+++ b/frontend/resources/images/icons/handlers-independent.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/handlers-mirror.svg b/frontend/resources/images/icons/handlers-mirror.svg
new file mode 100644
index 0000000000..78f71c740e
--- /dev/null
+++ b/frontend/resources/images/icons/handlers-mirror.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/images/icons/snap.svg b/frontend/resources/images/icons/snap.svg
new file mode 100644
index 0000000000..0acdce1f20
--- /dev/null
+++ b/frontend/resources/images/icons/snap.svg
@@ -0,0 +1,3 @@
+
diff --git a/frontend/resources/styles/common/refactor/color-defs.scss b/frontend/resources/styles/common/refactor/color-defs.scss
index fdaf3bf2fb..f5ba76a3c0 100644
--- a/frontend/resources/styles/common/refactor/color-defs.scss
+++ b/frontend/resources/styles/common/refactor/color-defs.scss
@@ -41,6 +41,7 @@
// APP COLORS
--app-white: #fff; // Used in several places
--app-black: #000; // Used on interactions, measurements and editor files
+ --app-pink: #f49ef7; // Used in path selection
// SOCIAL LOGIN BUTTONS
--google-login-background: #4285f4;
diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs
index 689ce07ecd..91f3703ff3 100644
--- a/frontend/src/app/main/data/workspace.cljs
+++ b/frontend/src/app/main/data/workspace.cljs
@@ -1554,6 +1554,7 @@
(dm/export dwt/update-dimensions)
(dm/export dwt/change-orientation)
(dm/export dwt/start-rotate)
+(dm/export dwt/start-move-line-point)
(dm/export dwt/increase-rotation)
(dm/export dwt/start-move-selected)
(dm/export dwt/move-selected)
diff --git a/frontend/src/app/main/data/workspace/clipboard.cljs b/frontend/src/app/main/data/workspace/clipboard.cljs
index c7f9c0ef91..ba2a4b1e29 100644
--- a/frontend/src/app/main/data/workspace/clipboard.cljs
+++ b/frontend/src/app/main/data/workspace/clipboard.cljs
@@ -39,6 +39,7 @@
[app.main.data.notifications :as ntf]
[app.main.data.persistence :as dps]
[app.main.data.workspace.media :as dwm]
+ [app.main.data.workspace.path.clipboard :as path-cp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.texts :as dwtxt]
@@ -291,8 +292,9 @@
(rx/mapcat
(fn [pdata]
(case (:type pdata)
- :copied-props (rx/of (paste-transit-props pdata))
- :copied-shapes (rx/of (paste-transit-shapes pdata))
+ :copied-props (rx/of (paste-transit-props pdata))
+ :copied-shapes (rx/of (paste-transit-shapes pdata))
+ :copied-path-content (rx/of (path-cp/paste-nodes-as-shape (:content pdata)))
(rx/empty)))))
:else
diff --git a/frontend/src/app/main/data/workspace/drawing/common.cljs b/frontend/src/app/main/data/workspace/drawing/common.cljs
index 0356086dd7..6a0efcd8f4 100644
--- a/frontend/src/app/main/data/workspace/drawing/common.cljs
+++ b/frontend/src/app/main/data/workspace/drawing/common.cljs
@@ -11,6 +11,7 @@
[app.common.types.modifiers :as ctm]
[app.common.types.shape :as cts]
[app.main.data.helpers :as dsh]
+ [app.main.data.workspace.path.state :as path.state]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.undo :as dwu]
[app.main.worker :as mw]
@@ -23,9 +24,16 @@
(ptk/reify ::clear-drawing
ptk/UpdateEvent
(update [_ state]
- (if preserve-tool?
- (update state :workspace-drawing dissoc :object :lock)
- (dissoc state :workspace-drawing))))))
+ (let [path-editing? (path.state/editing? state)]
+ (cond
+ path-editing?
+ (update state :workspace-drawing select-keys [:object])
+
+ preserve-tool?
+ (update state :workspace-drawing dissoc :object :lock)
+
+ :else
+ (dissoc state :workspace-drawing)))))))
(defn handle-finish-drawing
[]
@@ -97,6 +105,6 @@
(rx/of (dwu/commit-undo-transaction (:id shape))))
(rx/empty)))))
- ;; Delay so the mouse event can read the drawing state
+ ;; Let the current mouse event finish before clearing drawing state.
(->> (rx/of (clear-drawing {:preserve-tool? (= tool :curve)}))
(rx/delay 0)))))))
diff --git a/frontend/src/app/main/data/workspace/drawing/curve.cljs b/frontend/src/app/main/data/workspace/drawing/curve.cljs
index 2324ae59fa..f6daffd33a 100644
--- a/frontend/src/app/main/data/workspace/drawing/curve.cljs
+++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs
@@ -26,6 +26,9 @@
(def ^:const simplify-tolerance 0.3)
+;; Maximum curve-fit deviation in board units.
+(def ^:const smooth-tolerance 1)
+
(defn- setup-frame
[]
(ptk/reify ::setup-frame
@@ -82,7 +85,7 @@
(update-in state [:workspace-drawing :object]
(fn [{:keys [::points] :as shape}]
(let [points (ups/simplify points simplify-tolerance)
- content (path/points->content points)
+ content (path/smooth-points->content points smooth-tolerance)
selrect (path/calc-selrect content)
points (grc/rect->points selrect)]
@@ -117,4 +120,3 @@
(setup-frame)
(finish-drawing)
(common/handle-finish-drawing)))))))
-
diff --git a/frontend/src/app/main/data/workspace/edition.cljs b/frontend/src/app/main/data/workspace/edition.cljs
index 58815458a2..2b9e9773bd 100644
--- a/frontend/src/app/main/data/workspace/edition.cljs
+++ b/frontend/src/app/main/data/workspace/edition.cljs
@@ -8,6 +8,7 @@
(:require
[app.main.data.helpers :as dsh]
[app.main.data.workspace.path.common :as dwpc]
+ [app.main.data.workspace.path.state :as path.state]
[app.main.features :as features]
[app.render-wasm.api :as wasm.api]
[beicon.v2.core :as rx]
@@ -48,26 +49,32 @@
(defn clear-edition-mode
[]
- (ptk/reify ::clear-edition-mode
- ptk/UpdateEvent
- (update [_ state]
- (-> state
- (update :workspace-local dissoc :edition :edit-path)
- (update :workspace-drawing dissoc :object :lock)
- (dissoc :workspace-grid-edition)
- (dissoc :workspace-wasm-editor-styles)))
+ (let [path-id (volatile! nil)]
+ (ptk/reify ::clear-edition-mode
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [edition-id (get-in state [:workspace-local :edition])
+ path-editing? (path.state/editing? state)]
+ (vreset! path-id (when path-editing? edition-id))
+ (-> state
+ (update :workspace-local dissoc :edition)
+ (cond-> (not path-editing?)
+ (update :workspace-local dissoc :edit-path)
- ptk/WatchEvent
- (watch [_ state _]
- (let [id (get-in state [:workspace-local :edition])]
- (rx/concat
- (when (some? id)
- (dwpc/finish-path)))))
+ (not path-editing?)
+ (update :workspace-drawing dissoc :object :lock))
+ (dissoc :workspace-grid-edition)
+ (dissoc :workspace-wasm-editor-styles))))
- ptk/EffectEvent
- (effect [_ state _]
- (when (features/active-feature? state "text-editor-wasm/v1")
- ;; NOTE: the WASM text editor is disposed by the v3 editor component on
- ;; unmount, *after* it finalizes its content.
- (wasm.api/request-render "clear-edition-mode")))))
+ ptk/WatchEvent
+ (watch [_ _ _]
+ (if (some? @path-id)
+ (rx/of (dwpc/finish-path))
+ (rx/empty)))
+ ptk/EffectEvent
+ (effect [_ state _]
+ (when (features/active-feature? state "text-editor-wasm/v1")
+ ;; NOTE: the WASM text editor is disposed by the v3 editor component on
+ ;; unmount, *after* it finalizes its content.
+ (wasm.api/request-render "clear-edition-mode"))))))
diff --git a/frontend/src/app/main/data/workspace/path.cljs b/frontend/src/app/main/data/workspace/path.cljs
index 8948147c02..bd0f469a7a 100644
--- a/frontend/src/app/main/data/workspace/path.cljs
+++ b/frontend/src/app/main/data/workspace/path.cljs
@@ -7,6 +7,7 @@
(ns app.main.data.workspace.path
(:require
[app.common.data.macros :as dm]
+ [app.main.data.workspace.path.clipboard :as clipboard]
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.edition :as edition]
[app.main.data.workspace.path.selection :as selection]
@@ -19,31 +20,59 @@
(dm/export drawing/close-path-drag-start)
(dm/export drawing/change-edit-mode)
(dm/export drawing/reset-last-handler)
+(dm/export drawing/on-draw-node-pointer-down)
+(dm/export drawing/on-draw-segment-pointer-down)
+(dm/export drawing/start-move-prev-handler)
;; Edition
(dm/export edition/start-move-handler)
(dm/export edition/start-move-path-point)
+(dm/export edition/start-move-path-segment)
(dm/export edition/start-path-edit)
(dm/export edition/create-node-at-position)
(dm/export edition/move-selected)
+;; Clipboard
+(dm/export clipboard/copy-selected-nodes)
+(dm/export clipboard/cut-selected-nodes)
+(dm/export clipboard/paste-nodes)
+(dm/export clipboard/duplicate-selected)
+
;; Selection
(dm/export selection/handle-area-selection)
(dm/export selection/select-node)
+(dm/export selection/select-segment)
+(dm/export selection/select-handler)
(dm/export selection/path-handler-enter)
(dm/export selection/path-handler-leave)
+(dm/export selection/path-segment-enter)
+(dm/export selection/path-segment-leave)
(dm/export selection/path-pointer-enter)
(dm/export selection/path-pointer-leave)
+(dm/export selection/select-all-nodes)
+(dm/export selection/deselect-all)
;; Path tools
(dm/export tools/make-curve)
(dm/export tools/make-corner)
(dm/export tools/add-node)
(dm/export tools/remove-node)
+(dm/export tools/delete-selected)
+(dm/export tools/delete-selected-with-segments)
(dm/export tools/merge-nodes)
(dm/export tools/join-nodes)
(dm/export tools/separate-nodes)
(dm/export tools/toggle-snap)
+(dm/export tools/set-handler-type)
+(dm/export tools/toggle-node-curve)
+(dm/export tools/toggle-segment-curve)
+(dm/export tools/remove-segment)
+(dm/export tools/remove-node-with-segments)
+(dm/export tools/remove-handler)
+(dm/export tools/flip-nodes)
+(dm/export tools/align-nodes)
+(dm/export tools/distribute-nodes)
+(dm/export tools/set-selection-coordinate)
;; Undo/redo
(dm/export undo/undo-path)
diff --git a/frontend/src/app/main/data/workspace/path/changes.cljs b/frontend/src/app/main/data/workspace/path/changes.cljs
index 5680b9402f..60de534111 100644
--- a/frontend/src/app/main/data/workspace/path/changes.cljs
+++ b/frontend/src/app/main/data/workspace/path/changes.cljs
@@ -6,86 +6,57 @@
(ns app.main.data.workspace.path.changes
(:require
- [app.common.data.macros :as dm]
[app.common.files.changes-builder :as pcb]
[app.common.types.path :as path]
[app.main.data.changes :as dch]
[app.main.data.helpers :as dsh]
- [app.main.data.workspace.path.state :as st]
+ [app.main.data.workspace.shapes :as dwsh]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
-(defn generate-path-changes
- "Generates changes to update the new content of the shape"
- [it objects page-id shape old-content new-content]
+(defn- normalize-content
+ "Normalizes path content for persistence."
+ [content preserve-move-to]
+ (-> (if (and (not preserve-move-to)
+ (= (-> content last :command) :move-to))
+ (take (dec (count content)) content)
+ content)
+ (path/close-loops)))
- (assert (path/content? old-content))
- (assert (path/content? new-content))
-
- (let [shape-id (:id shape)
-
- ;; We set the old values so the update-shapes works
- objects
- (update objects shape-id
- (fn [shape]
- (-> shape
- (assoc :content old-content)
- (path/update-geometry))))
-
- changes
- (-> (pcb/empty-changes it page-id)
- (pcb/with-objects objects))
-
- new-content
- (path/content new-content)]
-
- (cond
- ;; https://tree.taiga.io/project/penpot/issue/2366
- (nil? shape-id)
- changes
-
- (empty? new-content)
- (-> changes
- (pcb/remove-objects [shape-id])
- (pcb/resize-parents [shape-id]))
-
- :else
- (-> changes
- (pcb/update-shapes [shape-id]
- (fn [shape]
- (-> shape
- (assoc :content new-content)
- (path/update-geometry))))
- (pcb/resize-parents [shape-id])))))
-
-(defn save-path-content
- ([]
- (save-path-content {}))
- ([{:keys [preserve-move-to] :or {preserve-move-to false}}]
- (ptk/reify ::save-path-content
- ptk/UpdateEvent
- (update [_ state]
- (let [content (st/get-path state :content)
- content (if (and (not preserve-move-to)
- (= (-> content last :command) :move-to))
- (path/content (take (dec (count content)) content))
- (path/content content))]
- (st/set-content state content)))
-
- ptk/WatchEvent
- (watch [it state _]
- (let [page-id (:current-page-id state)
- local (get state :workspace-local)
- id (get local :edition)
- objects (dsh/lookup-page-objects state page-id)]
-
- ;; NOTE: we proceed only if the shape is present on the
- ;; objects, if shape is a ephimeral drawing shape, we should
- ;; do nothing
- (when-let [shape (get objects id)]
- (when-let [old-content (dm/get-in local [:edit-path id :old-content])]
- (let [new-content (get shape :content)
- changes (generate-path-changes it objects page-id shape old-content new-content)]
- (rx/of (dch/commit-changes changes))))))))))
+(defn finalize-path-content
+ [id]
+ (ptk/reify ::finalize-path-content
+ ptk/WatchEvent
+ (watch [it state _]
+ (let [page-id (:current-page-id state)
+ objects (dsh/lookup-page-objects state page-id)
+ shape (get objects id)
+ old-content (get-in state [:workspace-local :edit-path id :old-content])
+ edit-content (get-in state [:workspace-drawing :object :content])
+ new-content (some-> edit-content (normalize-content false))]
+ (cond
+ ;; Ignore differences introduced only by normalization.
+ (or (nil? shape)
+ (nil? old-content)
+ (nil? edit-content)
+ (= old-content edit-content)
+ (= (path/close-loops old-content) new-content))
+ (rx/empty)
+ (empty? new-content)
+ (let [changes (-> (pcb/empty-changes it page-id)
+ (pcb/with-objects objects)
+ (pcb/remove-objects [id])
+ (pcb/resize-parents [id]))]
+ (rx/of (dch/commit-changes changes)))
+ :else
+ (rx/of
+ (dwsh/update-shapes
+ [id]
+ (fn [shape]
+ (-> shape
+ (path/convert-to-path)
+ (assoc :content new-content)
+ (path/update-geometry)))
+ {:reg-objects? true})))))))
diff --git a/frontend/src/app/main/data/workspace/path/clipboard.cljs b/frontend/src/app/main/data/workspace/path/clipboard.cljs
new file mode 100644
index 0000000000..a98cea1037
--- /dev/null
+++ b/frontend/src/app/main/data/workspace/path/clipboard.cljs
@@ -0,0 +1,209 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+(ns app.main.data.workspace.path.clipboard
+ (:require
+ [app.common.data.macros :as dm]
+ [app.common.geom.point :as gpt]
+ [app.common.math :as mth]
+ [app.common.transit :as t]
+ [app.common.types.path :as path]
+ [app.main.data.helpers :as dsh]
+ [app.main.data.workspace.path.common :as common]
+ [app.main.data.workspace.path.drawing :as drawing]
+ [app.main.data.workspace.path.edition :as edition]
+ [app.main.data.workspace.path.helpers :as helpers]
+ [app.main.data.workspace.path.state :as st]
+ [app.main.data.workspace.path.tools :as tools]
+ [app.main.data.workspace.shapes :as dwsh]
+ [app.main.streams :as ms]
+ [app.util.clipboard :as clipboard]
+ [beicon.v2.core :as rx]
+ [potok.v2.core :as ptk]))
+
+(def ^:private clipboard-type :copied-path-content)
+
+(defn- on-clipboard-error
+ [cause]
+ (js/console.error "clipboard blocked:" cause)
+ (rx/empty))
+
+(defn copy-selected-nodes
+ "Copies the selected path content to the clipboard."
+ []
+ (ptk/reify ::copy-selected-nodes
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ fragment (some-> content (path/extract-content selection))]
+ (when (seq fragment)
+ (let [data (t/encode-str {:type clipboard-type
+ :content fragment}
+ {:type :json-verbose})]
+ (->> (rx/from (clipboard/to-clipboard data))
+ (rx/catch on-clipboard-error)
+ (rx/ignore))))))))
+
+(defn cut-selected-nodes
+ "Copies and removes the current path selection."
+ []
+ (ptk/reify ::cut-selected-nodes
+ ptk/WatchEvent
+ (watch [_ _ _]
+ (rx/of (copy-selected-nodes)
+ (tools/delete-selected)))))
+
+(def ^:private paste-offset (gpt/point 10 10))
+
+(defn- collision-step
+ "Returns the non-negative paste-offset step that makes two nodes coincide."
+ [pasted existing]
+ (let [delta (gpt/subtract existing pasted)
+ x-step (/ (:x delta) (:x paste-offset))
+ y-step (/ (:y delta) (:y paste-offset))]
+ (when (and (not (neg? x-step))
+ (= x-step y-step)
+ (= x-step (mth/floor x-step)))
+ (long x-step))))
+
+(defn- available-offset-step
+ "Returns the first paste-offset step with no node collisions."
+ [existing pasted]
+ (let [blocked
+ (reduce
+ (fn [blocked pasted-point]
+ (reduce
+ (fn [blocked existing-point]
+ (if-let [step (collision-step pasted-point existing-point)]
+ (conj blocked step)
+ blocked))
+ blocked
+ existing))
+ #{}
+ pasted)]
+ ;; At most (count blocked) non-negative steps can be unavailable.
+ (some #(when-not (contains? blocked %) %)
+ (range (inc (count blocked))))))
+
+(defn- center-content-at
+ "Centers `sub-content` on `target` using its node bounds."
+ [sub-content target]
+ (let [pts (path/get-points sub-content)
+ xs (map :x pts)
+ ys (map :y pts)
+ center (gpt/point (/ (+ (reduce min xs) (reduce max xs)) 2)
+ (/ (+ (reduce min ys) (reduce max ys)) 2))]
+ (path/move-content sub-content (gpt/subtract target center))))
+
+(defn- offset-pasted-content
+ "Offsets pasted content until its nodes do not overlap existing nodes."
+ [content sub-content]
+ (let [existing (into #{} (path/get-points content))
+ pasted (path/get-points sub-content)
+ step (available-offset-step existing pasted)]
+ (if (zero? step)
+ sub-content
+ (path/move-content sub-content (gpt/scale paste-offset step)))))
+
+(defn paste-content
+ "Pastes path content into the edited path at the pointer."
+ [sub-content]
+ (ptk/reify ::paste-content
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (if (and (some? id)
+ (some? (dm/get-in state [:workspace-local :edit-path id]))
+ (seq sub-content))
+ (let [content (st/get-path state :content)
+ base (count content)
+ target (deref ms/mouse-position)
+ ;; Center the fragment at the pointer.
+ sub-content (cond-> sub-content
+ (some? target) (center-content-at target))
+ sub-content (offset-pasted-content content sub-content)
+ new-content (path/splice-content content sub-content)
+ pasted (into #{}
+ (map #(+ base %))
+ (helpers/node-indices sub-content))]
+ (-> state
+ (st/set-content new-content)
+ (update-in (st/get-path-location state) path/update-geometry)
+ (assoc-in [:workspace-local :edit-path id :selection]
+ (assoc helpers/empty-selection :nodes pasted))))
+ state)))
+
+ ptk/WatchEvent
+ (watch [_ state _]
+ ;; Enter move mode with the pasted nodes selected.
+ (when (some? (dm/get-in state [:workspace-local :edition]))
+ (rx/of (drawing/change-edit-mode :move))))))
+
+(defn paste-nodes-as-shape
+ "Creates a path shape from copied content at the pointer."
+ [sub-content]
+ (ptk/reify ::paste-nodes-as-shape
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [content (path/content sub-content)
+ id (st/get-path-id state)
+ editing? (and (some? id)
+ (some? (dm/get-in state [:workspace-local :edit-path id])))]
+ (when (and (not editing?) (seq (path/get-points content)))
+ (let [target (or (deref ms/mouse-position)
+ (dsh/get-viewport-center state))
+ moved (center-content-at content target)
+ mrect (path/calc-selrect moved)]
+ (rx/of
+ (dwsh/create-and-add-shape
+ :path (:x target) (:y target)
+ {:content moved
+ ;; Keep the shape at the content position.
+ :x (:x mrect)
+ :y (:y mrect)
+ :width (:width mrect)
+ :height (:height mrect)
+ :name "Path"}))))))))
+
+(defn paste-nodes
+ "Pastes copied path content into the edited path."
+ []
+ (ptk/reify ::paste-nodes
+ ptk/WatchEvent
+ (watch [_ _ _]
+ (->> (clipboard/from-navigator)
+ (rx/filter #(= (.-type ^js %) "application/transit+json"))
+ (rx/mapcat #(rx/from (.text ^js %)))
+ (rx/map t/decode-str)
+ (rx/filter #(and (map? %) (= clipboard-type (:type %))))
+ (rx/take 1)
+ (rx/mapcat (fn [{:keys [content]}]
+ ;; Drop a pending segment before splicing.
+ (rx/of (common/cancel-pending-segment)
+ (paste-content content))))
+ (rx/catch on-clipboard-error)))))
+
+(defn duplicate-selected
+ "Duplicates the current node and segment selection."
+ []
+ (ptk/reify ::duplicate-selected
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ result (helpers/duplicate-selection-content
+ content selection (edition/duplicate-offset zoom))]
+ (when (seq (:sub result))
+ (rx/concat
+ ;; Drop a pending segment before splicing.
+ (rx/of (common/cancel-pending-segment)
+ (edition/splice-duplicated result))
+ (when (some? (dm/get-in state [:workspace-local :edition]))
+ (rx/of (drawing/change-edit-mode :move)))))))))
diff --git a/frontend/src/app/main/data/workspace/path/common.cljs b/frontend/src/app/main/data/workspace/path/common.cljs
index cfb59be0a8..2cae10ec70 100644
--- a/frontend/src/app/main/data/workspace/path/common.cljs
+++ b/frontend/src/app/main/data/workspace/path/common.cljs
@@ -17,6 +17,23 @@
[state]
(dissoc state :last-point :prev-handler :drag-handler :preview))
+(defn- drop-trailing-move-to
+ "Drops a trailing subpath start without segments."
+ [content]
+ (if (= :move-to (-> content last :command))
+ (path/content (take (dec (count content)) content))
+ content))
+
+(defn- update-object-content
+ [state f]
+ (let [location (st/get-path-location state)
+ object (get-in state location)
+ content (some-> (:content object) f)]
+ (cond-> state
+ (some? content)
+ (assoc-in location (cond-> (assoc object :content content)
+ (seq content) (path/update-geometry))))))
+
(defn finish-path
[]
(ptk/reify ::finish-path
@@ -25,4 +42,15 @@
(let [id (st/get-path-id state)]
(-> state
(update-in [:workspace-local :edit-path id] clean-edit-state)
- (update-in (st/get-path-location state :content) path/close-subpaths))))))
+ (update-object-content (comp path/close-subpaths drop-trailing-move-to)))))))
+
+(defn cancel-pending-segment
+ "Cancels the pending segment without leaving draw mode."
+ []
+ (ptk/reify ::cancel-pending-segment
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (-> state
+ (update-in [:workspace-local :edit-path id] clean-edit-state)
+ (update-object-content drop-trailing-move-to))))))
diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs
index 4caa22959a..384b8f00fe 100644
--- a/frontend/src/app/main/data/workspace/path/drawing.cljs
+++ b/frontend/src/app/main/data/workspace/path/drawing.cljs
@@ -20,13 +20,14 @@
[app.main.data.workspace.drawing.common :as dwdc]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.pages :as-alias dwpg]
- [app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
+ [app.main.data.workspace.path.edition :as edition]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
+ [app.main.data.workspace.path.tools :as tools]
[app.main.data.workspace.path.undo :as undo]
- [app.main.data.workspace.shapes :as dwsh]
+ [app.main.streams :as ms]
[app.util.mouse :as mse]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@@ -35,36 +36,75 @@
(declare check-changed-content)
(declare change-edit-mode)
-(defn- end-path-event?
+(defn start-created-path-edition
+ [id]
+ (ptk/reify ::start-created-path-edition
+ ptk/WatchEvent
+ (watch [_ _ _]
+ (rx/of (dwe/start-edition-mode id)
+ (edition/start-path-edit id)
+ (change-edit-mode :draw)))))
+
+;; Draw-loop stop signals either restart the same path or exit drawing.
+
+(defn restart-draw-loop?
+ "True when drawing restarts on the same path."
+ [event]
+ (or (= (ptk/type event) ::common/finish-path)
+ (and ^boolean (mse/mouse-event? event)
+ ^boolean (mse/mouse-double-click-event? event))))
+
+(defn- exit-draw-loop?
+ "True when the draw loop exits."
[event]
(let [type (ptk/type event)]
- (or
- (= type ::common/finish-path)
- (= type :app.main.data.workspace.path.shortcuts/esc-pressed)
- (= type :app.main.data.workspace.common/clear-edition-mode)
- (= type :app.main.data.workspace.edition/clear-edition-mode)
- (= type ::dwpg/finalize-page)
- (= event :interrupt) ;; ESC
- (and ^boolean (mse/mouse-event? event)
- ^boolean (mse/mouse-double-click-event? event)))))
+ (or (= type ::dwe/clear-edition-mode)
+ (= type ::dwpg/finalize-page)
+ (dwe/interrupt? event))))
+
+(defn- end-path-event?
+ "True when the draw loop should stop."
+ [event]
+ (or (restart-draw-loop? event)
+ (exit-draw-loop? event)))
+
+(def ^:private draw-insert-threshold
+ "Maximum screen distance for inserting a node on a segment."
+ 16)
(defn preview-next-point
[{:keys [x y shift?]}]
(ptk/reify ::preview-next-point
ptk/UpdateEvent
(update [_ state]
- (let [id (st/get-path-id state)
- fix-angle? shift?
- last-point (get-in state [:workspace-local :edit-path id :last-point])
- position (cond-> (gpt/point x y)
- fix-angle? (path.helpers/position-fixed-angle last-point))
- content (st/get-path state :content)
+ (let [id (st/get-path-id state)
+ edit-path (get-in state [:workspace-local :edit-path id])]
+ ;; Freeze the next-point preview during modifier drags.
+ (if (seq (:content-modifiers edit-path))
+ state
+ (let [fix-angle? shift?
+ {:keys [last-point prev-handler]} edit-path
+ content (st/get-path state :content)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ raw-pos @ms/mouse-position
- {:keys [last-point prev-handler]}
- (get-in state [:workspace-local :edit-path id])
+ ;; Segment insertion uses the exact on-curve preview point.
+ insert-point (when (and (seq (:segments (:hover edit-path)))
+ (gpt/point? raw-pos))
+ (helpers/insertion-point
+ content raw-pos (/ draw-insert-threshold zoom) true))
- segment (path/next-node content position last-point prev-handler)]
- (assoc-in state [:workspace-local :edit-path id :preview] segment)))))
+ position (cond
+ (some? insert-point)
+ insert-point
+
+ fix-angle?
+ (path.helpers/position-fixed-angle (gpt/point x y) last-point)
+
+ :else
+ (gpt/point x y))
+ segment (path/next-node content position last-point prev-handler)]
+ (assoc-in state [:workspace-local :edit-path id :preview] segment)))))))
(defn add-node
[{:keys [x y shift?]}]
@@ -141,34 +181,84 @@
(rx/of (preview-next-point handler)
(undo/merge-head))))))
-(defn close-path-drag-start
- [position]
- (ptk/reify ::close-path-drag-start
+(defn drag-prev-handler
+ "Moves the current node's forward handle while drawing."
+ [{:keys [x y alt? shift?]}]
+ (ptk/reify ::drag-prev-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ index (count content)
+ position (path.helpers/segment->point (nth content (dec index)))
+
+ handler-position
+ (cond-> (gpt/point x y)
+ shift? (path.helpers/position-fixed-angle position))
+
+ dx (- (:x handler-position) (:x position))
+ dy (- (:y handler-position) (:y position))
+
+ ;; Alt leaves the opposite handle unchanged.
+ rejoin? (not alt?)
+
+ modifiers (helpers/move-handler-modifiers content index :c1 false false rejoin? dx dy)]
+ (-> state
+ (update-in [:workspace-local :edit-path id] dissoc :prev-handler)
+ (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers)
+ (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position))))))
+
+(defn start-move-prev-handler
+ "Starts dragging the current node's forward handle."
+ []
+ (ptk/reify ::start-move-prev-handler
ptk/WatchEvent
(watch [_ state stream]
- (let [content (st/get-path state :content)
- handlers (-> (path/get-handlers content)
- (get position))
+ (let [stopper (rx/merge
+ (mse/drag-stopper stream)
+ (rx/filter end-path-event? stream))
- [idx prefix] (when (= (count handlers) 1)
- (first handlers))
-
- drag-events-stream
+ drag-events
(->> (streams/position-stream state)
- (rx/map #(drag-handler position idx prefix %))
- (rx/take-until
- (rx/merge
- (mse/drag-stopper stream)
- (rx/filter end-path-event? stream))))]
+ (rx/map drag-prev-handler)
+ (rx/take-until stopper))]
+ (streams/drag-stream
+ (rx/concat
+ (rx/of (edition/set-drag-cursor "move-handles"))
+ drag-events
+ (rx/of (finish-drag))))))))
- (rx/concat
- (rx/of (add-node position))
- (streams/drag-stream
- (rx/concat
- drag-events-stream
- (rx/of (finish-drag))
- (rx/of (close-path-drag-end))))
- (rx/of (common/finish-path)))))))
+(defn close-path-drag-start
+ ([position]
+ (close-path-drag-start position "draw-node"))
+ ([position cursor]
+ (ptk/reify ::close-path-drag-start
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [content (st/get-path state :content)
+ handlers (-> (path/get-handlers content)
+ (get position))
+
+ [idx prefix] (when (= (count handlers) 1)
+ (first handlers))
+
+ drag-events-stream
+ (->> (streams/position-stream state)
+ (rx/map #(drag-handler position idx prefix %))
+ (rx/take-until
+ (rx/merge
+ (mse/drag-stopper stream)
+ (rx/filter end-path-event? stream))))]
+
+ (rx/concat
+ (rx/of (add-node position))
+ (streams/drag-stream
+ (rx/concat
+ (rx/of (edition/set-drag-cursor cursor))
+ drag-events-stream
+ (rx/of (finish-drag))
+ (rx/of (close-path-drag-end))))
+ (rx/of (common/finish-path))))))))
(defn close-path-drag-end []
(ptk/reify ::close-path-drag-end
@@ -177,30 +267,27 @@
(let [id (st/get-path-id state)]
(update-in state [:workspace-local :edit-path id] dissoc :prev-handler)))))
-(defn start-path-from-point [position]
- (ptk/reify ::start-path-from-point
- ptk/WatchEvent
- (watch [_ state stream]
- (let [stopper (rx/merge
- (mse/drag-stopper stream)
- (rx/filter end-path-event? stream))
+(defn start-path-from-point
+ ([position]
+ (start-path-from-point position "draw-node"))
+ ([position cursor]
+ (ptk/reify ::start-path-from-point
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [stopper (rx/merge
+ (mse/drag-stopper stream)
+ (rx/filter end-path-event? stream))
- drag-events (->> (streams/position-stream state)
- (rx/map #(drag-handler %))
- (rx/take-until stopper))]
- (rx/concat
- (rx/of (add-node position))
- (streams/drag-stream
- (rx/concat
- drag-events
- (rx/of (finish-drag)))))))))
-
-(defn make-node-events-stream
- [stream]
- (->> stream
- (rx/filter (ptk/type? ::close-path-drag-start))
- (rx/take 1)
- (rx/merge-map #(rx/empty))))
+ drag-events (->> (streams/position-stream state)
+ (rx/map #(drag-handler %))
+ (rx/take-until stopper))]
+ (rx/concat
+ (rx/of (add-node position))
+ (streams/drag-stream
+ (rx/concat
+ (rx/of (edition/set-drag-cursor cursor))
+ drag-events
+ (rx/of (finish-drag))))))))))
(defn make-drag-stream
[state stream down-event]
@@ -229,7 +316,12 @@
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (assoc-in state [:workspace-local :edit-path id :edit-mode] :draw)))
+ (update-in state [:workspace-local :edit-path id]
+ (fn [edit-state]
+ (-> edit-state
+ (assoc :edit-mode :draw)
+ ;; Keep explicit snap choices across draw restarts.
+ (update :snap-toggled (fnil identity true)))))))
ptk/WatchEvent
(watch [_ state stream]
@@ -243,26 +335,29 @@
(rx/filter end-path-event?)
(rx/share))
+ stop-event
+ (volatile! nil)
+
stoper-stream
(->> stream
(rx/filter (ptk/type? ::start-edition))
- (rx/merge end-stream))
+ (rx/merge end-stream)
+ (rx/tap #(vreset! stop-event %))
+ (rx/share))
;; Mouse move preview
mousemove-events
(->> (streams/position-stream state)
(rx/map #(preview-next-point %)))
- ;; From mouse down we can have: click, drag and double click
+ ;; Viewport clicks add nodes; node clicks handle closing separately.
mousedown-events
(->> mouse-down
;; We just ignore the mouse event and stream down the
;; last position event
(rx/with-latest-from #(-> %2) (streams/position-stream state))
- ;; We change to the stream that emits the first event
(rx/switch-map
- #(rx/race (make-node-events-stream stream)
- (make-drag-stream state stream %)))
+ #(make-drag-stream state stream %))
(rx/take-until end-stream))]
(->> (rx/concat
@@ -270,7 +365,11 @@
(->> (rx/merge mousemove-events
mousedown-events)
(rx/take-until stoper-stream))
- (rx/of (ptk/data-event ::end-edition))))))))
+ (->> (rx/of nil)
+ (rx/map (fn [_]
+ (ptk/data-event
+ ::end-edition
+ {:restart? (restart-draw-loop? @stop-event)}))))))))))
(defn setup-frame
[]
@@ -299,8 +398,20 @@
(cond-> (some? drop-index)
(with-meta {:index drop-index})))))))))
+(defn- close-drawn-loops
+ "Adds explicit close commands to completed loops."
+ []
+ (ptk/reify ::close-drawn-loops
+ ptk/UpdateEvent
+ (update [_ state]
+ (d/update-in-when state [:workspace-drawing :object]
+ (fn [object]
+ (-> object
+ (update :content path/close-loops)
+ (path/update-geometry)))))))
+
(defn- handle-drawing-end
- [shape-id]
+ [shape-id restart?]
(ptk/reify ::handle-drawing-end
ptk/UpdateEvent
(update [_ state]
@@ -313,15 +424,26 @@
ptk/WatchEvent
(watch [_ state _]
(when-let [content (dm/get-in state [:workspace-drawing :object :content])]
- (if (> (count content) 1)
- (rx/of (setup-frame)
+ (cond
+ (and (> (count content) 1) restart?)
+ (rx/of (common/finish-path)
+ (close-drawn-loops)
+ (setup-frame)
(dwdc/handle-finish-drawing)
- (dwe/start-edition-mode shape-id)
- (change-edit-mode :draw))
- (rx/of (dwdc/handle-finish-drawing)))))))
+ (start-created-path-edition shape-id))
+
+ (> (count content) 1)
+ (rx/of (close-drawn-loops)
+ (setup-frame)
+ (dwdc/handle-finish-drawing)
+ (dwe/clear-edition-mode))
+
+ :else
+ (rx/of (dwdc/handle-finish-drawing)
+ (dwe/clear-edition-mode)))))))
(defn handle-drawing
- "Hanndle the start of drawing new path shape"
+ "Starts drawing a path."
[]
(ptk/reify ::handle-new-shape
ptk/UpdateEvent
@@ -337,8 +459,10 @@
(->> stream
(rx/filter (ptk/type? ::end-edition))
(rx/take 1)
+ ;; Let the stop event settle before finishing the drawing.
(rx/observe-on :async)
- (rx/map (partial handle-drawing-end shape-id))))))))
+ (rx/map (fn [event]
+ (handle-drawing-end shape-id (:restart? (deref event)))))))))))
(declare start-draw-mode*)
@@ -347,12 +471,22 @@
(ptk/reify ::start-draw-mode
ptk/UpdateEvent
(update [_ state]
- (let [id (dm/get-in state [:workspace-local :edition])
- objects (dsh/lookup-page-objects state)
- content (dm/get-in objects [id :content])]
- (if content
- (update-in state [:workspace-local :edit-path id] assoc :old-content content)
- state)))
+ (let [id (dm/get-in state [:workspace-local :edition])
+ objects (dsh/lookup-page-objects state)
+ shape (get objects id)
+ drawing (dm/get-in state [:workspace-drawing :object])
+ old-content (dm/get-in state [:workspace-local :edit-path id :old-content])
+ drawing (or drawing
+ (some-> shape
+ (path/convert-to-path objects)
+ (update :content path/close-subpaths)
+ (path/update-geometry)))]
+ (cond-> state
+ drawing
+ (assoc-in [:workspace-drawing :object] drawing)
+
+ (and drawing (nil? old-content))
+ (assoc-in [:workspace-local :edit-path id :old-content] (:content drawing)))))
ptk/WatchEvent
(watch [_ _ _]
@@ -369,23 +503,52 @@
(if (= :draw mode)
(rx/concat
- (rx/of (dwsh/update-shapes [id] path/convert-to-path))
(rx/of (start-edition id))
(->> stream
(rx/filter (ptk/type? ::end-edition))
(rx/take 1)
- (rx/mapcat (fn [_]
- (rx/of (check-changed-content)
- (start-draw-mode*))))))
+ (rx/mapcat (fn [event]
+ (if (:restart? (deref event))
+ (rx/of (common/finish-path)
+ (check-changed-content)
+ (start-draw-mode*))
+ (rx/empty))))))
(rx/empty))))))
+(defn- enter-draw-from-selected-node
+ "Starts a new segment from the only selected node."
+ [state id]
+ (let [selection (get (st/get-selection state id) :nodes #{})
+ last-point (dm/get-in state [:workspace-local :edit-path id :last-point])
+ content (st/get-path state :content)]
+ (if (and (nil? last-point)
+ (= 1 (count selection))
+ (some? content)
+ (helpers/node? content (first selection)))
+ (let [index (first selection)
+ pos (helpers/node-position content index)
+ last-idx (dec (count content))
+ tip? (and (= index last-idx)
+ (not= :close-path (:command (nth content index nil))))
+ state (assoc-in state [:workspace-local :edit-path id :last-point] pos)]
+ (if tip?
+ state
+ (update-in state (st/get-path-location state)
+ (fn [shape]
+ (-> shape
+ (update :content path/append-segment
+ {:command :move-to :params (select-keys pos [:x :y])})
+ (path/update-geometry))))))
+ state)))
+
(defn change-edit-mode
[mode]
(ptk/reify ::change-edit-mode
ptk/UpdateEvent
(update [_ state]
(if-let [id (dm/get-in state [:workspace-local :edition])]
- (d/update-in-when state [:workspace-local :edit-path id] assoc :edit-mode mode)
+ (cond-> (d/update-in-when state [:workspace-local :edit-path id] assoc :edit-mode mode)
+ (= mode :draw) (enter-draw-from-selected-node id))
state))
ptk/WatchEvent
@@ -405,6 +568,98 @@
(let [id (st/get-path-id state)]
(assoc-in state [:workspace-local :edit-path id :prev-handler] nil)))))
+(defn on-draw-node-pointer-down
+ "Handles node clicks and drags in draw mode."
+ [index position alt? mod?]
+ (ptk/reify ::on-draw-node-pointer-down
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ node-pos (when (and (some? content)
+ (< index (count content))
+ (helpers/node? content index))
+ (helpers/node-position content index))
+ last-point (dm/get-in state [:workspace-local :edit-path id :last-point])
+ pending-origin? (and (some? node-pos) (= last-point node-pos))]
+ (cond
+ (and mod? alt?)
+ (rx/concat
+ (rx/of (tools/remove-node-with-segments index))
+ (if pending-origin?
+ (rx/of (common/cancel-pending-segment))
+ (rx/empty)))
+
+ mod?
+ (streams/drag-stream
+ (rx/of (edition/set-drag-cursor "move-handles")
+ (edition/curve-config-node-drag index))
+ (rx/of (tools/toggle-node-curve index)))
+
+ alt?
+ (if (some? node-pos)
+ (rx/concat
+ (rx/of (tools/remove-node node-pos))
+ (if pending-origin?
+ (rx/of (common/cancel-pending-segment))
+ (rx/empty)))
+ (rx/empty))
+
+ (= last-point position)
+ (rx/of (reset-last-handler))
+
+ (nil? last-point)
+ (rx/of (start-path-from-point position))
+
+ :else
+ (rx/of (close-path-drag-start position)))))))
+
+(defn on-draw-segment-pointer-down
+ "Handles segment clicks and drags in draw mode."
+ [index alt? mod?]
+ (ptk/reify ::on-draw-segment-pointer-down
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ content (st/get-path state :content)
+ position @ms/mouse-position
+ last-point (dm/get-in state [:workspace-local :edit-path id :last-point])]
+ (cond
+ alt?
+ (let [entry (d/seek #(= index (:index %)) (helpers/segment-entries content))
+ pending-here? (and (some? last-point)
+ (some? entry)
+ (or (= last-point (:from entry))
+ (= last-point (:to entry))))]
+ (rx/concat
+ (rx/of (tools/remove-segment index))
+ (if pending-here?
+ (rx/of (common/cancel-pending-segment))
+ (rx/empty))))
+
+ mod?
+ (let [entry (d/seek #(= index (:index %)) (helpers/segment-entries content))
+ bendable? (and (some? entry)
+ (not= :close-path (:command (:segment entry))))]
+ (streams/drag-stream
+ (if bendable?
+ (rx/of (edition/set-drag-cursor "move-curve")
+ (edition/bend-selected-segment index position))
+ (rx/empty))
+ (rx/of (tools/toggle-segment-curve index))))
+
+ :else
+ (let [insert-point (helpers/insertion-point
+ content position (/ draw-insert-threshold zoom) true)]
+ (if (some? insert-point)
+ (rx/concat
+ (rx/of (edition/create-node-at-position (meta insert-point)))
+ (if (some? last-point)
+ (rx/of (close-path-drag-start insert-point "draw-add"))
+ (rx/of (start-path-from-point insert-point "draw-add"))))
+ (rx/empty))))))))
+
(defn check-changed-content
[]
(ptk/reify ::check-changed-content
@@ -418,10 +673,11 @@
(cond
(and (not= content old-content) (not empty-content?))
- (rx/of (changes/save-path-content))
+ (rx/empty)
+ ;; Exit through the path edition stop event.
(= mode :draw)
- (rx/of :interrupt)
+ (rx/of (dwe/clear-edition-mode))
:else
(rx/of
diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs
index d70fff5cb6..9787108e12 100644
--- a/frontend/src/app/main/data/workspace/path/edition.cljs
+++ b/frontend/src/app/main/data/workspace/path/edition.cljs
@@ -8,10 +8,10 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
+ [app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
- [app.main.data.changes :as dch]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.path.changes :as changes]
@@ -19,32 +19,178 @@
[app.main.data.workspace.path.selection :as selection]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
+ [app.main.data.workspace.path.tools :as tools]
[app.main.data.workspace.path.undo :as undo]
- [app.main.data.workspace.shapes :as dwsh]
[app.main.streams :as ms]
+ [app.render-wasm.svg-fills :as svg-fills]
[app.util.mouse :as mse]
[beicon.v2.core :as rx]
+ [beicon.v2.operators :as rxo]
[potok.v2.core :as ptk]))
-(defn modify-handler [id index prefix dx dy match-opposite?]
- (ptk/reify ::modify-handler
+(defn- handler-modifier-delta
+ [modifiers index prefix]
+ (let [[cx cy] (path.helpers/prefix->coords prefix)]
+ (gpt/point (dm/get-in modifiers [index cx] 0)
+ (dm/get-in modifiers [index cy] 0))))
+
+(defn- remove-handler-modifier
+ [modifiers [index prefix]]
+ (let [[cx cy] (path.helpers/prefix->coords prefix)
+ modifiers (update modifiers index dissoc cx cy)]
+ (cond-> modifiers
+ (empty? (get modifiers index)) (dissoc index))))
+
+(defn- stored-handler-drag-mode
+ "Returns a handler's stored drag mode, ignoring stale mirror state."
+ [content handler-types index prefix]
+ (case (get handler-types (helpers/handler-node-index index prefix))
+ :mirror (if (helpers/handlers-joined? content index prefix)
+ :mirror
+ :smart)
+ :aligned :aligned
+ :independent :independent
+ :smart))
+
+(defn- active-selected-handlers
+ "Returns valid handlers for the current drag."
+ [content primary selected-handlers move-selection?]
+ (let [handlers (if move-selection? selected-handlers #{primary})
+ handlers (into #{}
+ (filter (fn [[index _]]
+ (= :curve-to (:command (nth content index nil)))))
+ handlers)]
+ (cond-> handlers
+ (empty? handlers) (conj primary))))
+
+(defn- handler-drag-modifiers
+ "Returns modifiers for one dragged handler."
+ [content handler-types selected-handlers start-modifiers move-delta mode
+ move-selection? [index prefix]]
+ (let [start-delta (handler-modifier-delta start-modifiers index prefix)
+ delta (gpt/add start-delta move-delta)
+ opposite-id (path/opposite-index content index prefix)
+ opposite-selected? (and move-selection?
+ (contains? selected-handlers opposite-id))
+ joined? (helpers/handlers-joined? content index prefix)
+ handler-mode (if move-selection?
+ (stored-handler-drag-mode
+ content handler-types index prefix)
+ mode)
+ modifiers (case handler-mode
+ :aligned
+ (helpers/align-handler-modifiers
+ content index prefix (:x delta) (:y delta))
+
+ :mirror
+ (helpers/move-handler-modifiers
+ content index prefix true true true (:x delta) (:y delta))
+
+ :independent
+ (helpers/move-handler-modifiers
+ content index prefix false false false (:x delta) (:y delta))
+
+ (helpers/move-handler-modifiers
+ content index prefix false
+ (and joined? (not opposite-selected?))
+ false (:x delta) (:y delta)))]
+ (cond-> modifiers
+ opposite-selected? (remove-handler-modifier opposite-id))))
+
+(defn- selected-handler-modifiers
+ "Combines modifiers for all dragged handlers."
+ [content handler-types selected-handlers start-modifiers move-delta mode move-selection?]
+ (reduce
+ (fn [modifiers handler-id]
+ (d/deep-merge
+ modifiers
+ (handler-drag-modifiers
+ content handler-types selected-handlers start-modifiers move-delta
+ mode move-selection? handler-id)))
+ {}
+ selected-handlers))
+
+(defn- transient-prev-handler
+ "Returns the mirrored transient drawing handler."
+ [content [index prefix] handler-mode moving-handler edit-mode prev-handler]
+ (when (and (= edit-mode :draw)
+ (= prefix :c2)
+ (= index (dec (count content)))
+ (some? prev-handler)
+ (not= handler-mode :independent))
+ (let [node (path/handler->node content index prefix)
+ mode (if (= handler-mode :mirror) :mirror :aligned)]
+ (helpers/opposite-handler-target node moving-handler prev-handler mode))))
+
+(defn modify-selected-handlers
+ "Moves selected handlers using each node's handler mode."
+ [id primary start-modifiers dx dy mode move-selection?]
+ (ptk/reify ::modify-selected-handlers
ptk/UpdateEvent
(update [_ state]
-
- (let [content (st/get-path state :content)
- modifiers (helpers/move-handler-modifiers content index prefix false match-opposite? dx dy)
- [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])
- point (gpt/point (+ (dm/get-in content [index :params cx]) dx)
- (+ (dm/get-in content [index :params cy]) dy))]
-
+ (let [content (st/get-path state :content)
+ handler-types (dm/get-in state
+ [:workspace-local :edit-path id :handler-types]
+ {})
+ selected-handlers (active-selected-handlers
+ content primary
+ (dm/get-in state
+ [:workspace-local :edit-path id :selection :handlers]
+ #{})
+ move-selection?)
+ move-delta (gpt/point dx dy)
+ moved-modifiers (selected-handler-modifiers
+ content handler-types selected-handlers start-modifiers
+ move-delta mode move-selection?)
+ modifiers (d/deep-merge start-modifiers moved-modifiers)
+ [primary-index primary-prefix] primary
+ primary-mode (if move-selection?
+ (stored-handler-drag-mode
+ content handler-types primary-index primary-prefix)
+ mode)
+ primary-handler (path/get-handler-point content primary-index primary-prefix)
+ primary-delta (gpt/add
+ (handler-modifier-delta start-modifiers
+ primary-index
+ primary-prefix)
+ move-delta)
+ moving-handler (gpt/add primary-handler primary-delta)
+ edit-mode (dm/get-in state [:workspace-local :edit-path id :edit-mode])
+ prev-handler (dm/get-in state [:workspace-local :edit-path id :prev-handler])
+ new-prev-handler (transient-prev-handler
+ content primary primary-mode moving-handler
+ edit-mode prev-handler)]
(-> state
- (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers)
- (assoc-in [:workspace-local :edit-path id :moving-handler] point))))))
+ (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers)
+ (assoc-in [:workspace-local :edit-path id :moving-handler] moving-handler)
+ (cond-> (some? new-prev-handler)
+ (assoc-in [:workspace-local :edit-path id :prev-handler] new-prev-handler)))))))
+
+(defn- apply-content-modifiers*
+ [id new-content]
+ (ptk/reify ::apply-content-modifiers*
+ ptk/UpdateEvent
+ (update [_ state]
+ (cond-> (-> state
+ (st/set-content new-content)
+ (update-in [:workspace-local :edit-path id]
+ dissoc
+ :content-modifiers
+ :moving-nodes
+ :moving-handler))
+ (seq new-content)
+ (update-in (st/get-path-location state) path/update-geometry)))
+
+ ptk/WatchEvent
+ (watch [_ _ _]
+ ;; Moving modifiers keep node indices stable.
+ (when (empty? new-content)
+ (rx/of (dwe/clear-edition-mode))))))
(defn apply-content-modifiers []
(ptk/reify ::apply-content-modifiers
ptk/WatchEvent
- (watch [it state _]
+ (watch [_ state _]
(let [id (st/get-path-id state)
shape (st/get-path state)
@@ -52,24 +198,47 @@
(dm/get-in state [:workspace-local :edit-path id :content-modifiers])]
(if (or (nil? shape) (nil? content-modifiers))
(rx/of (dwe/clear-edition-mode))
- (let [page-id (get state :current-page-id state)
- objects (dsh/lookup-page-objects state)
+ (let [content (get shape :content)
+ new-content (path/apply-content-modifiers content content-modifiers)]
+ (when (some? new-content)
+ (rx/of (apply-content-modifiers* id new-content)))))))))
- content (get shape :content)
- new-content (path/apply-content-modifiers content content-modifiers)
+(def ^:private merge-drop-distance
+ "Maximum screen distance for merging dropped nodes."
+ 10)
- old-points (path/get-points content)
- new-points (path/get-points new-content)
- point-change (->> (map hash-map old-points new-points) (reduce merge))]
+(defn merge-dragged-on-drop
+ "Merges the closest moved and stationary nodes after a drag."
+ []
+ (ptk/reify ::merge-dragged-on-drop
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
- (when (and (some? new-content) (some? shape))
- (let [changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
- (if (empty? new-content)
- (rx/of (dch/commit-changes changes)
- (dwe/clear-edition-mode))
- (rx/of (dch/commit-changes changes)
- (selection/update-selection point-change)
- (fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers :moving-nodes :moving-handler))))))))))))
+ ;; Include endpoints of selected segments.
+ moved-indices (into (get selection :nodes #{})
+ (helpers/segment-node-indices content (get selection :segments #{})))
+ moved (helpers/node-positions content moved-indices)
+ moved-set (set moved)
+
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ threshold (/ merge-drop-distance zoom)
+ others (remove moved-set (path/get-points content))
+
+ pairs (->> moved
+ (keep (fn [p]
+ (let [near (filter #(<= (gpt/distance % p) threshold) others)]
+ (when (seq near)
+ (let [t (apply min-key #(gpt/distance % p) near)]
+ [p t (gpt/distance t p)]))))))
+ best (when (seq pairs)
+ (apply min-key #(nth % 2) pairs))]
+ (if (some? best)
+ (let [[p t _] best]
+ (rx/of (tools/process-path-tool #{p t} path/merge-nodes)))
+ (rx/empty))))))
(defn modify-content-point
[content {dx :x dy :y} modifiers point]
@@ -93,59 +262,184 @@
(reduce modify-handler $ handler-indices))))
(defn set-move-modifier
- [points move-modifier]
+ "Adds a move delta for selected nodes and handlers."
+ [points handler-ids move-modifier]
(ptk/reify ::set-modifiers
ptk/UpdateEvent
(update [_ state]
- (let [id (st/get-path-id state)
+ (let [id (st/get-path-id state)
content (st/get-path state :content)
- modifiers-reducer (partial modify-content-point content move-modifier)
+ {dx :x dy :y} move-modifier
+
content-modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers] {})
- content-modifiers (->> points
- (reduce modifiers-reducer content-modifiers))]
+
+ content-modifiers
+ (->> points
+ (reduce (partial modify-content-point content move-modifier) content-modifiers))
+
+ content-modifiers
+ (->> handler-ids
+ (reduce (fn [modifiers [index prefix]]
+ (let [cx (d/prefix-keyword prefix :x)
+ cy (d/prefix-keyword prefix :y)]
+ (update modifiers index assoc cx dx cy dy)))
+ content-modifiers))]
(-> state
(assoc-in [:workspace-local :edit-path id :content-modifiers] content-modifiers))))))
+(defn- move-node-indices
+ [state node-indices from-point to-point]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ to-point (cond-> to-point
+ (:shift? to-point) (path.helpers/position-fixed-angle from-point))
+ delta (gpt/subtract to-point from-point)
+ points (helpers/node-positions content node-indices)
+ reducer (partial modify-content-point content delta)
+ modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers] {})
+ modifiers (reduce reducer modifiers points)]
+ (-> state
+ (assoc-in [:workspace-local :edit-path id :moving-nodes] true)
+ (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers))))
+
(defn move-selected-path-point [from-point to-point]
(ptk/reify ::move-point
ptk/UpdateEvent
(update [_ state]
- (let [id (st/get-path-id state)
- content (st/get-path state :content)
- to-point (cond-> to-point
- (:shift? to-point) (path.helpers/position-fixed-angle from-point))
+ (let [id (st/get-path-id state)
+ selected-nodes (dm/get-in state
+ [:workspace-local :edit-path id :selection :nodes]
+ #{})]
+ (move-node-indices state selected-nodes from-point to-point)))))
- delta (gpt/subtract to-point from-point)
+(defn move-selected-path-segment [from-point to-point]
+ (ptk/reify ::move-segment
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ node-indices (helpers/selected-node-indices content selection)]
+ (move-node-indices state node-indices from-point to-point)))))
- modifiers-reducer (partial modify-content-point content delta)
+(defn- clear-drag-cursor []
+ (ptk/reify ::clear-drag-cursor
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (d/update-in-when state [:workspace-local :edit-path id] dissoc :drag-cursor)))))
- points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
+(defn set-drag-cursor
+ "Shows `cursor` until the current drag stops."
+ [cursor]
+ (ptk/reify ::set-drag-cursor
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (d/update-in-when state [:workspace-local :edit-path id] assoc :drag-cursor cursor)))
- modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers] {})
- modifiers (->> points
- (reduce modifiers-reducer modifiers))]
-
- (-> state
- (assoc-in [:workspace-local :edit-path id :moving-nodes] true)
- (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers))))))
+ ptk/WatchEvent
+ (watch [_ _ stream]
+ (->> (rx/merge
+ (mse/drag-stopper stream)
+ (rx/filter streams/finish-edition? stream))
+ (rx/take 1)
+ (rx/map #(clear-drag-cursor))))))
(declare drag-selected-points)
+(def ^:private duplicate-screen-offset 10)
+
+(defn duplicate-offset
+ "Returns a duplicate offset that stays constant in screen pixels."
+ [zoom]
+ (let [step (/ duplicate-screen-offset zoom)]
+ (gpt/point step step)))
+
+(defn splice-duplicated
+ "Adds duplicate subpaths and selects their new nodes."
+ [{:keys [sub selected]}]
+ (ptk/reify ::splice-duplicated
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (if (and (some? id) (seq sub))
+ (let [content (st/get-path state :content)
+ base (count content)
+ new-content (path/splice-content content sub)
+ pasted (into #{} (map #(+ base %)) selected)]
+ (-> state
+ (st/set-content new-content)
+ (update-in (st/get-path-location state) path/update-geometry)
+ (assoc-in [:workspace-local :edit-path id :selection]
+ (assoc helpers/empty-selection :nodes pasted))))
+ state)))))
+
+(defn- duplicate-and-drag
+ "Duplicates the selection and drags the copy from `start-position`."
+ [start-position]
+ (ptk/reify ::duplicate-and-drag
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ result (helpers/duplicate-selection-content
+ content selection (duplicate-offset zoom))]
+ (if (seq (:sub result))
+ (rx/of (splice-duplicated result)
+ (drag-selected-points start-position))
+ (rx/of (drag-selected-points start-position)))))))
+
+(declare curve-config-node-drag)
+
(defn start-move-path-point
- [position shift?]
+ "Handles node clicks and drags in move mode."
+ [index shift? alt? mod?]
(ptk/reify ::start-move-path-point
ptk/WatchEvent
(watch [_ state _]
- (let [id (dm/get-in state [:workspace-local :edition])
- selected-points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
- selected? (contains? selected-points position)]
- (streams/drag-stream
- (rx/of
- (dwsh/update-shapes [id] path/convert-to-path)
- (when-not selected? (selection/select-node position shift?))
- (drag-selected-points @ms/mouse-position))
- (rx/of (selection/select-node position shift?)))))))
+ (let [id (st/get-path-id state)
+ selected-nodes (get (st/get-selection state id) :nodes #{})
+ selected? (contains? selected-nodes index)
+ content (st/get-path state :content)
+ position (when (and (some? content)
+ (< index (count content))
+ (helpers/node? content index))
+ (helpers/node-position content index))]
+ (cond
+ (and mod? alt?)
+ (streams/drag-stream
+ (rx/empty)
+ (if (some? position)
+ (rx/of (tools/remove-node-with-segments index))
+ (rx/empty)))
+
+ mod?
+ (streams/drag-stream
+ (rx/of (set-drag-cursor "move-handles")
+ (curve-config-node-drag index))
+ (rx/of (tools/toggle-node-curve index)))
+
+ alt?
+ (streams/drag-stream
+ (rx/of
+ (set-drag-cursor "move-copy")
+ (when-not selected? (selection/select-node index false))
+ (duplicate-and-drag @ms/mouse-position))
+ (if (some? position)
+ (rx/of (tools/remove-node position))
+ (rx/of (selection/select-node index false))))
+
+ :else
+ (streams/drag-stream
+ (rx/of
+ (set-drag-cursor "move-move")
+ (when-not selected? (selection/select-node index shift?))
+ (drag-selected-points @ms/mouse-position))
+ (rx/of (selection/select-node index shift?))))))))
(defn drag-selected-points
[start-position]
@@ -156,11 +450,13 @@
id (dm/get-in state [:workspace-local :edition])
- selected-points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
+ content (st/get-path state :content)
+
+ selected-nodes (get (st/get-selection state id) :nodes #{})
+ selected-points (helpers/node-positions content selected-nodes)
start-position (apply min-key #(gpt/distance start-position %) selected-points)
- content (st/get-path state :content)
points (path/get-points content)]
(rx/concat
@@ -169,8 +465,216 @@
(streams/move-points-stream start-position selected-points)
(rx/map #(move-selected-path-point start-position %))
(rx/take-until stopper))
+ (rx/of (apply-content-modifiers)
+ (merge-dragged-on-drop)))))))
+
+(declare drag-selected-segments)
+(declare bend-selected-segment)
+(declare create-node-at-position)
+
+(defn start-move-path-segment
+ "Handles segment clicks and drags in move mode."
+ [index shift? alt? mod?]
+ (ptk/reify ::start-move-path-segment
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ selected-segments (get selection :segments #{})
+ ;; Both selected endpoints also select their segment for dragging.
+ segment-ends (helpers/segment-node-indices content #{index})
+ selected? (or (contains? selected-segments index)
+ (and (seq segment-ends)
+ (every? (get selection :nodes #{}) segment-ends)))
+ position @ms/mouse-position
+ threshold (/ helpers/segment-insert-threshold zoom)]
+ (cond
+ (and mod? alt?)
+ (streams/drag-stream
+ (rx/empty)
+ (rx/of (tools/remove-segment index)))
+
+ mod?
+ (let [entry (d/seek #(= index (:index %)) (helpers/segment-entries content))
+ bend? (and (some? entry)
+ (not= :close-path (:command (:segment entry))))]
+ (streams/drag-stream
+ (rx/of (set-drag-cursor "move-curve")
+ (if bend?
+ (bend-selected-segment index position)
+ (drag-selected-segments position)))
+ (rx/of (tools/toggle-segment-curve index))))
+
+ alt?
+ (let [insert-point (helpers/insertion-point content position threshold true)]
+ (streams/drag-stream
+ (rx/of
+ (set-drag-cursor "move-copy")
+ (when-not selected? (selection/select-segment index false))
+ (duplicate-and-drag position))
+ (if (some? insert-point)
+ (rx/of (create-node-at-position (meta insert-point)))
+ (rx/of (selection/select-segment index false)))))
+
+ :else
+ (let [insert-point (when-not shift?
+ (helpers/insertion-point content position threshold false))
+ click-event (if (some? insert-point)
+ (create-node-at-position (meta insert-point))
+ (selection/select-segment index shift?))]
+ (streams/drag-stream
+ (rx/of
+ (set-drag-cursor "move-move")
+ (when-not selected? (selection/select-segment index shift?))
+ (drag-selected-segments position))
+ (rx/of click-event))))))))
+
+(defn- segment-entry
+ [content index]
+ (d/seek #(= index (:index %)) (helpers/segment-entries content)))
+
+(defn drag-selected-segments
+ [start-position]
+ (ptk/reify ::drag-selected-segments
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [stopper (mse/drag-stopper stream)
+ id (dm/get-in state [:workspace-local :edition])
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ node-indices (helpers/selected-node-indices content selection)
+ selected-points (helpers/node-positions content node-indices)
+ points (path/get-points content)]
+ (if (empty? selected-points)
+ (rx/empty)
+ (rx/concat
+ (->> points
+ (streams/move-points-stream start-position selected-points)
+ (rx/map #(move-selected-path-segment start-position %))
+ (rx/take-until stopper))
+ (rx/of (apply-content-modifiers)
+ (merge-dragged-on-drop))))))))
+
+(defn bend-segment-modifier
+ "Bends segment `index` so its point at `t` reaches `target`."
+ [index base-curve t target]
+ (ptk/reify ::bend-segment-modifier
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ deltas (path.helpers/bend-curve-deltas base-curve t target)
+ modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers] {})]
+ (assoc-in state [:workspace-local :edit-path id :content-modifiers]
+ (assoc modifiers index deltas))))))
+
+(defn bend-selected-segment
+ [index start-position]
+ (ptk/reify ::bend-selected-segment
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [stopper (mse/drag-stopper stream)
+ content (st/get-path state :content)
+ entry (segment-entry content index)
+ base-curve (path.helpers/entry->bezier entry)
+ ;; Keep the grabbed curve parameter fixed during the drag.
+ t (path.helpers/curve-closest-t base-curve start-position 0.001)]
+ (rx/concat
+ (->> ms/mouse-position
+ (rx/filter gpt/point?)
+ (rx/map streams/to-pixel-snap)
+ (rx/map #(bend-segment-modifier index base-curve t %))
+ (rx/take-until stopper))
(rx/of (apply-content-modifiers)))))))
+(defn- curve-config-modifier
+ "Pulls out smooth node handles toward `position`."
+ [node in-index in-base in-neighbour out-index out-base out-neighbour position]
+ (ptk/reify ::curve-config-modifier
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ v (gpt/to-vec node position)
+ both? (and (some? in-index) (some? out-index))
+
+ ;; Pick which handle follows the pointer from the drag direction.
+ ref (when (and (some? in-neighbour) (some? out-neighbour))
+ (gpt/subtract (gpt/unit (gpt/to-vec node out-neighbour))
+ (gpt/unit (gpt/to-vec node in-neighbour))))
+ s (if (and both? (some? ref) (neg? (gpt/dot v ref))) -1 1)
+
+ out-handle (if both? (gpt/add node (gpt/scale v s)) (gpt/add node v))
+ in-handle (if both? (gpt/subtract node (gpt/scale v s)) (gpt/add node v))
+
+ modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers] {})
+ modifiers (cond-> modifiers
+ (some? in-index)
+ (assoc in-index
+ {:c2x (- (:x in-handle) (:x in-base))
+ :c2y (- (:y in-handle) (:y in-base))})
+
+ (some? out-index)
+ (assoc out-index
+ {:c1x (- (:x out-handle) (:x out-base))
+ :c1y (- (:y out-handle) (:y out-base))}))]
+ (assoc-in state [:workspace-local :edit-path id :content-modifiers] modifiers)))))
+
+(defn curve-config-node-drag
+ "Replaces a node's handles with a smooth mirrored pair during a drag."
+ [index]
+ (ptk/reify ::curve-config-node-drag
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [content (st/get-path state :content)
+ node (when (and (some? content)
+ (< index (count content))
+ (helpers/node? content index))
+ (helpers/node-position content index))
+ in-cmd (nth content index nil)
+ out-cmd (nth content (inc index) nil)
+ in? (contains? #{:line-to :curve-to} (:command in-cmd))
+ out? (contains? #{:line-to :curve-to} (:command out-cmd))
+ ;; New curve handles start at the node.
+ in-base (when in?
+ (if (= :curve-to (:command in-cmd))
+ (path/get-handler in-cmd :c2)
+ node))
+ out-base (when out?
+ (if (= :curve-to (:command out-cmd))
+ (path/get-handler out-cmd :c1)
+ node))
+ ;; Neighbours keep handles on their matching leg.
+ in-neighbour (when in? (helpers/node-position content (dec index)))
+ out-neighbour (when out? (helpers/node-position content (inc index)))
+ stopper (rx/merge
+ (mse/drag-stopper stream)
+ (->> stream
+ (rx/filter streams/finish-edition?)))]
+ (if (and (some? node) (or in? out?))
+ (rx/concat
+ (->> ms/mouse-position
+ (rx/filter gpt/point?)
+ ;; Apply Shift changes without waiting for pointer movement.
+ (rx/combine-latest-with ms/keyboard-shift)
+ (rx/map (fn [[position shift?]]
+ (assoc position :shift? shift?)))
+ (rx/map
+ (fn [{:keys [x y shift?]}]
+ (let [position (cond-> (gpt/point x y)
+ shift? (path.helpers/position-fixed-angle node))]
+ (curve-config-modifier node
+ (when in? index)
+ in-base
+ in-neighbour
+ (when out? (inc index))
+ out-base
+ out-neighbour
+ position))))
+ (rx/take-until stopper))
+ (rx/of (apply-content-modifiers)))
+ (rx/empty))))))
+
(defn- get-displacement
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
@@ -213,7 +717,20 @@
current-move (dm/get-in state [:workspace-local :edit-path id :current-move])]
;; id can be null if we just selected the tool but we didn't start drawing
(if (and id (= same-event current-move))
- (let [points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
+ (let [content (st/get-path state :content)
+ selection (st/get-selection state id)
+ selected-nodes (get selection :nodes #{})
+ selected-segments (get selection :segments #{})
+ selected-handlers (get selection :handlers #{})
+
+ ;; Move nodes rigidly and handlers independently.
+ node-indices (into selected-nodes
+ (helpers/segment-node-indices content selected-segments))
+ points (helpers/node-positions content node-indices)
+ handler-ids (into #{}
+ (filter (fn [[index _]]
+ (= :curve-to (:command (nth content index nil)))))
+ selected-handlers)
move-events (->> stream
(rx/filter (ptk/type? ::move-selected))
@@ -226,12 +743,11 @@
mov-vec (gpt/multiply (get-displacement direction) scale)]
(rx/concat
- (rx/of (dwsh/update-shapes [id] path/convert-to-path))
(rx/merge
(->> move-events
(rx/take-until stopper)
(rx/scan #(gpt/add %1 mov-vec) (gpt/point 0 0))
- (rx/map #(set-move-modifier points %)))
+ (rx/map #(set-move-modifier points handler-ids %)))
;; First event is not read by the stream so we need to send it again
(rx/of (move-selected direction shift?)))
@@ -240,53 +756,131 @@
(finish-move-selected))))
(rx/empty)))))))
+(declare drag-selected-handlers)
+
+(defn- handler-drag-mode
+ "Returns the live handler matching mode for a drag."
+ [plain-mode mod? alt?]
+ (cond
+ (and mod? alt?) :aligned
+ mod? :mirror
+ alt? :independent
+ :else plain-mode))
+
+(defn- handler-drag-cursor
+ [mod? alt?]
+ (if (or mod? alt?) "move-handles" "move-move"))
+
(defn start-move-handler
- [index prefix]
+ "Handles handler clicks and drags in both edit modes."
+ [index prefix shift? alt? mod?]
(ptk/reify ::start-move-handler
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ handler-id [index prefix]
+ content (st/get-path state :content)
+ selected-handlers (dm/get-in state
+ [:workspace-local :edit-path id :selection :handlers]
+ #{})
+ selected? (contains? selected-handlers handler-id)
+
+ handler-types (dm/get-in state [:workspace-local :edit-path id :handler-types] {})
+ plain-mode (stored-handler-drag-mode
+ content handler-types index prefix)]
+ (cond
+ (and mod? alt?)
+ (streams/drag-stream
+ (rx/of (set-drag-cursor (handler-drag-cursor mod? alt?))
+ (drag-selected-handlers handler-id plain-mode))
+ (rx/empty))
+
+ (or mod? alt?)
+ (streams/drag-stream
+ (rx/of (set-drag-cursor (handler-drag-cursor mod? alt?))
+ (drag-selected-handlers handler-id plain-mode))
+ (rx/of (tools/remove-handler index prefix)))
+
+ :else
+ (streams/drag-stream
+ (rx/of
+ (set-drag-cursor (handler-drag-cursor mod? alt?))
+ (when-not selected?
+ (selection/select-handler index prefix shift?))
+ (drag-selected-handlers handler-id plain-mode))
+ (rx/of (selection/select-handler index prefix shift?))))))))
+
+(defn drag-selected-handlers
+ "Drags selected handlers using the live matching mode."
+ [[index prefix :as primary] plain-mode]
+ (ptk/reify ::drag-selected-handlers
ptk/WatchEvent
(watch [_ state stream]
- (let [id (dm/get-in state [:workspace-local :edition])
- cx (d/prefix-keyword prefix :x)
- cy (d/prefix-keyword prefix :y)
-
- modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers])
- start-delta-x (dm/get-in modifiers [index cx] 0)
- start-delta-y (dm/get-in modifiers [index cy] 0)
-
- content (st/get-path state :content)
- points (path/get-points content)
-
- point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.helpers/segment->point))
- handler (-> content (nth index) (path/get-handler prefix))
-
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ points (path/get-points content)
+ start-modifiers (dm/get-in state
+ [:workspace-local :edit-path id :content-modifiers]
+ {})
+ start-delta (handler-modifier-delta start-modifiers index prefix)
+ point (path/handler->node content index prefix)
+ handler (-> (path/get-handler-point content index prefix)
+ (gpt/add start-delta))
[op-idx op-prefix] (path/opposite-index content index prefix)
- opposite (path/get-handler-point content op-idx op-prefix)]
+ opposite (when op-idx
+ (-> (path/get-handler-point content op-idx op-prefix)
+ (gpt/add (handler-modifier-delta start-modifiers
+ op-idx
+ op-prefix))))
+ stopper (rx/merge
+ (mse/drag-stopper stream)
+ (->> stream
+ (rx/filter streams/finish-edition?)))
- (streams/drag-stream
- (rx/concat
- (rx/of (dwsh/update-shapes [id] path/convert-to-path))
- (->> (streams/move-handler-stream handler point handler opposite points)
+ handler-events (rx/share
+ (streams/move-handler-stream handler point handler opposite points))]
+ (rx/concat
+ (rx/merge
+ (->> handler-events
(rx/map
- (fn [{:keys [x y alt? shift?]}]
- (let [pos (cond-> (gpt/point x y)
- shift? (path.helpers/position-fixed-angle point))]
- (modify-handler
- id
- index
- prefix
- (+ start-delta-x (- (:x pos) (:x handler)))
- (+ start-delta-y (- (:y pos) (:y handler)))
- (not alt?)))))
- (rx/take-until
- (rx/merge
- (mse/drag-stopper stream)
- (->> stream
- (rx/filter streams/finish-edition?)))))
-
- (rx/concat (rx/of (apply-content-modifiers)))))))))
+ (fn [{:keys [x y shift? alt? mod?]}]
+ (let [position (cond-> (gpt/point x y)
+ shift? (path.helpers/position-fixed-angle point))
+ delta (gpt/subtract position handler)
+ mode (handler-drag-mode plain-mode mod? alt?)
+ move-selection? (not (or mod? alt?))]
+ (modify-selected-handlers id
+ primary
+ start-modifiers
+ (:x delta)
+ (:y delta)
+ mode
+ move-selection?))))
+ (rx/take-until stopper))
+ ;; Update the cursor only when the matching mode changes.
+ (->> handler-events
+ (rx/map (fn [{:keys [alt? mod?]}] (handler-drag-cursor mod? alt?)))
+ (rx/pipe (rxo/distinct-contiguous))
+ (rx/map set-drag-cursor)
+ (rx/take-until stopper)))
+ (rx/of (apply-content-modifiers)))))))
(declare stop-path-edit)
+(defn- resolve-edit-fills
+ "Resolves the fills inherited by the editing copy.
+ Frames stop group fill inheritance."
+ [shape objects]
+ (let [own (svg-fills/resolve-shape-fills shape)]
+ (if (seq own)
+ own
+ (loop [parent-id (:parent-id shape)]
+ (let [parent (get objects parent-id)]
+ (cond
+ (nil? parent) []
+ (cfh/group-shape? parent) (svg-fills/resolve-shape-fills parent)
+ (cfh/frame-shape? parent) []
+ :else (recur (:parent-id parent))))))))
(defn start-path-edit
[id]
@@ -294,10 +888,15 @@
ptk/UpdateEvent
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
- shape (get objects id)]
+ shape (get objects id)
+ shape (-> shape
+ (path/convert-to-path objects)
+ (update :content path/close-subpaths)
+ (path/update-geometry))
+ shape (assoc shape :fills (resolve-edit-fills shape objects))]
(-> state
- (st/set-content (path/close-subpaths (:content shape)))
+ (assoc-in [:workspace-drawing :object] shape)
(update-in [:workspace-local :edit-path id]
(fn [state]
(let [state (if state
@@ -305,20 +904,20 @@
(assoc state :edit-mode :draw)
state)
{:edit-mode :move
- :selected #{}
- :snap-toggled false})]
+ :selection helpers/empty-selection
+ :hover helpers/empty-selection
+ :handler-types {}
+ :snap-toggled true})]
(assoc state :old-content (:content shape))))))))
ptk/WatchEvent
(watch [_ _ stream]
- (let [stopper (rx/filter #(let [type (ptk/type %)]
- (= type ::dwe/clear-edition-mode)
- (= type ::start-path-edit))
- stream)]
+ (let [stopper (rx/filter (ptk/type? ::start-path-edit) stream)]
(rx/concat
(rx/of (undo/start-path-undo))
+ ;; Finalize once on the canonical edition stop event.
(->> stream
- (rx/filter #(= % :interrupt))
+ (rx/filter (ptk/type? ::dwe/clear-edition-mode))
(rx/take 1)
(rx/map #(stop-path-edit id))
(rx/take-until stopper)))))))
@@ -326,29 +925,27 @@
(defn stop-path-edit
[id]
(ptk/reify ::stop-path-edit
- ptk/UpdateEvent
- (update [_ state]
- (update state :workspace-local dissoc :edit-path id))
-
ptk/WatchEvent
(watch [_ _ _]
- (rx/of (ptk/data-event :layout/update {:ids [id]})))))
+ (rx/of
+ (changes/finalize-path-content id)
+ (fn [state]
+ (-> state
+ (update-in [:workspace-local :edit-path] dissoc id)
+ (update :workspace-drawing dissoc :object :lock)))
+ (ptk/data-event :layout/update {:ids [id]})))))
(defn- split-segments
- [id {:keys [from-p to-p t]}]
+ [_id {:keys [from-p to-p t]}]
(ptk/reify ::split-segments
ptk/UpdateEvent
(update [_ state]
(let [content (st/get-path state :content)]
(-> state
- (assoc-in [:workspace-local :edit-path id :old-content] content)
(st/set-content (-> content
(path/split-segments #{from-p to-p} t)
- (path/content))))))
-
- ptk/WatchEvent
- (watch [_ _ _]
- (rx/of (changes/save-path-content {:preserve-move-to true})))))
+ (path/content)))
+ (update-in (st/get-path-location state) path/update-geometry))))))
(defn create-node-at-position
[params]
@@ -356,5 +953,4 @@
ptk/WatchEvent
(watch [_ state _]
(let [id (st/get-path-id state)]
- (rx/of (dwsh/update-shapes [id] path/convert-to-path)
- (split-segments id params))))))
+ (rx/of (split-segments id params))))))
diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs
index 4432cb0b08..a32a86f57c 100644
--- a/frontend/src/app/main/data/workspace/path/helpers.cljs
+++ b/frontend/src/app/main/data/workspace/path/helpers.cljs
@@ -6,7 +6,11 @@
(ns app.main.data.workspace.path.helpers
(:require
+ [app.common.data :as d]
[app.common.geom.point :as gpt]
+ [app.common.geom.rect :as grc]
+ [app.common.geom.shapes :as gsh]
+ [app.common.geom.shapes.intersect :as gsi]
[app.common.math :as mth]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]))
@@ -25,8 +29,27 @@
(gpt/to-vec common p1)
(gpt/to-vec common p2))))
+(defn opposite-handler-target
+ "Returns the opposite handler target for mirror or aligned modes."
+ [node handler opposite mode]
+ (if (and (some? node) (some? handler) (some? opposite))
+ (case mode
+ :mirror
+ (gpt/subtract (gpt/scale node 2) handler)
+
+ :aligned
+ (let [handler-vector (gpt/to-vec node handler)]
+ (if (mth/almost-zero? (gpt/length handler-vector))
+ opposite
+ (gpt/subtract node
+ (gpt/scale (gpt/unit handler-vector)
+ (gpt/distance node opposite)))))
+
+ opposite)
+ opposite))
+
(defn- calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy]
- (when (and (some? handler) (some? opposite))
+ (if (and (some? handler) (some? opposite))
(let [;; To match the angle, the angle should be matching (angle between points 180deg)
angle-handlers (angle-points node handler opposite)
@@ -54,30 +77,466 @@
match-distance?
(gpt/scale-from node distance-scale))]
[(- (:x new-opposite) (:x opposite))
- (- (:y new-opposite) (:y opposite))])))
+ (- (:y new-opposite) (:y opposite))])
+ ;; Leave missing opposite handles unchanged.
+ [0 0]))
+
+(defn handlers-joined?
+ "True when a node's handlers are collinear and opposite."
+ [content index prefix]
+ (let [[op-idx op-prefix] (path/opposite-index content index prefix)
+ node (path/handler->node content index prefix)
+ handler (path/get-handler-point content index prefix)
+ opposite (when op-idx (path/get-handler-point content op-idx op-prefix))]
+ (boolean
+ (and (some? op-idx)
+ (some? handler)
+ (some? opposite)
+ (not= handler node)
+ (not= opposite node)
+ (<= (mth/abs (- 180 (angle-points node handler opposite))) 0.1)))))
(defn move-handler-modifiers
- [content index prefix match-distance? match-angle? dx dy]
+ ([content index prefix match-distance? match-angle? dx dy]
+ (move-handler-modifiers content index prefix match-distance? match-angle? false dx dy))
+ ([content index prefix match-distance? match-angle? rejoin? dx dy]
- (let [[cx cy] (path.helpers/prefix->coords prefix)
+ (let [[cx cy] (path.helpers/prefix->coords prefix)
+ [op-idx op-prefix] (path/opposite-index content index prefix)
+
+ node (path/handler->node content index prefix)
+ handler (path/get-handler-point content index prefix)
+ opposite (path/get-handler-point content op-idx op-prefix)
+
+ [ocx ocy] (path.helpers/prefix->coords op-prefix)
+ [odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)
+
+ hnv (if (some? handler)
+ (gpt/to-vec node (-> handler (update :x + dx) (update :y + dy)))
+ (gpt/point dx dy))
+ mirrored-opposite (opposite-handler-target
+ node (gpt/add node hnv) opposite :mirror)]
+
+ (-> {}
+ (update index assoc cx dx cy dy)
+
+ (cond->
+ ;; Force an exact mirror when rejoining handlers.
+ (and (some? op-idx) rejoin? (not= opposite node))
+ (update op-idx assoc
+ ocx (- (:x mirrored-opposite) (:x opposite))
+ ocy (- (:y mirrored-opposite) (:y opposite)))
+
+ (and (some? op-idx) (not rejoin?) (not= opposite node))
+ (update op-idx assoc ocx odx ocy ody)
+
+ (and (some? op-idx) (= opposite node) match-distance? match-angle?)
+ (update op-idx assoc
+ ocx (- (:x mirrored-opposite) (:x opposite))
+ ocy (- (:y mirrored-opposite) (:y opposite))))))))
+
+(defn align-handler-modifiers
+ "Moves a handler and aligns its opposite without changing its length."
+ [content index prefix dx dy]
+ (let [[cx cy] (path.helpers/prefix->coords prefix)
[op-idx op-prefix] (path/opposite-index content index prefix)
+ node (path/handler->node content index prefix)
+ opposite (when (some? op-idx)
+ (path/get-handler-point content op-idx op-prefix))
+ handler (path/get-handler-point content index prefix)
+ modifiers (-> {} (update index assoc cx dx cy dy))]
+ (if (and (some? handler) (some? opposite) (not= opposite node))
+ (let [moved-handler (-> handler (update :x + dx) (update :y + dy))
+ handler-vector (gpt/to-vec node moved-handler)
+ target (opposite-handler-target node moved-handler opposite :aligned)]
+ (if (mth/almost-zero? (gpt/length handler-vector))
+ modifiers
+ (let [[ocx ocy] (path.helpers/prefix->coords op-prefix)]
+ (update modifiers op-idx assoc
+ ocx (- (:x target) (:x opposite))
+ ocy (- (:y target) (:y opposite))))))
+ modifiers)))
- node (path/handler->node content index prefix)
- handler (path/get-handler-point content index prefix)
- opposite (path/get-handler-point content op-idx op-prefix)
+;; --- Per-node handler type (mirror / aligned / independent)
- [ocx ocy] (path.helpers/prefix->coords op-prefix)
- [odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)
+(defn handler-node-index
+ "Returns the anchor command index for a handler."
+ [index prefix]
+ (if (= prefix :c1) (dec index) index))
- hnv (if (some? handler)
- (gpt/to-vec node (-> handler (update :x + dx) (update :y + dy)))
- (gpt/point dx dy))]
+(defn node-primary-handler
+ "Returns a curve handler for a node, preferring its incoming handle."
+ [content node-index]
+ (let [n (count content)
+ out-idx (inc node-index)]
+ (cond
+ (and (>= node-index 0) (< node-index n)
+ (= :curve-to (:command (nth content node-index nil))))
+ [node-index :c2]
- (-> {}
- (update index assoc cx dx cy dy)
+ (and (< out-idx n)
+ (= :curve-to (:command (nth content out-idx nil))))
+ [out-idx :c1]
- (cond-> (and (some? op-idx) (not= opposite node))
- (update op-idx assoc ocx odx ocy ody)
+ :else nil)))
- (and (some? op-idx) (= opposite node) match-distance? match-angle?)
- (update op-idx assoc ocx (- (:x hnv)) ocy (- (:y hnv)))))))
+(defn handlers-equal-length?
+ "True when a node's two handlers are the same distance from the node."
+ [content index prefix]
+ (let [[op-idx op-prefix] (path/opposite-index content index prefix)
+ node (path/handler->node content index prefix)
+ handler (path/get-handler-point content index prefix)
+ opposite (when op-idx (path/get-handler-point content op-idx op-prefix))]
+ (boolean
+ (and (some? handler) (some? opposite)
+ (mth/almost-zero? (- (gpt/distance node handler)
+ (gpt/distance node opposite)))))))
+
+(defn derive-handler-type
+ "Infers a node's handler type from its geometry."
+ [content node-index]
+ (if-let [[idx prefix] (node-primary-handler content node-index)]
+ (cond
+ (not (handlers-joined? content idx prefix)) :independent
+ (handlers-equal-length? content idx prefix) :mirror
+ :else :aligned)
+ :independent))
+
+(defn remap-handler-types
+ "Remaps handler types by node position after structural changes."
+ [handler-types old-content new-content]
+ (let [handler-types (or handler-types {})]
+ (if (= (count old-content) (count new-content))
+ handler-types
+ (let [types-by-position
+ (reduce-kv
+ (fn [result index type]
+ (let [segment (nth old-content index nil)]
+ (if (or (nil? segment) (= :close-path (:command segment)))
+ result
+ (update result
+ (path.helpers/segment->point segment)
+ (fnil conj #{})
+ type))))
+ {}
+ handler-types)]
+ (into {}
+ (keep (fn [[index segment]]
+ (when-not (= :close-path (:command segment))
+ (let [types (get types-by-position
+ (path.helpers/segment->point segment))]
+ (when (= 1 (count types))
+ [index (first types)])))))
+ (d/enumerate new-content))))))
+
+;; Nodes and segments use command indices. Handlers use `[index prefix]`.
+;; Selection and hover use grouped index sets:
+;; {:nodes #{index} :segments #{index} :handlers #{[index prefix]}}
+
+(def empty-selection
+ {:nodes #{} :segments #{} :handlers #{}})
+
+(defn node?
+ "True when the command at the given content index is a selectable node."
+ [content index]
+ (and (number? index)
+ (<= 0 index)
+ (< index (count content))
+ (not= :close-path (:command (nth content index nil)))))
+
+(defn node-indices
+ "Indices of every selectable node in the content."
+ [content]
+ (into []
+ (comp (remove (fn [[_ seg]] (= :close-path (:command seg))))
+ (map first))
+ (d/enumerate content)))
+
+(defn node-position
+ "Position of the node at the given content command index."
+ [content index]
+ (path.helpers/segment->point (nth content index)))
+
+(defn curve-node?
+ "True when the node at `index` has a visible curve handler."
+ [content index]
+ (when (node? content index)
+ (let [node (node-position content index)
+ incoming (when (= :curve-to (:command (nth content index nil)))
+ (path/get-handler-point content index :c2))
+ outgoing-index (inc index)
+ outgoing (when (= :curve-to (:command (nth content outgoing-index nil)))
+ (path/get-handler-point content outgoing-index :c1))]
+ (boolean (some #(and (some? %) (not= node %)) [incoming outgoing])))))
+
+(defn node-positions
+ "Set of positions for the given node indices in the content."
+ [content indices]
+ (let [indices (set indices)]
+ (into #{}
+ (comp (filter (fn [[index _]] (contains? indices index)))
+ (map (fn [[_ seg]] (path.helpers/segment->point seg))))
+ (d/enumerate content))))
+
+(defn nodes-in-rect
+ "Indices of the nodes whose position falls inside the given rect."
+ [content rect]
+ (into #{}
+ (comp (remove (fn [[_ seg]] (= :close-path (:command seg))))
+ (filter (fn [[_ seg]] (gsh/has-point-rect? rect (path.helpers/segment->point seg))))
+ (map first))
+ (d/enumerate content)))
+
+(def segment-entries
+ "Returns selectable path segments."
+ path/segment-entries)
+
+(defn segment-node-indices
+ "Unique endpoint-node indices for the selected segment command indices."
+ [content segment-indices]
+ (let [segment-indices (set segment-indices)]
+ (into #{}
+ (comp (filter #(contains? segment-indices (:index %)))
+ (mapcat (juxt :from-index :to-index))
+ (remove nil?))
+ (segment-entries content))))
+
+(defn check-enabled
+ "Returns path actions enabled for selected node indices."
+ [content selected-nodes]
+ (when content
+ (let [selected-nodes (into #{} (filter #(node? content %)) selected-nodes)
+ selected-segments (filter (fn [{:keys [from-index to-index]}]
+ (and (contains? selected-nodes from-index)
+ (contains? selected-nodes to-index)))
+ (segment-entries content))
+ num-segments (count selected-segments)
+ num-nodes (count selected-nodes)
+ nodes-selected? (seq selected-nodes)
+ segments-selected? (seq selected-segments)
+ max-segments (/ (* num-nodes (dec num-nodes)) 2)
+ curves-selected? (some #(curve-node? content %) selected-nodes)
+ corners-selected? (some #(not (curve-node? content %)) selected-nodes)]
+ {:make-corner (and nodes-selected? curves-selected?)
+ :make-curve (and nodes-selected? corners-selected?)
+ :merge-nodes (and nodes-selected? (>= num-nodes 2))
+ :join-nodes (and nodes-selected? (>= num-nodes 2) (< num-segments max-segments))
+ :separate-nodes (or segments-selected? (= num-nodes 1))})))
+
+(defn selected-node-indices
+ "Returns selected nodes plus endpoints of selected segments."
+ [content selection]
+ (into (get selection :nodes #{})
+ (segment-node-indices content (get selection :segments #{}))))
+
+(defn selection-coordinate-rect
+ "Returns the bounds of selected segments, nodes, and handlers."
+ [content selection]
+ (let [segments (get selection :segments #{})
+ node-indices (selected-node-indices content selection)
+ handlers (get selection :handlers #{})
+ segment-rect (when (seq segments)
+ (path/calc-selrect
+ (path/extract-content content {:segments segments})))
+ point-rect (grc/points->rect
+ (into (node-positions content node-indices)
+ (keep (fn [[index prefix]]
+ (path/get-handler-point content index prefix)))
+ handlers))]
+ (grc/join-rects (keep identity [segment-rect point-rect]))))
+
+(defn handler-target-nodes
+ "Returns nodes targeted by the current node and handler selection."
+ [content selection]
+ (into (selected-node-indices content selection)
+ (map (fn [[idx prefix]] (handler-node-index idx prefix)))
+ (get selection :handlers #{})))
+
+(defn handler-selection-state
+ "Returns targeted curve nodes and their shared handler mode."
+ [content handler-types target-nodes]
+ (let [curve-nodes (into #{} (filter #(curve-node? content %)) target-nodes)
+ modes (into #{}
+ (map (fn [index]
+ (or (get handler-types index)
+ (derive-handler-type content index))))
+ curve-nodes)]
+ {:nodes curve-nodes
+ :active-type (cond
+ (empty? modes) nil
+ (= 1 (count modes)) (first modes)
+ :else :mixed)}))
+
+(defn handler-trigger-action
+ "Returns the handler menu action for the active mode."
+ [active-type]
+ (if (= active-type :mixed) :open :select))
+
+(def segment-insert-threshold
+ "Maximum screen distance for midpoint insertion."
+ 12)
+
+(defn segment-mid-point
+ "Returns a segment's arc-length midpoint with split metadata."
+ [{:keys [from to segment] :as entry}]
+ (let [curve (path.helpers/entry->bezier entry)
+ t (if (= :line-to (:command segment))
+ 0.5
+ (path.helpers/curve-arc-length-t curve))]
+ (with-meta (path.helpers/curve-values curve t)
+ {:from-p from :to-p to :t t})))
+
+(defn insertion-mid-points
+ "Precomputes segment midpoint insertion candidates."
+ [content]
+ (into []
+ (comp (remove #(= :close-path (:command (:segment %))))
+ (map segment-mid-point))
+ (segment-entries content)))
+
+(defn- closest-insertion-mid-point
+ [mid-points position threshold]
+ (some->> mid-points
+ (reduce
+ (fn [closest mid-point]
+ (let [distance (gpt/distance position mid-point)]
+ (if (and (<= distance threshold)
+ (or (nil? closest)
+ (< distance (first closest))))
+ [distance mid-point]
+ closest)))
+ nil)
+ second))
+
+(defn insertion-point
+ "Returns the on-path point a nearby click would insert, with split metadata."
+ ([content position threshold anywhere?]
+ (insertion-point content position threshold anywhere? nil))
+ ([content position threshold anywhere? mid-points]
+ (if anywhere?
+ (let [point (path/closest-point content position 0.01)]
+ (when (and (some? point) (<= (gpt/distance position point) threshold))
+ point))
+ (closest-insertion-mid-point
+ (or mid-points (insertion-mid-points content)) position threshold))))
+
+(defn- segment-lines
+ [{:keys [from to segment]}]
+ (if (= :curve-to (:command segment))
+ (path.helpers/curve->lines from
+ to
+ (path/get-handler segment :c1)
+ (path/get-handler segment :c2))
+ [[from to]]))
+
+(defn segments-in-rect
+ "Returns segments that cross or fall inside `rect`."
+ [content rect]
+ (let [rect-lines (gsi/points->lines (grc/rect->points rect))]
+ (into #{}
+ (comp
+ (filter
+ (fn [entry]
+ (let [lines (segment-lines entry)]
+ (or (some (fn [[from to]]
+ (or (grc/contains-point? rect from)
+ (grc/contains-point? rect to)))
+ lines)
+ (gsi/intersects-lines? rect-lines lines)))))
+ (map :index))
+ (segment-entries content))))
+
+(defn handler-entries
+ "Visible path handlers as `{:identity [index prefix] :point p}` entries."
+ [content]
+ (into []
+ (comp
+ (mapcat
+ (fn [[index segment]]
+ (when (= :curve-to (:command segment))
+ (keep
+ (fn [prefix]
+ (let [handler (path/get-handler-point content index prefix)
+ node (path/handler->node content index prefix)]
+ (when (and handler (not= handler node))
+ {:identity [index prefix]
+ :point handler})))
+ [:c1 :c2])))))
+ (d/enumerate content)))
+
+(defn handlers-in-rect
+ "Identities of visible path handlers whose control point is inside `rect`."
+ [content rect]
+ (into #{}
+ (comp (filter #(grc/contains-point? rect (:point %)))
+ (map :identity))
+ (handler-entries content)))
+
+(defn remap-selected-nodes
+ "Remaps selected nodes by position after structural changes."
+ [selected-nodes old-content new-content]
+ (if (empty? selected-nodes)
+ selected-nodes
+ (let [positions (node-positions old-content selected-nodes)]
+ (into #{}
+ (comp (remove (fn [[_ seg]] (= :close-path (:command seg))))
+ (filter (fn [[_ seg]] (contains? positions (path.helpers/segment->point seg))))
+ (map first))
+ (d/enumerate new-content)))))
+
+(defn- fragment-covered-nodes
+ "Returns nodes already included in a duplicated segment fragment."
+ [content {:keys [nodes segments]}]
+ (let [nodes (or nodes #{})
+ segments (or segments #{})]
+ (into #{}
+ (comp (filter (fn [{:keys [index from-index to-index]}]
+ (or (contains? segments index)
+ (and (contains? nodes from-index)
+ (contains? nodes to-index)))))
+ (mapcat (juxt :from-index :to-index)))
+ (segment-entries content))))
+
+(defn duplicate-selection-content
+ "Duplicates selected nodes and segments for splicing as new subpaths."
+ [content selection offset]
+ (let [fragment (path/extract-content content selection)
+ fragment (cond-> fragment
+ (and (seq fragment) (some? offset))
+ (path/move-content offset))
+ fragment (vec fragment)
+ covered (fragment-covered-nodes content selection)
+ free (sort (remove covered (get selection :nodes #{})))]
+ (reduce (fn [{:keys [sub selected]} node-index]
+ (if-let [{ext :content ext-selected :selected}
+ (path/duplicate-node-content content node-index offset)]
+ (let [start (count sub)]
+ {:sub (into sub ext)
+ :selected (into selected (map #(+ start %)) ext-selected)})
+ {:sub sub :selected selected}))
+ {:sub fragment :selected (set (node-indices fragment))}
+ free)))
+
+(defn remap-selection
+ "Remaps a grouped selection after path content changes."
+ [selection old-content new-content]
+ (let [selection (or selection empty-selection)]
+ (if (= (count old-content) (count new-content))
+ (-> selection
+ (update :handlers
+ (fn [handlers]
+ (into #{}
+ (filter (fn [[index _]]
+ (= :curve-to (:command (nth new-content index nil)))))
+ handlers)))
+ ;; Drop indices that became subpath breaks.
+ (update :segments
+ (fn [segments]
+ (into #{}
+ (remove (fn [index]
+ (= :move-to (:command (nth new-content index nil)))))
+ segments))))
+ (assoc empty-selection
+ :nodes (remap-selected-nodes (get selection :nodes #{})
+ old-content
+ new-content)))))
diff --git a/frontend/src/app/main/data/workspace/path/selection.cljs b/frontend/src/app/main/data/workspace/path/selection.cljs
index e4d28c3dd6..62c372211a 100644
--- a/frontend/src/app/main/data/workspace/path/selection.cljs
+++ b/frontend/src/app/main/data/workspace/path/selection.cljs
@@ -7,9 +7,8 @@
(ns app.main.data.workspace.path.selection
(:require
[app.common.data.macros :as dm]
- [app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
- [app.common.geom.shapes :as gsh]
+ [app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as st]
[app.main.streams :as ms]
[app.util.mouse :as mse]
@@ -17,84 +16,140 @@
[beicon.v2.operators :as rxo]
[potok.v2.core :as ptk]))
-(defn path-pointer-enter [position]
+(defn path-pointer-enter [index]
(ptk/reify ::path-pointer-enter
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (update-in state [:workspace-local :edit-path id :hover-points] (fnil conj #{}) position)))))
+ (update-in state [:workspace-local :edit-path id :hover :nodes] (fnil conj #{}) index)))))
-(defn path-pointer-leave [position]
+(defn path-pointer-leave [index]
(ptk/reify ::path-pointer-leave
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (update-in state [:workspace-local :edit-path id :hover-points] disj position)))))
+ (update-in state [:workspace-local :edit-path id :hover :nodes] disj index)))))
(defn path-handler-enter [index prefix]
(ptk/reify ::path-handler-enter
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (update-in state [:workspace-local :edit-path id :hover-handlers] (fnil conj #{}) [index prefix])))))
+ (update-in state [:workspace-local :edit-path id :hover :handlers] (fnil conj #{}) [index prefix])))))
(defn path-handler-leave [index prefix]
(ptk/reify ::path-handler-leave
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (update-in state [:workspace-local :edit-path id :hover-handlers] disj [index prefix])))))
+ (update-in state [:workspace-local :edit-path id :hover :handlers] disj [index prefix])))))
-(defn select-node-area
- [initial-set remove?]
- (ptk/reify ::select-node-area
+(defn path-segment-enter [index]
+ (ptk/reify ::path-segment-enter
ptk/UpdateEvent
(update [_ state]
- (let [selrect (dm/get-in state [:workspace-local :selrect])
- id (dm/get-in state [:workspace-local :edition])
- content (st/get-path state :content)
+ (let [id (st/get-path-id state)]
+ (update-in state [:workspace-local :edit-path id :hover :segments] (fnil conj #{}) index)))))
- selected-point? (if (some? selrect)
- (partial gsh/has-point-rect? selrect)
- (constantly false))
+(defn path-segment-leave [index]
+ (ptk/reify ::path-segment-leave
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)]
+ (update-in state [:workspace-local :edit-path id :hover :segments] disj index)))))
- xform (comp (filter #(not (= (:command %) :close-path)))
- (map (comp gpt/point :params))
- (filter selected-point?))
- positions (if remove?
- (apply disj initial-set (into #{} xform content))
- (into initial-set xform content))]
+(defn- select-element
+ [state type identity shift?]
+ (let [id (dm/get-in state [:workspace-local :edition])
+ selection (or (st/get-selection state id) helpers/empty-selection)
+ selected (get selection type #{})
+ selection (cond
+ (and shift? (contains? selected identity))
+ (update selection type disj identity)
- (cond-> state
- (some? id)
- (assoc-in [:workspace-local :edit-path id :selected-points] positions))))))
+ shift?
+ (update selection type (fnil conj #{}) identity)
-(defn select-node [position shift?]
+ :else
+ (assoc helpers/empty-selection type #{identity}))]
+ (cond-> state
+ (some? id)
+ (assoc-in [:workspace-local :edit-path id :selection] selection))))
+
+(defn select-node [index shift?]
(ptk/reify ::select-node
ptk/UpdateEvent
(update [_ state]
- (let [id (dm/get-in state [:workspace-local :edition])
- selected-points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
- selected-points (cond
- (and shift? (contains? selected-points position))
- (disj selected-points position)
+ (select-element state :nodes index shift?))))
- shift?
- (conj selected-points position)
+(defn select-segment [index shift?]
+ (ptk/reify ::select-segment
+ ptk/UpdateEvent
+ (update [_ state]
+ (select-element state :segments index shift?))))
- :else
- #{position})]
- (cond-> state
- (some? id)
- (assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))
+(defn select-handler [index prefix shift?]
+ (ptk/reify ::select-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ (select-element state :handlers [index prefix] shift?))))
+
+(defn- update-area-set
+ [initial-set in-rect remove?]
+ (if remove?
+ (apply disj initial-set in-rect)
+ (into initial-set in-rect)))
+
+(defn select-path-area
+ [rect initial-selection remove?]
+ (ptk/reify ::select-path-area
+ ptk/UpdateEvent
+ (update [_ state]
+ (if-not (grc/rect? rect)
+ state
+ (let [id (dm/get-in state [:workspace-local :edition])
+ content (st/get-path state :content)
+
+ ;; Marquee priority is nodes, segments, then handlers.
+ nodes (helpers/nodes-in-rect content rect)
+ segments (if (empty? nodes)
+ (helpers/segments-in-rect content rect)
+ #{})
+ handlers (if (and (empty? nodes) (empty? segments))
+ (helpers/handlers-in-rect content rect)
+ #{})
+ in-rect {:nodes nodes
+ :segments segments
+ :handlers handlers}
+ selection
+ (reduce-kv
+ (fn [selection type identities]
+ (assoc selection type
+ (update-area-set (get initial-selection type #{})
+ identities
+ remove?)))
+ helpers/empty-selection
+ in-rect)]
+ (cond-> state
+ (some? id)
+ (assoc-in [:workspace-local :edit-path id :selection] selection)))))))
(defn deselect-all []
(ptk/reify ::deselect-all
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)]
- (-> state
- (assoc-in [:workspace-local :edit-path id :selected-points] #{}))))))
+ (assoc-in state [:workspace-local :edit-path id :selection] helpers/empty-selection)))))
+
+(defn select-all-nodes []
+ (ptk/reify ::select-all-nodes
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (assoc helpers/empty-selection
+ :nodes (into #{} (helpers/node-indices content)))]
+ (assoc-in state [:workspace-local :edit-path id :selection] selection)))))
(defn update-area-selection
[rect]
@@ -123,10 +178,10 @@
stopper (mse/drag-stopper stream)
from-p @ms/mouse-position
- initial-set
+ initial-selection
(if (or append? remove?)
- (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
- #{})
+ (or (st/get-selection state id) helpers/empty-selection)
+ helpers/empty-selection)
selrect-stream
(->> ms/mouse-position
@@ -141,20 +196,11 @@
(rx/merge
(->> selrect-stream
(rx/map update-area-selection))
+ ;; Limit path hit-testing to once per animation frame.
(->> selrect-stream
- (rx/buffer-time 100)
+ (rx/buffer-time 16)
(rx/map last)
+ (rx/filter some?)
(rx/pipe (rxo/distinct-contiguous))
- (rx/map #(select-node-area initial-set remove?))))
+ (rx/map #(select-path-area % initial-selection remove?))))
(rx/of (clear-area-selection))))))))
-
-(defn update-selection
- [point-change]
- (ptk/reify ::update-selection
- ptk/UpdateEvent
- (update [_ state]
- (let [id (st/get-path-id state)
- selected-points (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
- selected-points (into #{} (map point-change) selected-points)]
- (-> state
- (assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))
diff --git a/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs b/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs
index 6c55397514..9a15aaeb96 100644
--- a/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs
+++ b/frontend/src/app/main/data/workspace/path/shapes_to_path.cljs
@@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cph]
+ [app.common.geom.matrix :as gmt]
[app.common.geom.shapes :as gsh]
[app.common.types.container :as ctn]
[app.common.types.path :as path]
@@ -28,6 +29,18 @@
:rx :ry :r1 :r2 :r3 :r4
:metadata])
+(defn- flatten-path
+ "Resets a path to axis-aligned geometry."
+ [shape]
+ (-> shape
+ (assoc :rotation 0
+ :flip-x false
+ :flip-y false
+ :transform (gmt/matrix)
+ :transform-inverse (gmt/matrix))
+ (dissoc :selrect :points)
+ (path/update-geometry)))
+
(defn convert-selected-to-path
([]
(convert-selected-to-path nil))
@@ -53,18 +66,21 @@
(pcb/update-shapes
selected
(fn [shape]
- (let [content (wasm.api/shape-to-path (:id shape))]
- (-> shape
- (assoc :type :path)
- (cond-> (cph/text-shape? shape)
- (assoc :fills
- (->> (txt/node-seq txt/is-text-node? (:content shape))
- (map :fills)
- (first))))
- (cond-> (cph/image-shape? shape)
- (assoc :fill-image (get shape :metadata)))
- (d/without-keys dissoc-attrs)
- (path/update-geometry content)))))
+ ;; Keep path content in world coordinates.
+ (if (cph/path-shape? shape)
+ (flatten-path shape)
+ (let [content (wasm.api/shape-to-path (:id shape))]
+ (-> shape
+ (assoc :type :path)
+ (cond-> (cph/text-shape? shape)
+ (assoc :fills
+ (->> (txt/node-seq txt/is-text-node? (:content shape))
+ (map :fills)
+ (first))))
+ (cond-> (cph/image-shape? shape)
+ (assoc :fill-image (get shape :metadata)))
+ (d/without-keys dissoc-attrs)
+ (path/update-geometry content))))))
(pcb/remove-objects children-ids))]
(rx/of (dch/commit-changes changes)))
diff --git a/frontend/src/app/main/data/workspace/path/shortcuts.cljs b/frontend/src/app/main/data/workspace/path/shortcuts.cljs
index 24444d711d..5308ccee51 100644
--- a/frontend/src/app/main/data/workspace/path/shortcuts.cljs
+++ b/frontend/src/app/main/data/workspace/path/shortcuts.cljs
@@ -9,6 +9,8 @@
[app.main.data.shortcuts :as ds]
[app.main.data.workspace :as dw]
[app.main.data.workspace.path :as drp]
+ [app.main.data.workspace.path.common :as drp.common]
+ [app.main.data.workspace.path.state :as drp.state]
[app.main.store :as st]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@@ -19,12 +21,24 @@
;; Shortcuts format https://github.com/ccampbell/mousetrap
-(defn esc-pressed []
+(defn esc-pressed
+ "Maps Escape to finish, cancel, or exit for the current draw state."
+ []
(ptk/reify ::esc-pressed
ptk/WatchEvent
- (watch [_ _ _]
- ;; Not interrupt when we're editing a path
- (rx/of :interrupt))))
+ (watch [_ state _]
+ (let [id (drp.state/get-path-id state)
+ pending? (some? (get-in state [:workspace-local :edit-path id :last-point]))
+ edition (get-in state [:workspace-local :edition])]
+ (cond
+ (and pending? (nil? edition))
+ (rx/of (drp.common/finish-path))
+
+ pending?
+ (rx/of (drp.common/cancel-pending-segment))
+
+ :else
+ (rx/of :interrupt))))))
(def shortcuts
{:move-nodes {:tooltip "M"
@@ -45,7 +59,12 @@
:delete-node {:tooltip (ds/supr)
:command ["del" "backspace"]
:subsections [:path-editor]
- :fn #(st/emit! (drp/remove-node))}
+ :fn #(st/emit! (drp/delete-selected))}
+
+ :delete-node-and-segments {:tooltip (ds/shift (ds/supr))
+ :command ["shift+del" "shift+backspace"]
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/delete-selected-with-segments))}
:merge-nodes {:tooltip (ds/meta "J")
:command (ds/c-mod "j")
@@ -78,6 +97,46 @@
:subsections [:path-editor]
:fn #(st/emit! (drp/toggle-snap))}
+ :copy {:tooltip (ds/meta "C")
+ :command (ds/c-mod "c")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/copy-selected-nodes))}
+
+ :cut {:tooltip (ds/meta "X")
+ :command (ds/c-mod "x")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/cut-selected-nodes))}
+
+ :paste {:tooltip (ds/meta "V")
+ :command (ds/c-mod "v")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/paste-nodes))}
+
+ :duplicate {:tooltip (ds/meta "D")
+ :command (ds/c-mod "d")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/duplicate-selected))}
+
+ :select-all {:tooltip (ds/meta "A")
+ :command (ds/c-mod "a")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/select-all-nodes))}
+
+ :deselect-all {:tooltip (ds/meta (ds/shift "A"))
+ :command (ds/c-mod "shift+a")
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/deselect-all))}
+
+ :flip-horizontal {:tooltip (ds/shift "H")
+ :command "shift+h"
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/flip-nodes :horizontal))}
+
+ :flip-vertical {:tooltip (ds/shift "V")
+ :command "shift+v"
+ :subsections [:path-editor]
+ :fn #(st/emit! (drp/flip-nodes :vertical))}
+
:escape {:tooltip (ds/esc)
:command ["escape" "enter" "v"]
:fn #(st/emit! (esc-pressed))}
diff --git a/frontend/src/app/main/data/workspace/path/state.cljs b/frontend/src/app/main/data/workspace/path/state.cljs
index 87a0ebe64b..6a40322847 100644
--- a/frontend/src/app/main/data/workspace/path/state.cljs
+++ b/frontend/src/app/main/data/workspace/path/state.cljs
@@ -10,18 +10,50 @@
[app.common.types.path.shape-to-path :as stp]))
(defn get-path-id
- "Retrieves the currently editing path id"
+ "Returns the active path id.
+
+ The drawing copy is preferred because it also exists during initial path
+ creation, before workspace edition has an id. The edition id is the fallback
+ while an existing path's drawing copy is being established."
[state]
- (or (dm/get-in state [:workspace-local :edition])
- (dm/get-in state [:workspace-drawing :object :id])))
+ (or (dm/get-in state [:workspace-drawing :object :id])
+ (dm/get-in state [:workspace-local :edition])))
+
+(defn get-selection
+ "Returns the grouped selection for the active path or the supplied path id."
+ ([state]
+ (get-selection state (get-path-id state)))
+ ([state id]
+ (dm/get-in state [:workspace-local :edit-path id :selection])))
+
+(defn current-edit-state
+ ([state]
+ (current-edit-state (dm/get-in state [:workspace-local :edit-path])
+ (dm/get-in state [:workspace-local :edition])))
+ ([edit-path id]
+ (get edit-path id)))
+
+(defn editing?
+ ([state]
+ (some? (current-edit-state state)))
+ ([edit-path id]
+ (some? (current-edit-state edit-path id))))
+
+(defn drawing?
+ ([state]
+ (let [edition (dm/get-in state [:workspace-local :edition])
+ edit-path (dm/get-in state [:workspace-local :edit-path])]
+ (and (nil? edition)
+ (some? (get edit-path (get-path-id state))))))
+ ([edit-state edition drawing-tool drawing-object]
+ (or (= :draw (:edit-mode edit-state))
+ (and (nil? edition)
+ (= :path (:type drawing-object))
+ (not= :curve drawing-tool)))))
(defn get-path-location
- [state & ks]
- (if-let [edit-id (dm/get-in state [:workspace-local :edition])]
- (let [page-id (:current-page-id state)
- file-id (:current-file-id state)]
- (into [:files file-id :data :pages-index page-id :objects edit-id] ks))
- (into [:workspace-drawing :object] ks)))
+ [_state & ks]
+ (into [:workspace-drawing :object] ks))
(defn get-path
"Retrieves the location of the path object and additionally can pass
diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs
index 530cb6a977..8b941f721c 100644
--- a/frontend/src/app/main/data/workspace/path/streams.cljs
+++ b/frontend/src/app/main/data/workspace/path/streams.cljs
@@ -9,6 +9,7 @@
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.types.path :as path]
+ [app.main.data.workspace.edition :as-alias dwe]
[app.main.data.workspace.path.state :as pst]
[app.main.snap :as snap]
[app.main.store :as st]
@@ -20,24 +21,30 @@
(defonce drag-threshold 5)
+(def ^:private half-pixel-snap-zoom
+ "Zoom threshold for half-pixel snapping."
+ 3)
+
(defn dragging? [start zoom]
(fn [current]
(>= (gpt/distance start current) (/ drag-threshold zoom))))
-(defn finish-edition? [event]
- (= (ptk/type event) :app.main.data.workspace.common/clear-edition-mode))
+(defn finish-edition?
+ "True for the path edition stop event."
+ [event]
+ (= (ptk/type event) ::dwe/clear-edition-mode))
(defn to-pixel-snap [position]
(let [layout (get @st/state :workspace-layout)
- snap-pixel? (contains? layout :snap-pixel-grid)]
+ snap-pixel? (contains? layout :snap-pixel-grid)
+ zoom (get-in @st/state [:workspace-local :zoom] 1)]
(cond
(or (not snap-pixel?) (not (gpt/point? position)))
position
-
:else
- (gpt/round position))))
+ (gpt/round-step position (if (> zoom half-pixel-snap-zoom) 0.5 1)))))
(defn drag-stream
([to-stream]
@@ -79,13 +86,71 @@
(-> (l/derived get-snap st/state)
(rx/from-atom {:emit-current-value? true}))))
+(def ^:private node-merge-snap-distance
+ "Maximum screen distance for node merge snapping."
+ 10)
+
+(def ^:private neighboring-cell-offsets
+ [[-1 -1] [-1 0] [-1 1]
+ [0 -1] [0 0] [0 1]
+ [1 -1] [1 0] [1 1]])
+
+(defn- point-cell
+ [point cell-size]
+ [(js/Math.floor (/ (:x point) cell-size))
+ (js/Math.floor (/ (:y point) cell-size))])
+
+(defn make-node-merge-snap
+ "Builds a stationary-node index and returns its merge snap function."
+ [start-point selected-points points max-distance]
+ (let [selected-points (set selected-points)
+ point-index (reduce
+ (fn [index point]
+ (if (contains? selected-points point)
+ index
+ (update index (point-cell point max-distance) (fnil conj []) point)))
+ {}
+ points)
+ closest-target (fn [closest moved-point]
+ (let [[cell-x cell-y] (point-cell moved-point max-distance)]
+ (reduce
+ (fn [closest [offset-x offset-y]]
+ (reduce
+ (fn [closest target]
+ (let [distance (gpt/distance moved-point target)]
+ (if (and (<= distance max-distance)
+ (or (nil? closest)
+ (< distance (first closest))))
+ [distance (gpt/subtract target moved-point)]
+ closest)))
+ closest
+ (get point-index [(+ cell-x offset-x) (+ cell-y offset-y)] [])))
+ closest
+ neighboring-cell-offsets)))]
+ (fn [position]
+ (let [delta (gpt/subtract position start-point)
+ closest (reduce
+ (fn [closest selected-point]
+ (closest-target closest (gpt/add selected-point delta)))
+ nil
+ selected-points)]
+ (when (some? closest)
+ (gpt/add position (second closest)))))))
+
(defn move-points-stream
[start-point selected-points points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
+ snap-pixel? (contains? (get @st/state :workspace-layout) :snap-pixel-grid)
ranges (snap/create-ranges points selected-points)
d-pos (/ snap/snap-path-accuracy zoom)
+ ;; Build the merge index once per pixel-snapped gesture.
+ merge-distance (/ node-merge-snap-distance zoom)
+ node-merge-snap (when snap-pixel?
+ (make-node-merge-snap
+ start-point selected-points points merge-distance))
+
check-path-snap
(fn [[position snap-toggled]]
(if snap-toggled
@@ -93,16 +158,23 @@
moved-points (->> selected-points (mapv #(gpt/add % delta)))
snap (snap/get-snap-delta moved-points ranges d-pos)]
(gpt/add position snap))
+ position))
+
+ ;; Node merge snapping takes priority over the pixel grid.
+ snap-position
+ (fn [[position snap-toggled]]
+ (if (gpt/point? position)
+ (or (when node-merge-snap
+ (node-merge-snap position))
+ (check-path-snap [(to-pixel-snap position) snap-toggled]))
position))]
(->> ms/mouse-position
- (rx/map to-pixel-snap)
(rx/with-latest-from (snap-toggled-stream))
- (rx/map check-path-snap)
- (rx/with-latest-from
- (fn [position shift? alt?]
- (assoc position :shift? shift? :alt? alt?))
- ms/mouse-position-shift
- ms/mouse-position-alt))))
+ (rx/map snap-position)
+ ;; Apply keyboard modifiers without waiting for pointer movement.
+ (rx/combine-latest-with ms/keyboard-shift ms/keyboard-alt)
+ (rx/map (fn [[position shift? alt?]]
+ (assoc position :shift? shift? :alt? alt?))))))
(defn get-angle [node handler opposite]
(when (and (some? node) (some? handler) (some? opposite))
@@ -144,13 +216,13 @@
(merge position (gpt/add position snap)))))
position))]
+ ;; Keep handler movement off the pixel grid.
(->> ms/mouse-position
- (rx/map to-pixel-snap)
- (rx/with-latest-from
- (fn [position shift? alt?]
- (assoc position :shift? shift? :alt? alt?))
- ms/mouse-position-shift
- ms/mouse-position-alt)
+ (rx/filter gpt/point?)
+ ;; Apply keyboard modifiers without waiting for pointer movement.
+ (rx/combine-latest-with ms/keyboard-shift ms/keyboard-alt ms/keyboard-mod)
+ (rx/map (fn [[position shift? alt? mod?]]
+ (assoc position :shift? shift? :alt? alt? :mod? mod?)))
(rx/with-latest-from (snap-toggled-stream))
(rx/map check-path-snap))))
@@ -171,6 +243,8 @@
(rx/map snap/create-ranges))]
(->> ms/mouse-position
+ ;; The subject can hold nil until the pointer enters the viewport
+ (rx/filter gpt/point?)
(rx/map to-pixel-snap)
(rx/with-latest-from ranges-stream (snap-toggled-stream))
(rx/map (fn [[position ranges snap-toggled]]
@@ -178,8 +252,7 @@
(let [snap (snap/get-snap-delta [position] ranges d-pos)]
(gpt/add position snap))
position)))
- (rx/with-latest-from
- (fn [position shift? alt?]
- (assoc position :shift? shift? :alt? alt?))
- ms/mouse-position-shift
- ms/mouse-position-alt))))
+ ;; Apply Shift without waiting for pointer movement.
+ (rx/combine-latest-with ms/keyboard-shift ms/keyboard-alt)
+ (rx/map (fn [[position shift? alt?]]
+ (assoc position :shift? shift? :alt? alt?))))))
diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs
index 56a752df03..78c772e0b0 100644
--- a/frontend/src/app/main/data/workspace/path/tools.cljs
+++ b/frontend/src/app/main/data/workspace/path/tools.cljs
@@ -6,50 +6,56 @@
(ns app.main.data.workspace.path.tools
(:require
+ [app.common.data :as d]
[app.common.data.macros :as dm]
+ [app.common.geom.point :as gpt]
[app.common.types.path :as path]
- [app.main.data.changes :as dch]
- [app.main.data.helpers :as dsh]
[app.main.data.workspace.edition :as dwe]
- [app.main.data.workspace.path.changes :as changes]
+ [app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as st]
- [app.main.data.workspace.shapes :as dwsh]
+ [app.main.store :as store]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
(defn process-path-tool
- "Generic function that executes path transformations with the content and selected nodes"
+ "Runs a position-based path tool and remaps the selection."
([tool-fn]
(process-path-tool nil tool-fn))
([points tool-fn]
(ptk/reify ::process-path-tool
- ptk/WatchEvent
- (watch [it state _]
- (let [page-id (get state :current-page-id)
- objects (dsh/lookup-page-objects state page-id)
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [shape (st/get-path state)
+ id (st/get-path-id state)
- shape (st/get-path state)
- id (st/get-path-id state)
+ old-content (:content shape)
- selected-points
- (dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
+ ;; Segment selections include their endpoint nodes.
+ selected-nodes
+ (helpers/selected-node-indices
+ old-content
+ (st/get-selection state id))
points
- (or points selected-points)]
+ (or points (helpers/node-positions old-content selected-nodes))]
- (when (and (seq points) (some? shape))
+ (if (and (seq points) (some? shape))
(let [new-content
- (-> (tool-fn (:content shape) points)
- (path/close-subpaths))
+ (-> (tool-fn old-content points)
+ (path/close-subpaths))]
+ (-> (cond-> (st/set-content state new-content)
+ (seq new-content)
+ (update-in (st/get-path-location state) path/update-geometry))
+ (update-in [:workspace-local :edit-path id :selection]
+ #(helpers/remap-selection % old-content new-content))
+ (update-in [:workspace-local :edit-path id :handler-types]
+ #(helpers/remap-handler-types % old-content new-content))))
+ state)))
- changes
- (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
-
- (rx/concat
- (rx/of (dwsh/update-shapes [id] path/convert-to-path)
- (dch/commit-changes changes))
- (when (empty? new-content)
- (rx/of (dwe/clear-edition-mode)))))))))))
+ ptk/WatchEvent
+ (watch [_ state _]
+ (when (empty? (st/get-path state :content))
+ (rx/of (dwe/clear-edition-mode)))))))
(defn make-corner
([]
@@ -58,7 +64,9 @@
(process-path-tool
(when point #{point})
(fn [content points]
- (reduce path/make-corner-point content points)))))
+ (->> points
+ (filter #(path/is-curve-point? content %))
+ (reduce path/make-corner-point content))))))
(defn make-curve
([]
@@ -67,13 +75,154 @@
(process-path-tool
(when point #{point})
(fn [content points]
- (reduce path/make-curve-point content points)))))
+ (->> points
+ (remove #(path/is-curve-point? content %))
+ (reduce path/make-curve-point content))))))
+
+(defn- apply-handler-type-modifiers
+ "Returns modifiers that reshape a node's handlers to `type`."
+ [content node-index type]
+ (if-let [[idx prefix] (helpers/node-primary-handler content node-index)]
+ (case type
+ :mirror (helpers/move-handler-modifiers content idx prefix true true true 0 0)
+ :aligned (helpers/align-handler-modifiers content idx prefix 0 0)
+ {})
+ {}))
+
+(defn set-handler-type
+ "Sets and stores the handler behavior of selected nodes."
+ [type]
+ (ptk/reify ::set-handler-type
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ nodes (helpers/handler-target-nodes content selection)]
+ (if (and (some? content) (seq nodes))
+ (let [modifiers (reduce (fn [acc node-index]
+ (d/deep-merge acc (apply-handler-type-modifiers content node-index type)))
+ {} nodes)
+ new-content (path/apply-content-modifiers content modifiers)]
+ (-> (st/set-content state new-content)
+ (update-in (st/get-path-location state) path/update-geometry)
+ (update-in [:workspace-local :edit-path id :handler-types]
+ (fn [ht] (reduce #(assoc %1 %2 type) (or ht {}) nodes)))))
+ state)))))
(defn add-node []
(process-path-tool (fn [content points] (path/split-segments content points 0.5))))
-(defn remove-node []
- (process-path-tool path/remove-nodes))
+(defn remove-node
+ "Removes nodes and heals the gap with a fitted curve."
+ ([]
+ (process-path-tool path/remove-nodes))
+ ([point]
+ (process-path-tool #{point} path/remove-nodes)))
+
+(defn toggle-node-curve
+ "Toggles a node between a corner and a curve."
+ [index]
+ (ptk/reify ::toggle-node-curve
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [content (st/get-path state :content)]
+ (when (and (some? content)
+ (< index (count content))
+ (helpers/node? content index))
+ (let [point (helpers/node-position content index)]
+ (rx/of (if (path/is-curve-point? content point)
+ (make-corner point)
+ (make-curve point)))))))))
+
+(defn- update-path-content
+ "Updates path content, geometry, selection, and handler types."
+ [state new-content]
+ (let [id (st/get-path-id state)
+ old-content (st/get-path state :content)]
+ (-> (cond-> (st/set-content state new-content)
+ (seq new-content)
+ (update-in (st/get-path-location state) path/update-geometry))
+ (update-in [:workspace-local :edit-path id :selection]
+ #(helpers/remap-selection % old-content new-content))
+ (update-in [:workspace-local :edit-path id :handler-types]
+ #(helpers/remap-handler-types % old-content new-content)))))
+
+(defn remove-segments
+ "Removes segments and opens the path at their endpoints."
+ [indices]
+ (ptk/reify ::remove-segments
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (st/get-path state :content)]
+ (if (and (some? content) (seq indices))
+ (update-path-content state (path/remove-segments content indices))
+ state)))
+
+ ptk/WatchEvent
+ (watch [_ state _]
+ (when (empty? (st/get-path state :content))
+ (rx/of (dwe/clear-edition-mode))))))
+
+(defn remove-segment
+ [index]
+ (remove-segments #{index}))
+
+(defn remove-node-with-segments
+ "Removes a node and its incident segments without healing the gap."
+ [index]
+ (ptk/reify ::remove-node-with-segments
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [content (st/get-path state :content)
+ incident (into #{}
+ (comp (filter #(or (= index (:to-index %))
+ (= index (:from-index %))))
+ (map :index))
+ (helpers/segment-entries content))]
+ (when (seq incident)
+ (rx/of (remove-segments incident)))))))
+
+(defn delete-selected-with-segments
+ "Removes selected nodes and their incident segments without healing."
+ []
+ (ptk/reify ::delete-selected-with-segments
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selected (helpers/selected-node-indices
+ content
+ (st/get-selection state id))
+ incident (into #{}
+ (comp (filter #(or (contains? selected (:to-index %))
+ (contains? selected (:from-index %))))
+ (map :index))
+ (helpers/segment-entries content))]
+ (when (seq incident)
+ (rx/of (remove-segments incident)))))))
+
+(defn toggle-segment-curve
+ "Toggles a segment between a line and a curve."
+ [index]
+ (ptk/reify ::toggle-segment-curve
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (st/get-path state :content)]
+ (if (some? content)
+ (update-path-content state (path/toggle-segment-curve content index))
+ state)))))
+
+(defn remove-handler
+ "Collapses one handler onto its node."
+ [index prefix]
+ (ptk/reify ::remove-handler
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [content (st/get-path state :content)]
+ (if (some? content)
+ (update-path-content state (path/collapse-handler content index prefix))
+ state)))))
(defn merge-nodes []
(process-path-tool path/merge-nodes))
@@ -81,8 +230,157 @@
(defn join-nodes []
(process-path-tool path/join-nodes))
+(def ^:private separate-node-screen-offset
+ "Screen offset between separated node ends."
+ 8)
+
(defn separate-nodes []
- (process-path-tool path/separate-nodes))
+ ;; Keep the visible gap stable across zoom levels.
+ (let [zoom (get-in @store/state [:workspace-local :zoom] 1)
+ step (/ separate-node-screen-offset zoom)
+ offset (gpt/point step step)]
+ (process-path-tool
+ (fn [content points]
+ (path/separate-nodes content points offset)))))
+
+(defn delete-selected
+ "Heals selected nodes or opens selected segments."
+ []
+ (ptk/reify ::delete-selected
+ ptk/WatchEvent
+ (watch [_ state _]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ nodes (get selection :nodes #{})
+ segments (get selection :segments #{})]
+ (rx/of
+ (cond
+ ;; Node selection takes priority in mixed selections.
+ (seq nodes)
+ (process-path-tool (helpers/node-positions content nodes) path/remove-nodes)
+
+ ;; Segment-only selection opens the path.
+ (seq segments)
+ (separate-nodes)
+
+ :else
+ (remove-node)))))))
+
+(defn flip-nodes
+ "Flips selected nodes, or the whole path when none are selected."
+ [axis]
+ (ptk/reify ::flip-nodes
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selected (helpers/selected-node-indices
+ content
+ (st/get-selection state id))
+ indices (if (seq selected)
+ selected
+ (helpers/node-indices content))
+ content (path/flip-content content indices axis)]
+ (-> (st/set-content state content)
+ (update-in (st/get-path-location state) path/update-geometry))))))
+
+(defn align-nodes
+ "Aligns selected nodes and their handles within their bounds."
+ [axis]
+ (ptk/reify ::align-nodes
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selected (get (st/get-selection state id) :nodes #{})
+ content (path/align-content content selected axis)]
+ (-> (st/set-content state content)
+ (update-in (st/get-path-location state) path/update-geometry))))))
+
+(defn distribute-nodes
+ "Distributes selected nodes evenly along `axis`."
+ [axis]
+ (ptk/reify ::distribute-nodes
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selected (get (st/get-selection state id) :nodes #{})
+ content (path/distribute-content content selected axis)]
+ (-> (st/set-content state content)
+ (update-in (st/get-path-location state) path/update-geometry))))))
+
+(defn- axis-point
+ "Copy of `p` with `axis` (`:x`/`:y`) replaced by `value`."
+ [p axis value]
+ (if (= axis :x) (gpt/point value (:y p)) (gpt/point (:x p) value)))
+
+(defn- handler-target-points
+ "Returns handler targets for an absolute coordinate edit."
+ [content handlers handler-types axis value]
+ (reduce
+ (fn [pts [index prefix]]
+ (let [hp (path/get-handler-point content index prefix)
+ hp' (axis-point hp axis value)
+ node-index (helpers/handler-node-index index prefix)
+ mode (or (get handler-types node-index)
+ (helpers/derive-handler-type content node-index))
+ [op-idx op-prefix] (path/opposite-index content index prefix)
+ pts (assoc pts [index prefix] hp')]
+ (if (and (contains? #{:mirror :aligned} mode) (some? op-idx))
+ (let [node (path/handler->node content index prefix)
+ opp (path/get-handler-point content op-idx op-prefix)
+ opp' (helpers/opposite-handler-target node hp' opp mode)]
+ (assoc pts [op-idx op-prefix] opp'))
+ pts)))
+ {}
+ handlers))
+
+(defn- translated-handler-target-points
+ "Returns standalone handler targets for a group translation."
+ [content handlers node-indices delta]
+ (into {}
+ (comp
+ (remove (fn [[index prefix]]
+ (contains? node-indices
+ (helpers/handler-node-index index prefix))))
+ (keep (fn [[index prefix :as identity]]
+ (when-let [point (path/get-handler-point content index prefix)]
+ [identity (gpt/add point delta)]))))
+ handlers))
+
+(defn set-selection-coordinate
+ "Sets one coordinate of the current path selection."
+ [axis value]
+ (ptk/reify ::set-selection-coordinate
+ ptk/UpdateEvent
+ (update [_ state]
+ (let [id (st/get-path-id state)
+ content (st/get-path state :content)
+ selection (st/get-selection state id)
+ htypes (dm/get-in state [:workspace-local :edit-path id :handler-types])
+ segments (get selection :segments #{})
+ handlers (get selection :handlers #{})
+ node-idx (helpers/selected-node-indices content selection)
+
+ new-content
+ (if (seq segments)
+ ;; Translate segment selections as one group.
+ (let [rect (helpers/selection-coordinate-rect content selection)
+ cur (if (= axis :x) (dm/get-prop rect :x) (dm/get-prop rect :y))
+ delta (axis-point (gpt/point 0 0) axis (- value cur))
+ htargets (translated-handler-target-points
+ content handlers node-idx delta)]
+ (cond-> (path/translate-selected-nodes content node-idx delta)
+ (seq htargets) (path/set-handler-points htargets)))
+ ;; Set node and handler coordinates directly.
+ (let [pts (handler-target-points content handlers htypes axis value)]
+ (cond-> content
+ (seq node-idx) (path/set-nodes-coordinate node-idx axis value)
+ (seq pts) (path/set-handler-points pts))))]
+ (-> (st/set-content state new-content)
+ (update-in (st/get-path-location state) path/update-geometry))))))
(defn toggle-snap []
(ptk/reify ::toggle-snap
diff --git a/frontend/src/app/main/data/workspace/path/undo.cljs b/frontend/src/app/main/data/workspace/path/undo.cljs
index 76a9f35f62..ccebd5650a 100644
--- a/frontend/src/app/main/data/workspace/path/undo.cljs
+++ b/frontend/src/app/main/data/workspace/path/undo.cljs
@@ -12,8 +12,8 @@
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.edition :as-alias dwe]
[app.main.data.workspace.pages :as-alias dwpg]
- [app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
+ [app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as st]
[app.main.store :as store]
[beicon.v2.core :as rx]
@@ -28,17 +28,17 @@
[event]
(= :app.main.data.workspace.common/redo (ptk/type event)))
+;; Undo entries skip the render-only preview.
(defn- make-entry [state]
(let [id (st/get-path-id state)
shape (st/get-path state)]
{:content (:content shape)
:selrect (:selrect shape)
:points (:points shape)
- :preview (get-in state [:workspace-local :edit-path id :preview])
:last-point (get-in state [:workspace-local :edit-path id :last-point])
:prev-handler (get-in state [:workspace-local :edit-path id :prev-handler])}))
-(defn- load-entry [state {:keys [content selrect points preview last-point prev-handler]}]
+(defn- load-entry [state {:keys [content selrect points last-point prev-handler]}]
(let [id (st/get-path-id state)
old-content (st/get-path state :content)]
(-> state
@@ -47,11 +47,14 @@
(d/assoc-in-when (st/get-path-location state :points) points)
(d/update-in-when
[:workspace-local :edit-path id]
- assoc
- :preview preview
- :last-point last-point
- :prev-handler prev-handler
- :old-content old-content))))
+ (fn [edit-state]
+ ;; Remap the selection to the restored content.
+ (cond-> (assoc edit-state
+ :preview nil
+ :last-point last-point
+ :prev-handler prev-handler)
+ (some? content)
+ (update :selection helpers/remap-selection old-content content)))))))
(defn undo-path []
(ptk/reify ::undo-path
@@ -72,10 +75,8 @@
(watch [_ state _]
(let [id (st/get-path-id state)
undo-stack (get-in state [:workspace-local :edit-path id :undo-stack])]
- (if (> (:index undo-stack) 0)
- (rx/of (changes/save-path-content {:preserve-move-to true}))
- (rx/of (changes/save-path-content {:preserve-move-to true})
- (common/finish-path)
+ (when (zero? (:index undo-stack))
+ (rx/of (common/finish-path)
(dwc/show-toolbar)))))))
(defn redo-path []
@@ -90,11 +91,7 @@
(load-entry entry)
(d/assoc-in-when
[:workspace-local :edit-path id :undo-stack]
- undo-stack))))
-
- ptk/WatchEvent
- (watch [_ _ _]
- (rx/of (changes/save-path-content)))))
+ undo-stack))))))
(defn merge-head
"Joins the head with the previous undo in one. This is done so when the user changes a
@@ -171,4 +168,3 @@
(rx/map #(add-undo-entry)))
(rx/of (end-path-undo))))))))))
-
diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs
index d0e612b493..a03ab349f7 100644
--- a/frontend/src/app/main/data/workspace/transforms.cljs
+++ b/frontend/src/app/main/data/workspace/transforms.cljs
@@ -23,6 +23,8 @@
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm]
+ [app.common.types.path :as path]
+ [app.common.types.path.helpers :as path.helpers]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.attrs :refer [editable-attrs]]
[app.common.types.shape.layout :as ctl]
@@ -363,6 +365,71 @@
(dwm/apply-modifiers)
(finish-transform))))))))))))
+(defn start-move-line-point
+ "Drags one endpoint of a straight path while keeping the other fixed."
+ [shape index]
+ (ptk/reify ::start-move-line-point
+ ptk/WatchEvent
+ (watch [_ state stream]
+ (let [id (dm/get-prop shape :id)
+ page-id (:current-page-id state)
+ objects (dsh/lookup-page-objects state page-id)
+ zoom (dm/get-in state [:workspace-local :zoom] 1)
+ layout (:workspace-layout state)
+ focus (:workspace-focus-selected state)
+
+ content (dm/get-prop shape :content)
+ start-point (path.helpers/segment->point (nth content index))
+ other-point (path.helpers/segment->point (nth content (if (zero? index) 1 0)))
+
+ stopper (mse/drag-stopper stream)
+
+ ;; Shift constrains the endpoint around the fixed point.
+ position-stream
+ (->> ms/mouse-position
+ (rx/filter some?)
+ (rx/with-latest-from ms/mouse-position-shift)
+ (rx/switch-map
+ (fn [[pos shift?]]
+ (if ^boolean shift?
+ (rx/of (path.helpers/position-fixed-angle pos other-point))
+ (snap/closest-snap-point page-id [shape] objects layout zoom focus pos))))
+ (rx/share))
+
+ move-endpoint
+ (fn [pos save-undo?]
+ (let [delta (gpt/to-vec start-point pos)]
+ (dwsh/update-shapes
+ [id]
+ (fn [_]
+ (-> shape
+ (assoc :content (path/apply-content-modifiers
+ content
+ {index {:x (dm/get-prop delta :x)
+ :y (dm/get-prop delta :y)}}))
+ (path/update-geometry)))
+ {:reg-objects? true :save-undo? save-undo?})))]
+
+ ;; Hide selection controls during the drag.
+ (rx/concat
+ (rx/of #(assoc-in % [:workspace-local :transform] :move))
+ ;; Subscribe the preview and commit branches together.
+ (rx/merge
+ ;; Preview without creating undo entries.
+ (->> position-stream
+ (rx/sample mconst/move-sample-time)
+ (rx/map #(move-endpoint % false))
+ (rx/take-until stopper))
+ ;; Commit the final position as one undo step.
+ (->> position-stream
+ (rx/take-until stopper)
+ (rx/last)
+ (rx/mapcat
+ (fn [pos]
+ (rx/of (move-endpoint start-point false)
+ (move-endpoint pos true))))))
+ (rx/of #(assoc-in % [:workspace-local :transform] nil)))))))
+
(defn trigger-bounding-box-cloaking
"Trigger the bounding box cloaking (with default timer of 1sec)
diff --git a/frontend/src/app/main/refs.cljs b/frontend/src/app/main/refs.cljs
index a73ae9b872..765cbde5e1 100644
--- a/frontend/src/app/main/refs.cljs
+++ b/frontend/src/app/main/refs.cljs
@@ -222,6 +222,9 @@
(def selected-edition
(l/derived :edition workspace-local))
+(def workspace-edit-path
+ (l/derived :edit-path workspace-local))
+
(def current-transform
(l/derived :transform workspace-local))
diff --git a/frontend/src/app/main/ui/css_cursors.cljs b/frontend/src/app/main/ui/css_cursors.cljs
index 9c0a97276e..8541d7bedf 100644
--- a/frontend/src/app/main/ui/css_cursors.cljs
+++ b/frontend/src/app/main/ui/css_cursors.cljs
@@ -40,9 +40,21 @@
(init-static-cursor-style style "create-polygon" cur/create-polygon)
(init-static-cursor-style style "create-rectangle" cur/create-rectangle)
(init-static-cursor-style style "create-shape" cur/create-shape)
+ (init-static-cursor-style style "draw" cur/draw)
+ (init-static-cursor-style style "draw-add" cur/draw-add)
+ (init-static-cursor-style style "draw-node" cur/draw-node)
+ (init-static-cursor-style style "draw-remove" cur/draw-remove)
(init-static-cursor-style style "duplicate" cur/duplicate)
(init-static-cursor-style style "hand" cur/hand)
+ (init-static-cursor-style style "move" cur/move)
+ (init-static-cursor-style style "move-add" cur/move-add)
+ (init-static-cursor-style style "move-copy" cur/move-copy)
+ (init-static-cursor-style style "move-curve" cur/move-curve)
+ (init-static-cursor-style style "move-handles" cur/move-handles)
+ (init-static-cursor-style style "move-move" cur/move-move)
+ (init-static-cursor-style style "move-node" cur/move-node)
(init-static-cursor-style style "move-pointer" cur/move-pointer)
+ (init-static-cursor-style style "move-remove" cur/move-remove)
(init-static-cursor-style style "pen" cur/pen)
(init-static-cursor-style style "pen-node" cur/pen-node)
(init-static-cursor-style style "pencil" cur/pencil)
diff --git a/frontend/src/app/main/ui/cursors.clj b/frontend/src/app/main/ui/cursors.clj
index b55b560766..fdc294917f 100644
--- a/frontend/src/app/main/ui/cursors.clj
+++ b/frontend/src/app/main/ui/cursors.clj
@@ -17,6 +17,7 @@
(def default-hotspot-y 12)
(def default-rotation 0)
(def default-height 20)
+(def default-width 20)
(defn parse-svg [svg-data]
(-> svg-data
@@ -51,7 +52,7 @@
(str/replace #"\s+$" "")))
(defn encode-svg-cursor
- [id rotation x y height]
+ [id rotation x y height width]
(let [svg-path (str cursor-folder "/" (name id) ".svg")
data (-> svg-path io/resource slurp parse-svg)
data (u/percent-encode data)
@@ -59,15 +60,16 @@
data (if rotation
(str/fmt "%3Cg transform='rotate(%s 8,8)'%3E%s%3C/g%3E" rotation data)
data)]
- (str "url(\"data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 16 16' width='20px' "
+ (str "url(\"data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 16 16' width='" width "px' "
"height='" height "px' %3E" data "%3C/svg%3E\") " x " " y ", auto")))
(defmacro cursor-ref
- "Creates a static cursor given its name, rotation and x/y hotspot"
- ([id] (encode-svg-cursor id default-rotation default-hotspot-x default-hotspot-y default-height))
- ([id rotation] (encode-svg-cursor id rotation default-hotspot-x default-hotspot-y default-height))
- ([id rotation x y] (encode-svg-cursor id rotation x y default-height))
- ([id rotation x y height] (encode-svg-cursor id rotation x y height)))
+ "Creates a static SVG cursor."
+ ([id] (encode-svg-cursor id default-rotation default-hotspot-x default-hotspot-y default-height default-width))
+ ([id rotation] (encode-svg-cursor id rotation default-hotspot-x default-hotspot-y default-height default-width))
+ ([id rotation x y] (encode-svg-cursor id rotation x y default-height default-width))
+ ([id rotation x y height] (encode-svg-cursor id rotation x y height default-width))
+ ([id rotation x y height width] (encode-svg-cursor id rotation x y height width)))
(defmacro cursor-fn
"Creates a dynamic cursor that can be rotated in runtime"
@@ -75,7 +77,8 @@
(let [[cp1 cp2] (-> (encode-svg-cursor id "$$$"
default-hotspot-x
default-hotspot-y
- default-height)
+ default-height
+ default-width)
(str/split #"\$\$\$"))]
`(fn [rot#]
(str/concat ~cp1 (+ ~initial rot#) ~cp2))))
diff --git a/frontend/src/app/main/ui/cursors.cljs b/frontend/src/app/main/ui/cursors.cljs
index e618b6014a..90667c3f4f 100644
--- a/frontend/src/app/main/ui/cursors.cljs
+++ b/frontend/src/app/main/ui/cursors.cljs
@@ -14,9 +14,21 @@
(def ^:cursor create-polygon (cursor-ref :create-polygon))
(def ^:cursor create-rectangle (cursor-ref :create-rectangle))
(def ^:cursor create-shape (cursor-ref :create-shape))
+(def ^:cursor draw (cursor-ref :draw 0 0 0))
+(def ^:cursor draw-add (cursor-ref :draw-add 0 0 0 25 25))
+(def ^:cursor draw-node (cursor-ref :draw-node 0 0 0 25 25))
+(def ^:cursor draw-remove (cursor-ref :draw-remove 0 0 0 25 25))
(def ^:cursor duplicate (cursor-ref :duplicate 0 0 0))
(def ^:cursor hand (cursor-ref :hand))
+(def ^:cursor move (cursor-ref :move 0 0 0 25 25))
+(def ^:cursor move-add (cursor-ref :move-add 0 0 0 25 25))
+(def ^:cursor move-copy (cursor-ref :move-copy 0 0 0 25 25))
+(def ^:cursor move-curve (cursor-ref :move-curve 0 0 0 25 25))
+(def ^:cursor move-handles (cursor-ref :move-handles 0 0 0 25 25))
+(def ^:cursor move-move (cursor-ref :move-move 0 0 0 25 25))
+(def ^:cursor move-node (cursor-ref :move-node 0 0 0 25 25))
(def ^:cursor move-pointer (cursor-ref :move-pointer))
+(def ^:cursor move-remove (cursor-ref :move-remove 0 0 0 25 25))
(def ^:cursor pen (cursor-ref :pen 0 0 0))
(def ^:cursor pen-node (cursor-ref :pen-node 0 0 10 36))
(def ^:cursor pencil (cursor-ref :pencil 0 0 24))
diff --git a/frontend/src/app/main/ui/icons.cljs b/frontend/src/app/main/ui/icons.cljs
index ee405fa7f8..a5392a2d5e 100644
--- a/frontend/src/app/main/ui/icons.cljs
+++ b/frontend/src/app/main/ui/icons.cljs
@@ -144,6 +144,9 @@
(def ^:icon group (icon-xref :group))
(def ^:icon gutter-horizontal (icon-xref :gutter-horizontal))
(def ^:icon gutter-vertical (icon-xref :gutter-vertical))
+(def ^:icon handlers-equal (icon-xref :handlers-equal))
+(def ^:icon handlers-independent (icon-xref :handlers-independent))
+(def ^:icon handlers-mirror (icon-xref :handlers-mirror))
(def ^:icon help (icon-xref :help))
(def ^:icon hide (icon-xref :hide))
(def ^:icon history (icon-xref :history))
@@ -219,6 +222,7 @@
(def ^:icon shown (icon-xref :shown))
(def ^:icon size-horizontal (icon-xref :size-horizontal))
(def ^:icon size-vertical (icon-xref :size-vertical))
+(def ^:icon snap (icon-xref :snap))
(def ^:icon snap-nodes (icon-xref :snap-nodes))
(def ^:icon status-alert (icon-xref :status-alert))
(def ^:icon status-tick (icon-xref :status-tick))
diff --git a/frontend/src/app/main/ui/measurements.cljs b/frontend/src/app/main/ui/measurements.cljs
index b775e7d1bb..3d51e5752d 100644
--- a/frontend/src/app/main/ui/measurements.cljs
+++ b/frontend/src/app/main/ui/measurements.cljs
@@ -9,11 +9,13 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
+ [app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.types.component :as ctk]
+ [app.common.types.path :as path]
[app.common.uuid :as uuid]
[app.main.constants :as mconst]
[app.main.ui.formats :as fmt]
@@ -214,6 +216,11 @@
single-shape (and (= (count shapes) 1) (first shapes))
+ ;; Straight paths use endpoint controls instead of a size badge.
+ single-line? (and single-shape
+ (cfh/path-shape? single-shape)
+ (path/single-line? (dm/get-prop single-shape :content)))
+
component-color? (if single-shape
(ctk/instance-head? single-shape)
(every? ctk/instance-head? shapes))
@@ -245,64 +252,65 @@
text-width (* (count text) badge-char-width)
badge-width (+ text-width (* 2 badge-padding-x))]
- (if has-rotation?
- (let [edge (get-edge-for-badge rotation)
- points (dm/get-prop single-shape :points)
+ (when-not ^boolean single-line?
+ (if has-rotation?
+ (let [edge (get-edge-for-badge rotation)
+ points (dm/get-prop single-shape :points)
- [ep1 ep2] (get-edge-points points edge)
+ [ep1 ep2] (get-edge-points points edge)
- mid-point (gpt/lerp ep1 ep2 0.5)
- normal (gpt/normal-right (gpt/subtract ep2 ep1))
+ mid-point (gpt/lerp ep1 ep2 0.5)
+ normal (gpt/normal-right (gpt/subtract ep2 ep1))
- rot-offset (case edge
- :bottom 0
- :right 270
- :top 180
- :left 90)
- badge-rot (+ rotation rot-offset)
- offset (+ badge-gap (/ badge-height 2))
+ rot-offset (case edge
+ :bottom 0
+ :right 270
+ :top 180
+ :left 90)
+ badge-rot (+ rotation rot-offset)
+ offset (+ badge-gap (/ badge-height 2))
- badge-x (- (/ badge-width 2))
- badge-y (- (/ badge-height 2))
- badge-cx (+ (:x mid-point) (* (:x normal) offset))
- badge-cy (+ (:y mid-point) (* (:y normal) offset))]
+ badge-x (- (/ badge-width 2))
+ badge-y (- (/ badge-height 2))
+ badge-cx (+ (:x mid-point) (* (:x normal) offset))
+ badge-cy (+ (:y mid-point) (* (:y normal) offset))]
- [:g.selection-size-badge {:pointer-events "none"
- :transform (dm/str "translate(" badge-cx "," badge-cy ") rotate(" badge-rot ")")}
- [:rect {:x badge-x
- :y badge-y
- :width badge-width
- :height badge-height
- :rx badge-radius
- :ry badge-radius
- :style {:fill badge-bg-color}}]
- [:text {:class (stl/css :badge-text)
- :x 0
- :y 0
- :text-anchor "middle"
- :dominant-baseline "middle"}
- text]])
+ [:g.selection-size-badge {:pointer-events "none"
+ :transform (dm/str "translate(" badge-cx "," badge-cy ") rotate(" badge-rot ")")}
+ [:rect {:x badge-x
+ :y badge-y
+ :width badge-width
+ :height badge-height
+ :rx badge-radius
+ :ry badge-radius
+ :style {:fill badge-bg-color}}]
+ [:text {:class (stl/css :badge-text)
+ :x 0
+ :y 0
+ :text-anchor "middle"
+ :dominant-baseline "middle"}
+ text]])
- (let [badge-x (- (/ badge-width 2))
- badge-y (- (/ badge-height 2))
- badge-cx (+ (:x selrect) (/ (:width selrect) 2))
- badge-cy (+ (:y selrect) (:height selrect) badge-gap (/ badge-height 2))]
+ (let [badge-x (- (/ badge-width 2))
+ badge-y (- (/ badge-height 2))
+ badge-cx (+ (:x selrect) (/ (:width selrect) 2))
+ badge-cy (+ (:y selrect) (:height selrect) badge-gap (/ badge-height 2))]
- [:g.selection-size-badge {:pointer-events "none"
- :transform (dm/str "translate(" badge-cx "," badge-cy ")")}
- [:rect {:x badge-x
- :y badge-y
- :width badge-width
- :height badge-height
- :rx badge-radius
- :ry badge-radius
- :style {:fill badge-bg-color}}]
- [:text {:class (stl/css :badge-text)
- :x 0
- :y 0
- :text-anchor "middle"
- :dominant-baseline "middle"}
- text]]))))
+ [:g.selection-size-badge {:pointer-events "none"
+ :transform (dm/str "translate(" badge-cx "," badge-cy ")")}
+ [:rect {:x badge-x
+ :y badge-y
+ :width badge-width
+ :height badge-height
+ :rx badge-radius
+ :ry badge-radius
+ :style {:fill badge-bg-color}}]
+ [:text {:class (stl/css :badge-text)
+ :x 0
+ :y 0
+ :text-anchor "middle"
+ :dominant-baseline "middle"}
+ text]])))))
(mf/defc distance-display* [{:keys [from to zoom bounds]}]
(let [fixed-x (if (gsh/fully-contained? from to)
@@ -384,4 +392,3 @@
[:> selection-rect* {:type :hover :selrect hover-selrect :zoom zoom}]
[:> size-display* {:selrect hover-selrect :zoom zoom}]
[:> distance-display* {:from hover-selrect :to selected-selrect :zoom zoom :bounds bounds-selrect}]])])))
-
diff --git a/frontend/src/app/main/ui/workspace/context_menu.cljs b/frontend/src/app/main/ui/workspace/context_menu.cljs
index eb8b06f9cb..64e9e015df 100644
--- a/frontend/src/app/main/ui/workspace/context_menu.cljs
+++ b/frontend/src/app/main/ui/workspace/context_menu.cljs
@@ -501,7 +501,10 @@
:shortcut-key :start-editing
:on-click do-start-editing}])
- (when-not (or disable-flatten has-frame? has-path?)
+ ;; Flattening a single path bakes its transform.
+ (when (and (not disable-flatten)
+ (not has-frame?)
+ (or (not has-path?) (and single? has-path?)))
[:> menu-entry* {:title (tr "workspace.shape.menu.flatten")
:on-click do-transform-to-path}])
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 34b00faf93..89d77e4e35 100644
--- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
@@ -12,14 +12,16 @@
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.main.data.workspace.path :as drp]
+ [app.main.data.workspace.path.helpers :as dwp.helpers]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.css-cursors :as cur]
[app.main.ui.hooks :as hooks]
+ [app.main.ui.workspace.viewport.viewport-ref :as uwvv]
[app.util.dom :as dom]
[app.util.keyboard :as kbd]
- [clojure.set :refer [map-invert]]
+ [beicon.v2.core :as rx]
[goog.events :as events]
[rumext.v2 :as mf]))
@@ -39,10 +41,55 @@
(def black-color "var(--app-black)")
(def white-color "var(--app-white)")
(def gray-color "var(--df-secondary)")
+(def selected-color "var(--app-pink)")
+
+;; Hover cursors for each edit mode and modifier combination.
+
+(defn- node-cursor
+ [edit-mode {:keys [shift? mod? alt?]} is-selected any-node-selected?]
+ (if (= edit-mode :draw)
+ (cond
+ ^boolean alt? "draw-remove"
+ ^boolean mod? "move-handles"
+ :else "draw-node")
+ (cond
+ (and ^boolean mod? ^boolean alt?) "draw-remove"
+ ^boolean mod? "move-handles"
+ ^boolean alt? "draw-remove"
+ (and ^boolean shift?
+ ^boolean any-node-selected?) "move-add"
+ ^boolean is-selected "move-move"
+ :else "move-node")))
+
+(defn- segment-cursor
+ [edit-mode {:keys [shift? mod? alt?]} is-selected insert-preview?]
+ (if (= edit-mode :draw)
+ (cond
+ ^boolean alt? "draw-remove"
+ ^boolean mod? "move-curve"
+ :else "draw-add")
+ (cond
+ (and ^boolean mod? ^boolean alt?) "draw-remove"
+ ^boolean mod? "move-curve"
+ ^boolean alt? "draw-add"
+ ^boolean shift? "move-add"
+ ^boolean insert-preview? "draw-add"
+ ^boolean is-selected "move-move"
+ :else nil)))
+
+(defn- handler-cursor
+ [edit-mode {:keys [shift? mod? alt?]} is-selected]
+ (cond
+ (and ^boolean mod? ^boolean alt?) "move"
+ (or ^boolean mod? ^boolean alt?) "move-remove"
+ (and (= edit-mode :move)
+ ^boolean shift?
+ (not ^boolean is-selected)) "move-add"
+ :else "move"))
(mf/defc path-point*
{::mf/private true}
- [{:keys [position zoom edit-mode is-hover is-selected is-preview is-start-path is-last is-new is-curve]}]
+ [{:keys [index position zoom edit-mode is-hover is-selected is-preview is-new cursor]}]
(let [{:keys [x y]} position
is-draw (= edit-mode :draw)
@@ -54,48 +101,37 @@
on-enter
(mf/use-fn
+ (mf/deps index)
(fn [_]
- (st/emit! (drp/path-pointer-enter position))))
+ (when (some? index)
+ (st/emit! (drp/path-pointer-enter index)))))
on-leave
(mf/use-fn
+ (mf/deps index)
(fn [_]
- (st/emit! (drp/path-pointer-leave position))))
+ (when (some? index)
+ (st/emit! (drp/path-pointer-leave index)))))
on-pointer-down
(fn [event]
(when (dom/left-mouse? event)
+ (uwvv/capture-pointer event)
(dom/stop-propagation event)
(dom/prevent-default event)
-
- ;; When clicking on a hover point that lies on a segment (has metadata with
- ;; split params), only insert the node — don't also run draw-mode actions which
- ;; would add the same position as an extra endpoint, corrupting the path order
- ;; and misplacing stroke caps.
+ ;; Preview nodes store their split params as metadata.
;; FIXME: revisit this, using meta here breaks equality checks
(if (and is-new (some? (meta position)))
(st/emit! (drp/create-node-at-position (meta position)))
(let [is-shift (kbd/shift? event)
+ is-alt (kbd/alt? event)
is-mod (kbd/mod? event)]
(cond
- is-last
- (st/emit! (drp/reset-last-handler))
-
- (and is-move is-mod (not is-curve))
- (st/emit! (drp/make-curve position))
-
- (and is-move is-mod is-curve)
- (st/emit! (drp/make-corner position))
-
is-move
- ;; If we're dragging a selected item we don't change the selection
- (st/emit! (drp/start-move-path-point position is-shift))
+ (st/emit! (drp/start-move-path-point index is-shift is-alt is-mod))
- (and is-draw is-start-path)
- (st/emit! (drp/start-path-from-point position))
-
- (and is-draw (not is-start-path))
- (st/emit! (drp/close-path-drag-start position)))))))]
+ is-draw
+ (st/emit! (drp/on-draw-node-pointer-down index position is-alt is-mod)))))))]
[:g.path-point
[:circle.path-point
@@ -108,7 +144,7 @@
:stroke (cond ^boolean is-active black-color
^boolean is-preview secondary-color
:else accent-color)
- :fill (cond is-selected accent-color
+ :fill (cond is-selected selected-color
:else white-color)}}]
[:circle {:cx x
:cy y
@@ -116,21 +152,24 @@
:on-pointer-down on-pointer-down
:on-pointer-enter on-enter
:on-pointer-leave on-leave
- :pointer-events (when-not ^boolean is-preview "visible")
- :class (cond ^boolean is-draw (cur/get-static "pen-node")
- ^boolean is-move (cur/get-static "pointer-node"))
+ ;; Let insertion preview clicks reach the segment.
+ :pointer-events (cond ^boolean is-preview nil
+ ^boolean is-new "none"
+ :else "visible")
+ :class (when (some? cursor) (cur/get-static cursor))
:style {:stroke-width 0
:fill "none"}}]]))
-;; FIXME: is-selected prop looks unused
-
(mf/defc path-handler*
{::mf/private true}
- [{:keys [index prefix point handler zoom is-selected is-hover edit-mode snap-angle]}]
+ [{:keys [index prefix point handler zoom is-selected is-hover snap-angle cursor on-grab]}]
(let [x (dm/get-prop handler :x)
y (dm/get-prop handler :y)
- is-draw (= edit-mode :draw)
- is-move (= edit-mode :move)
+
+ ;; Placed handlers and handlers with `on-grab` are interactive.
+ is-interactive
+ (or (some? index)
+ (some? on-grab))
is-active
(or ^boolean is-selected
@@ -148,16 +187,21 @@
on-pointer-down
(mf/use-fn
- (mf/deps index prefix is-move)
+ (mf/deps index prefix is-interactive on-grab)
(fn [event]
- (when (dom/left-mouse? event)
+ (when (and ^boolean is-interactive (dom/left-mouse? event))
+ (uwvv/capture-pointer event)
(dom/stop-propagation event)
(dom/prevent-default event)
+ (if (some? on-grab)
+ (on-grab event)
+ (st/emit! (drp/start-move-handler index
+ prefix
+ (kbd/shift? event)
+ (kbd/alt? event)
+ (kbd/mod? event)))))))]
- (when ^boolean is-move
- (st/emit! (drp/start-move-handler index prefix))))))]
-
- [:g.handler {:pointer-events (if ^boolean is-draw "none" "visible")}
+ [:g.handler {:pointer-events (if ^boolean is-interactive "visible" "none")}
[:line
{:x1 (:x point)
:y1 (:y point)
@@ -194,11 +238,70 @@
:on-pointer-down on-pointer-down
:on-pointer-enter on-enter
:on-pointer-leave on-leave
- :class (when ^boolean is-move
- (cur/get-static "pointer-move"))
+ :class (when (and ^boolean is-interactive (some? cursor))
+ (cur/get-static cursor))
:style {:fill "none"
:stroke-width 0}}]]))
+(defn- segment-content
+ [{:keys [from to segment]}]
+ (path/content
+ [{:command :move-to
+ :params from}
+ (if (= :close-path (:command segment))
+ {:command :line-to
+ :params to}
+ segment)]))
+
+(mf/defc path-segment*
+ {::mf/private true}
+ [{:keys [entry zoom edit-mode is-interactive is-selected is-hover cursor]}]
+ (let [index (:index entry)
+ content (mf/with-memo [entry] (segment-content entry))
+ is-active (or ^boolean is-selected ^boolean is-hover)
+ on-enter (mf/use-fn
+ (mf/deps index)
+ (fn [_]
+ (st/emit! (drp/path-segment-enter index))))
+ on-leave (mf/use-fn
+ (mf/deps index)
+ (fn [_]
+ (st/emit! (drp/path-segment-leave index))))
+ on-pointer-down
+ (mf/use-fn
+ (mf/deps index is-interactive edit-mode)
+ (fn [event]
+ (when (and ^boolean is-interactive (dom/left-mouse? event))
+ (uwvv/capture-pointer event)
+ (dom/stop-propagation event)
+ (dom/prevent-default event)
+ (if (= edit-mode :draw)
+ (st/emit! (drp/on-draw-segment-pointer-down index
+ (kbd/alt? event)
+ (kbd/mod? event)))
+ (st/emit! (drp/start-move-path-segment index
+ (kbd/shift? event)
+ (kbd/alt? event)
+ (kbd/mod? event)))))))]
+ [:g.path-segment {:pointer-events (if ^boolean is-interactive "visible" "none")}
+ (when ^boolean is-active
+ [:path {:d (.toString content)
+ :pointer-events "none"
+ :style {:fill "none"
+ :stroke (if ^boolean is-selected
+ selected-color
+ accent-color)
+ :stroke-width (/ 2 zoom)}}])
+ [:path {:d (.toString content)
+ :on-pointer-down on-pointer-down
+ :on-pointer-enter on-enter
+ :on-pointer-leave on-leave
+ :pointer-events "stroke"
+ :class (when (some? cursor) (cur/get-static cursor))
+ :style {:fill "none"
+ :stroke "transparent"
+ :stroke-width (/ point-radius-active-area zoom)}}]]))
+
(mf/defc path-preview*
{::mf/private true}
[{:keys [zoom segment from]}]
@@ -229,12 +332,8 @@
(mf/defc path-snap*
{::mf/private true}
- [{:keys [selected points zoom]}]
- (let [ranges
- (mf/with-memo [selected points]
- (snap/create-ranges points selected))
-
- snap-matches
+ [{:keys [selected ranges zoom]}]
+ (let [snap-matches
(snap/get-snap-delta-match selected ranges (/ 1 zoom))
matches
@@ -262,34 +361,160 @@
angle (gpt/angle-with-other v1 v2)]
(<= (- 180 angle) 0.1))))
+(defn- use-path-modifiers
+ "Tracks keyboard modifiers used by path cursors."
+ []
+ (let [modifiers* (mf/use-state {:shift? false :mod? false :alt? false})]
+ (hooks/use-stream
+ (mf/with-memo []
+ (rx/combine-latest ms/keyboard-shift ms/keyboard-mod ms/keyboard-alt))
+ (fn [[shift? mod? alt?]]
+ (reset! modifiers* {:shift? (boolean shift?)
+ :mod? (boolean mod?)
+ :alt? (boolean alt?)})))
+ (deref modifiers*)))
+
+(defn- use-insertion-preview
+ "Tracks the node insertion preview under the pointer."
+ [content zoom move-mode? mid-points]
+ (let [hover-point* (mf/use-state nil)]
+ (hooks/use-stream
+ (mf/with-memo []
+ (rx/combine-latest ms/mouse-position ms/keyboard-mod ms/keyboard-shift ms/keyboard-alt))
+ (mf/deps content zoom move-mode?)
+ (fn [[position mod? shift? alt?]]
+ (if (and ^boolean move-mode?
+ (not shift?)
+ (not mod?)
+ (gpt/point? position))
+ (reset! hover-point*
+ (dwp.helpers/insertion-point
+ content position
+ (/ dwp.helpers/segment-insert-threshold zoom)
+ (boolean alt?)
+ mid-points))
+ (reset! hover-point* nil))))
+ (deref hover-point*)))
+
+(defn- create-snap-ranges
+ "Builds snap ranges from stationary nodes."
+ [content selected-nodes selected-segments include-all?]
+ (let [points (if include-all?
+ (path/get-points content)
+ (let [moving-indices (into selected-nodes
+ (dwp.helpers/segment-node-indices
+ content selected-segments))
+ moving-positions (dwp.helpers/node-positions content moving-indices)]
+ (into [] (remove moving-positions) (path/get-points content))))]
+ (snap/create-ranges points)))
+
+(defn- snap-selected-points
+ [content selected-nodes selected-segment-nodes drag-handler preview moving-handler]
+ (cond
+ (some? drag-handler) #{drag-handler}
+ (some? preview) #{(path.helpers/segment->point preview)}
+ (some? moving-handler) #{moving-handler}
+ :else
+ (dwp.helpers/node-positions
+ content (into selected-nodes selected-segment-nodes))))
+
+(mf/defc path-node*
+ {::mf/private true}
+ [{:keys [index position content handlers zoom edit-mode selected-nodes selected-handlers
+ hover-nodes hover-handlers moving-handler modifiers drag-cursor
+ any-node-selected]}]
+ (let [show-handler? (fn [[handler-index prefix]]
+ (not= position
+ (path/get-handler-point content handler-index prefix)))
+ point-handlers (->> (get handlers position)
+ (filter show-handler?)
+ (not-empty))
+ point-selected? (contains? selected-nodes index)
+ point-hover? (contains? hover-nodes index)
+ matching-handlers? (matching-handler? content position point-handlers)]
+ [:g.path-node {:key (dm/str "node-" index)}
+ [:g.point-handlers
+ (for [[handler-index prefix] point-handlers]
+ (let [handler-position (path/get-handler-point content handler-index prefix)
+ handler-hover? (contains? hover-handlers [handler-index prefix])
+ handler-selected? (contains? selected-handlers [handler-index prefix])]
+ (when (and position handler-position)
+ [:> path-handler*
+ {:key (dm/str handler-index "-" (d/name prefix))
+ :point position
+ :handler handler-position
+ :index handler-index
+ :prefix prefix
+ :zoom zoom
+ :is-selected handler-selected?
+ :is-hover handler-hover?
+ :snap-angle (and (= handler-position moving-handler) matching-handlers?)
+ :edit-mode edit-mode
+ :cursor (or drag-cursor
+ (handler-cursor edit-mode modifiers handler-selected?))}])))]
+
+ [:> path-point* {:index index
+ :position position
+ :zoom zoom
+ :edit-mode edit-mode
+ :is-selected point-selected?
+ :is-hover point-hover?
+ :cursor (or drag-cursor
+ (node-cursor edit-mode modifiers point-selected?
+ any-node-selected))}]]))
+
(mf/defc path-editor*
[{:keys [shape zoom state]}]
- (let [hover-point (mf/use-state nil)
- editor-ref (mf/use-ref nil)
+ (let [editor-ref (mf/use-ref nil)
{:keys [edit-mode
drag-handler
prev-handler
preview
content-modifiers
- last-point
- selected-points
+ selection
moving-nodes
moving-handler
- hover-handlers
- hover-points
- snap-toggled]}
+ hover
+ snap-toggled
+ drag-cursor]}
state
- selected-points
- (or selected-points #{})
+ move-mode?
+ (= edit-mode :move)
+
+ draw-mode?
+ (= edit-mode :draw)
+
+ modifiers
+ (use-path-modifiers)
+
+ selected-nodes (get selection :nodes #{})
+ selected-segments (get selection :segments #{})
+ selected-handlers (get selection :handlers #{})
+ hover-nodes (get hover :nodes #{})
+ hover-segments (get hover :segments #{})
+ hover-handlers (get hover :handlers #{})
+
+ any-node-selected?
+ (boolean (seq selected-nodes))
+
+ ;; Skip segment hit targets while dragging.
+ dragging?
+ (or (some? drag-cursor)
+ (some? drag-handler))
base-content
(get shape :content)
- base-points
- (mf/with-memo [base-content]
- (path/get-points base-content))
+ ;; Cache segment midpoints used by insertion previews.
+ insertion-mid-points
+ (mf/with-memo [base-content move-mode?]
+ (when move-mode?
+ (dwp.helpers/insertion-mid-points base-content)))
+
+ hover-point
+ (use-insertion-preview base-content zoom move-mode? insertion-mid-points)
content
(mf/with-memo [base-content content-modifiers]
@@ -299,12 +524,19 @@
(mf/with-memo [content]
(path/get-points content))
- point->base (->> (map hash-map content-points base-points) (reduce merge))
- base->point (map-invert point->base)
+ ;; Pair each node position with its content index.
+ node-entries
+ (mf/with-memo [content content-points]
+ (mapv vector (dwp.helpers/node-indices content) content-points))
- points
- (mf/with-memo [content-points]
- (into #{} content-points))
+ segment-entries
+ (mf/with-memo [content dragging?]
+ (when-not dragging?
+ (dwp.helpers/segment-entries content)))
+
+ selected-segment-nodes
+ (mf/with-memo [content selected-segments]
+ (dwp.helpers/segment-node-indices content selected-segments))
last-p
(->> content last path.helpers/segment->point)
@@ -313,8 +545,16 @@
(mf/with-memo [content]
(path/get-handlers content))
- is-path-start
- (not (some? last-point))
+ ;; Build snap ranges from stationary nodes.
+ snap-dragging-handler?
+ (boolean (or (some? drag-handler)
+ (some? preview)
+ (some? moving-handler)))
+
+ snap-ranges
+ (mf/with-memo [base-content selected-nodes selected-segments snap-dragging-handler?]
+ (create-snap-ranges
+ base-content selected-nodes selected-segments snap-dragging-handler?))
show-snap?
(and ^boolean snap-toggled
@@ -329,23 +569,41 @@
(st/emit! :interrupt)))]
#(events/unlistenByKey key)))
- (hooks/use-stream
- ms/mouse-position
- (mf/deps base-content zoom)
- (fn [position]
- (when-let [point (path/closest-point base-content position (/ 0.01 zoom))]
- (reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
-
[:g.path-editor {:ref editor-ref}
[:path {:d (.toString content)
:style {:fill "none"
:stroke accent-color
:strokeWidth (/ 1 zoom)}}]
+ (for [{:keys [index] :as entry} segment-entries]
+ (let [is-selected (or (contains? selected-segments index)
+ ;; Select segments between selected endpoints.
+ (and (contains? selected-nodes (:from-index entry))
+ (contains? selected-nodes (:to-index entry))))
+ is-hover (contains? hover-segments index)]
+ [:> path-segment*
+ {:key (dm/str "segment-" index)
+ :entry entry
+ :zoom zoom
+ :edit-mode edit-mode
+ :is-interactive (or ^boolean move-mode? ^boolean draw-mode?)
+ :is-selected is-selected
+ :is-hover is-hover
+ :cursor (or drag-cursor
+ (segment-cursor edit-mode modifiers is-selected
+ (and is-hover (some? hover-point))))}]))
(when (and preview (not drag-handler))
[:> path-preview* {:segment preview
:from last-p
:zoom zoom}])
+ ;; Let insertion preview clicks reach the segment.
+ (when (and ^boolean move-mode? (some? hover-point))
+ [:g.hover-point {:pointer-events "none"}
+ [:> path-point* {:position hover-point
+ :edit-mode edit-mode
+ :is-new true
+ :zoom zoom}]])
+
(when (and drag-handler last-p)
[:g.drag-handler {:pointer-events "none"}
[:> path-handler* {:point last-p
@@ -353,90 +611,39 @@
:edit-mode edit-mode
:zoom zoom}]])
- (when @hover-point
- [:g.hover-point
- [:> path-point* {:position @hover-point
- :edit-mode edit-mode
- :is-new true
- :is-start-path is-path-start
- :zoom zoom}]])
-
- (for [position points]
- (let [pos-x (dm/get-prop position :x)
- pos-y (dm/get-prop position :y)
-
- show-handler?
- (fn [[index prefix]]
- ;; FIXME: get-handler-point is executed twice for each
- ;; render, this can be optimized
- (let [handler-position (path/get-handler-point content index prefix)]
- (not= position handler-position)))
-
- position-handlers
- (->> (get handlers position)
- (filter show-handler?)
- (not-empty))
-
- point-selected?
- (contains? selected-points (get point->base position))
-
- point-hover?
- (contains? hover-points (get point->base position))
-
- is-last
- (= last-point (get point->base position))
-
- is-curve
- (boolean position-handlers)]
-
- [:g.path-node {:key (dm/str pos-x "-" pos-y)}
- [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
- (for [[hindex prefix] position-handlers]
- (let [handler-position (path/get-handler-point content hindex prefix)
- handler-hover? (contains? hover-handlers [hindex prefix])
- moving-handler? (= handler-position moving-handler)
- matching-handler? (matching-handler? content position position-handlers)]
-
- (when (and position handler-position)
- [:> path-handler*
- {:key (dm/str hindex "-" (d/name prefix))
- :point position
- :handler handler-position
- :index hindex
- :prefix prefix
- :zoom zoom
- :is-hover handler-hover?
- :snap-angle (and moving-handler? matching-handler?)
- :edit-mode edit-mode}])))]
-
- [:> path-point* {:position position
- :zoom zoom
- :edit-mode edit-mode
- :is-selected point-selected?
- :is-hover point-hover?
- :is-last is-last
- :is-start-path is-path-start
- :is-curve is-curve}]]))
+ (for [[index position] node-entries]
+ [:> path-node* {:key (dm/str "node-" index)
+ :index index
+ :position position
+ :content content
+ :handlers handlers
+ :zoom zoom
+ :edit-mode edit-mode
+ :selected-nodes selected-nodes
+ :selected-handlers selected-handlers
+ :hover-nodes hover-nodes
+ :hover-handlers hover-handlers
+ :moving-handler moving-handler
+ :modifiers modifiers
+ :drag-cursor drag-cursor
+ :any-node-selected any-node-selected?}])
(when (and prev-handler last-p)
- [:g.prev-handler {:pointer-events "none"}
+ [:g.prev-handler
[:> path-handler*
{:point last-p
:edit-mode edit-mode
:handler prev-handler
- :zoom zoom}]])
+ :zoom zoom
+ :on-grab (fn [_] (st/emit! (drp/start-move-prev-handler)))
+ :cursor (or drag-cursor
+ (handler-cursor edit-mode modifiers false))}]])
(when ^boolean show-snap?
- (let [[snap-selected snap-points]
- (cond
- (some? drag-handler) [#{drag-handler} points]
- (some? preview) [#{(path.helpers/segment->point preview)} points]
- (some? moving-handler) [#{moving-handler} points]
- :else
- [(->> selected-points (map base->point) (into #{}))
- (->> points (remove selected-points) (into #{}))])]
+ (let [snap-selected (snap-selected-points
+ content selected-nodes selected-segment-nodes
+ drag-handler preview moving-handler)]
[:g.path-snap {:pointer-events "none"}
[:> path-snap* {:selected snap-selected
- :points snap-points
+ :ranges snap-ranges
:zoom zoom}]]))]))
-
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options.cljs b/frontend/src/app/main/ui/workspace/sidebar/options.cljs
index f07dce3891..3013dfd99a 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options.cljs
@@ -15,6 +15,7 @@
[app.main.data.helpers :as dsh]
[app.main.data.workspace :as udw]
[app.main.data.workspace.common :as dwc]
+ [app.main.data.workspace.path.state :as path.state]
[app.main.features :as features]
[app.main.refs :as refs]
[app.main.store :as st]
@@ -105,6 +106,18 @@
drawing (mf/deref refs/workspace-drawing)
edition (mf/deref refs/selected-edition)
+ edit-path
+ (mf/deref refs/workspace-edit-path)
+
+ edit-path-state
+ (path.state/current-edit-state edit-path edition)
+
+ path-editing?
+ (path.state/editing? edit-path edition)
+
+ path-node-count
+ (count (dm/get-in edit-path-state [:selection :nodes]))
+
files
(mf/deref refs/files)
@@ -152,12 +165,22 @@
[:div {:class (stl/css :element-options :design-options)}
[:> align-options* {:shapes shapes
- :objects objects}]
- [:> bool-options* {:total-selected total-selected
- :shapes shapes
- :shapes-with-children shapes-with-children}]
+ :objects objects
+ :path-edit? path-editing?
+ :node-count path-node-count}]
+ (when-not path-editing?
+ [:> bool-options* {:total-selected total-selected
+ :shapes shapes
+ :shapes-with-children shapes-with-children}])
(cond
+ ;; Show path-specific options during node editing.
+ path-editing?
+ [:> path/path-edition-options*
+ {:shape (get objects edition)
+ :file-id file-id
+ :page-id page-id}]
+
(and edit-grid? (d/not-empty? selected-cells))
[:> grid-cell/options*
{:shape-id (-> (get objects edition)
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/align.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/align.cljs
index f3e78e951e..d45e9ac730 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/align.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/align.cljs
@@ -8,6 +8,7 @@
(:require-macros [app.main.style :as stl])
(:require
[app.main.data.workspace :as dw]
+ [app.main.data.workspace.path :as dwdp]
[app.main.data.workspace.shortcuts :as sc]
[app.main.store :as st]
[app.main.ui.icons :as deprecated-icon]
@@ -16,30 +17,44 @@
[rumext.v2 :as mf]))
(mf/defc align-options*
- [{:keys [shapes objects]}]
- (let [disabled-align
- (not (dw/can-align? shapes objects))
+ ;; Align path nodes or whole shapes for the current edit mode.
+ [{:keys [shapes objects path-edit? node-count]}]
+ (let [node-count (or node-count 0)
+
+ disabled-align
+ (if path-edit?
+ (< node-count 2)
+ (not (dw/can-align? shapes objects)))
disabled-distribute
- (not (dw/can-distribute? shapes))
+ (if path-edit?
+ (< node-count 3)
+ (not (dw/can-distribute? shapes)))
align-objects
(mf/use-fn
+ (mf/deps path-edit?)
(fn [event]
(let [value (-> (dom/get-current-target event)
(dom/get-data "value")
(keyword))]
- (st/emit! (dw/align-objects value)))))
+ (st/emit! (if path-edit?
+ (dwdp/align-nodes value)
+ (dw/align-objects value))))))
distribute-objects
(mf/use-fn
+ (mf/deps path-edit?)
(fn [event]
(let [value (-> (dom/get-current-target event)
(dom/get-data "value")
(keyword))]
- (st/emit! (dw/distribute-objects value)))))]
+ (st/emit! (if path-edit?
+ (dwdp/distribute-nodes value)
+ (dw/distribute-objects value))))))]
- (when-not (and disabled-align disabled-distribute)
+ ;; Keep path controls visible while their actions are disabled.
+ (when (or path-edit? (not (and disabled-align disabled-distribute)))
[:div {:class (stl/css :align-options)}
[:div {:class (stl/css :align-group-horizontal)}
[:button {:class (stl/css-case :align-button true
@@ -106,4 +121,3 @@
:data-value "vertical"
:on-click distribute-objects}
deprecated-icon/distribute-vertical-spacing]]])))
-
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs
index f4a454af54..cf56b9a07d 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs
@@ -176,6 +176,29 @@
(identical? (get o-values :proportion-lock)
(get n-values :proportion-lock)))))
+(mf/defc node-position-menu*
+ "X and Y inputs for the current path selection."
+ [{:keys [values on-x-change on-y-change]}]
+ ;; Match the shape position input layout.
+ [:section {:class (stl/css :element-set)}
+ [:div {:class (stl/css :position)}
+ [:div {:class (stl/css :x-position)
+ :title (tr "workspace.options.x")}
+ [:span {:class (stl/css :icon-text)} "X"]
+ [:> deprecated-input/numeric-input* {:no-validate true
+ :placeholder (if (= :multiple (:x values)) (tr "settings.multiple") "--")
+ :on-change on-x-change
+ :class (stl/css :numeric-input)
+ :value (:x values)}]]
+ [:div {:class (stl/css :y-position)
+ :title (tr "workspace.options.y")}
+ [:span {:class (stl/css :icon-text)} "Y"]
+ [:> deprecated-input/numeric-input* {:no-validate true
+ :placeholder (if (= :multiple (:y values)) (tr "settings.multiple") "--")
+ :on-change on-y-change
+ :class (stl/css :numeric-input)
+ :value (:y values)}]]]])
+
(mf/defc measures-menu*
{::mf/wrap [#(mf/memo' % check-measures-menu-props)]}
[{:keys [ids values applied-tokens type shapes]}]
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/path.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/path.cljs
index 05b8158544..9f9491f465 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/path.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/path.cljs
@@ -7,8 +7,13 @@
(ns app.main.ui.workspace.sidebar.options.shapes.path
(:require
[app.common.data.macros :as dm]
+ [app.common.files.helpers :as cfh]
+ [app.common.types.path :as cpath]
[app.common.types.shape.layout :as ctl]
+ [app.main.data.workspace.path :as drp]
+ [app.main.data.workspace.path.helpers :as path.helpers]
[app.main.refs :as refs]
+ [app.main.store :as st]
[app.main.ui.workspace.sidebar.options.menus.blur :refer [blur-menu*]]
[app.main.ui.workspace.sidebar.options.menus.constraints :refer [constraint-attrs constraints-menu*]]
[app.main.ui.workspace.sidebar.options.menus.exports :refer [exports-menu* exports-attrs]]
@@ -17,7 +22,7 @@
[app.main.ui.workspace.sidebar.options.menus.layer :refer [layer-attrs layer-menu*]]
[app.main.ui.workspace.sidebar.options.menus.layout-container :refer [layout-container-flex-attrs layout-container-menu*]]
[app.main.ui.workspace.sidebar.options.menus.layout-item :refer [layout-item-attrs layout-item-menu*]]
- [app.main.ui.workspace.sidebar.options.menus.measures :refer [measure-attrs measures-menu*]]
+ [app.main.ui.workspace.sidebar.options.menus.measures :refer [measure-attrs measures-menu* node-position-menu*]]
[app.main.ui.workspace.sidebar.options.menus.shadow :refer [shadow-menu*]]
[app.main.ui.workspace.sidebar.options.menus.stroke :refer [stroke-attrs stroke-menu*]]
[app.main.ui.workspace.sidebar.options.menus.svg-attrs :refer [svg-attrs-menu*]]
@@ -144,3 +149,96 @@
:page-id page-id
:file-id file-id}]]))
+(mf/defc path-edition-options*
+ "Options shown while editing a path."
+ [{:keys [shape]}]
+ (let [id (dm/get-prop shape :id)
+ type (dm/get-prop shape :type)
+ ids (mf/with-memo [id] [id])
+ shapes (mf/with-memo [shape] [shape])
+
+ applied-tokens
+ (get shape :applied-tokens)
+
+ measure-values
+ (select-keys shape measure-attrs)
+
+ stroke-values
+ (select-keys shape stroke-attrs)
+
+ ;; Read coordinates from the live editing content.
+ edit-path (mf/deref refs/workspace-edit-path)
+ drawing (mf/deref refs/current-drawing-shape)
+ objects (mf/deref refs/workspace-page-objects)
+ selection (get-in edit-path [id :selection])
+ modifiers (get-in edit-path [id :content-modifiers])
+
+ content
+ (mf/with-memo [drawing modifiers]
+ (when-let [base (get drawing :content)]
+ (cpath/apply-content-modifiers base modifiers)))
+
+ ;; Show coordinates relative to the parent frame.
+ frame (cfh/get-parent-frame objects shape)
+ in-frame? (and (some? frame) (not (cfh/root? frame)))
+ ox (if in-frame? (dm/get-prop frame :x) 0)
+ oy (if in-frame? (dm/get-prop frame :y) 0)
+
+ ;; Segments use selection bounds; nodes and handlers use their positions.
+ node-values
+ (mf/with-memo [content selection ox oy]
+ (when (and (some? content) (some? selection))
+ (let [segments (get selection :segments)
+ handlers (get selection :handlers)
+ nodes (get selection :nodes)]
+ (cond
+ (seq segments)
+ (when-let [rect (path.helpers/selection-coordinate-rect
+ content selection)]
+ {:x (- (dm/get-prop rect :x) ox)
+ :y (- (dm/get-prop rect :y) oy)})
+
+ (or (seq nodes) (seq handlers))
+ (let [positions (into (path.helpers/node-positions content (set nodes))
+ (keep (fn [[i p]] (cpath/get-handler-point content i p)))
+ handlers)]
+ (when (seq positions)
+ (let [xs (into #{} (map #(- (:x %) ox)) positions)
+ ys (into #{} (map #(- (:y %) oy)) positions)]
+ {:x (if (= 1 (count xs)) (first xs) :multiple)
+ :y (if (= 1 (count ys)) (first ys) :multiple)})))))))
+
+ on-node-x-change
+ (mf/use-fn (mf/deps ox)
+ (fn [value] (when (some? value) (st/emit! (drp/set-selection-coordinate :x (+ value ox))))))
+
+ on-node-y-change
+ (mf/use-fn (mf/deps oy)
+ (fn [value] (when (some? value) (st/emit! (drp/set-selection-coordinate :y (+ value oy))))))]
+
+ [:*
+ (when (some? node-values)
+ [:> node-position-menu* {:values node-values
+ :on-x-change on-node-x-change
+ :on-y-change on-node-y-change}])
+ ;; Show read-only shape measures when no path element is selected.
+ (when (nil? node-values)
+ [:div {:style {:pointer-events "none" :opacity 0.6}}
+ [:> measures-menu* {:ids ids
+ :type type
+ :applied-tokens applied-tokens
+ :values measure-values
+ :shapes shapes}]])
+ [:> fill/fill-menu*
+ {:ids ids
+ :type type
+ :values shape
+ :applied-tokens applied-tokens}]
+ [:> stroke-menu* {:ids ids
+ :type type
+ :show-caps true
+ :values stroke-values
+ :applied-tokens applied-tokens}]
+ [:> shadow-menu* {:ids ids :values (get shape :shadow)}]
+ [:> blur-menu* {:ids ids
+ :values (select-keys shape [:blur :background-blur])}]]))
diff --git a/frontend/src/app/main/ui/workspace/top_toolbar.cljs b/frontend/src/app/main/ui/workspace/top_toolbar.cljs
index a529d33003..1ec87df215 100644
--- a/frontend/src/app/main/ui/workspace/top_toolbar.cljs
+++ b/frontend/src/app/main/ui/workspace/top_toolbar.cljs
@@ -16,6 +16,7 @@
[app.main.data.workspace.drawing.common :as dwdc]
[app.main.data.workspace.mcp :as mcp]
[app.main.data.workspace.media :as dwm]
+ [app.main.data.workspace.path.state :as pst]
[app.main.data.workspace.shortcuts :as sc]
[app.main.features :as features]
[app.main.refs :as refs]
@@ -34,16 +35,16 @@
(def ^:private toolbar-hidden-ref
(l/derived (fn [state]
- (let [visibility (get state :hide-toolbar)
- path-edit-state (get state :edit-path)
- selected (get state :selected)
- edition (get state :edition)
+ (let [visibility (get-in state [:workspace-local :hide-toolbar])
+ selected (get-in state [:workspace-local :selected])
is-single (= (count selected) 1)
- is-path-editing (and is-single (some? (get path-edit-state edition)))]
+ ;; The path edition bar replaces this toolbar.
+ is-path-editing (and is-single (pst/editing? state))
+ is-path-drawing (pst/drawing? state)]
- (if is-path-editing true visibility)))
- refs/workspace-local))
+ (if (or is-path-editing is-path-drawing) true visibility)))
+ st/state))
(def grouped-tools
{:shapes {:default-tool :rect
diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs
index 6841784f44..7e28ceaa7c 100644
--- a/frontend/src/app/main/ui/workspace/viewport.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport.cljs
@@ -13,7 +13,6 @@
[app.common.geom.shapes :as gsh]
[app.common.types.color :as clr]
[app.common.types.component :as ctk]
- [app.common.types.path :as path]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctt]
[app.common.types.shape.layout :as ctl]
@@ -46,6 +45,7 @@
[app.main.ui.workspace.viewport.hooks :as hooks]
[app.main.ui.workspace.viewport.interactions :as interactions]
[app.main.ui.workspace.viewport.outline :as outline]
+ [app.main.ui.workspace.viewport.path-state :as path-state]
[app.main.ui.workspace.viewport.pixel-overlay :as pixel-overlay]
[app.main.ui.workspace.viewport.presence :as presence]
[app.main.ui.workspace.viewport.rulers :as rulers]
@@ -53,8 +53,7 @@
[app.main.ui.workspace.viewport.selection :as selection]
[app.main.ui.workspace.viewport.snap-distances :as snap-distances]
[app.main.ui.workspace.viewport.snap-points :as snap-points]
- [app.main.ui.workspace.viewport.top-bar :refer [grid-edition-bar*
- path-edition-bar*
+ [app.main.ui.workspace.viewport.top-bar :refer [edition-bars*
view-only-bar*]]
[app.main.ui.workspace.viewport.utils :as utils]
[app.main.ui.workspace.viewport.viewport-ref :refer [create-viewport-ref]]
@@ -177,21 +176,22 @@
selected-frame (when (= (count selected-frames) 1)
(get base-objects (first selected-frames)))
- edit-path-state (get edit-path edition)
- edit-path-mode (get edit-path-state :edit-mode)
+ {:keys [edit-state
+ editing?
+ drawing?
+ editing-shape
+ bar-state
+ bar-shape
+ drawing-shape]}
+ (mf/with-memo [edit-path edition drawing-tool drawing-obj base-objects]
+ (path-state/derive-path-state edit-path edition drawing-tool drawing-obj base-objects))
- path-editing? (some? edit-path-state)
- path-drawing? (or (= edit-path-mode :draw)
- (and (= :path (get drawing-obj :type))
- (not= :curve drawing-tool)))
-
- editing-shape (when edition
- (get base-objects edition))
-
- editing-shape (mf/with-memo [editing-shape path-editing? base-objects]
- (if path-editing?
- (path/convert-to-path editing-shape base-objects)
- editing-shape))
+ edit-path-state edit-state
+ path-editing? editing?
+ path-drawing? drawing?
+ path-bar-state bar-state
+ path-bar-shape bar-shape
+ draw-area-shape drawing-shape
create-comment? (= :comments drawing-tool)
@@ -255,8 +255,14 @@
(seq selected))
show-snap-points? (and (or (contains? layout :dynamic-alignment)
(contains? layout :snap-guides))
- (or drawing-obj transform))
- show-selrect? (and selrect (empty? drawing) (not text-editing?))
+ (or drawing-obj transform)
+ (not path-editing?))
+
+ render-objects (mf/with-memo [base-objects path-editing? edition]
+ (cond-> base-objects
+ path-editing?
+ (assoc-in [edition :hidden] true)))
+ show-selrect? (and selrect (or (empty? drawing) path-editing?) (not text-editing?))
show-measures? (and (not transform)
(not path-editing?)
(or show-distances? mode-inspect? read-only?))
@@ -311,7 +317,7 @@
(hooks/setup-dom-events zoom disable-paste-ref in-viewport-ref read-only? drawing-tool path-drawing?)
(hooks/setup-viewport-size vport viewport-ref)
- (hooks/setup-cursor cursor alt? mod? space? panning drawing-tool path-drawing? path-editing? z? read-only?)
+ (hooks/setup-cursor cursor alt? mod? space? panning drawing-tool path-drawing? path-editing? (get path-bar-state :drag-cursor) z? read-only?)
(hooks/setup-keyboard alt? mod? space? z? shift?)
(hooks/setup-hover-shapes page-id move-stream base-objects selected mod? hover measure-hover
hover-ids hover-top-frame-id @hover-disabled? focus zoom show-measures? read-only? transform)
@@ -332,15 +338,14 @@
(when-not hide-ui?
[:> top-toolbar* {:layout layout}])
- (when (and ^boolean path-editing?
- ^boolean single-select?)
- [:> path-edition-bar* {:shape editing-shape
- :edit-path-state edit-path-state
- :layout layout}])
-
- (when (and ^boolean grid-editing?
- ^boolean single-select?)
- [:> grid-edition-bar* {:shape editing-shape}])])
+ [:> edition-bars* {:layout layout
+ :path-editing path-editing?
+ :path-drawing path-drawing?
+ :path-state path-bar-state
+ :path-shape path-bar-shape
+ :grid-editing grid-editing?
+ :grid-shape editing-shape
+ :single-select single-select?}]])
[:div {:class (stl/css :viewport-overlays)}
;; The behaviour inside a foreign object is a bit different that in plain HTML so we wrap
@@ -411,7 +416,7 @@
[:& (mf/provider use/include-metadata-ctx) {:value (dbg/enabled? :show-export-metadata)}
;; Render root shape
[:& shapes/root-shape {:key (str page-id)
- :objects base-objects
+ :objects render-objects
:active-frames @active-frames
;; disable thumbnails when previewing a version
:disable-thumbnails (some? preview-id)}]]]]
@@ -593,7 +598,7 @@
(when (and ^boolean show-draw-area?
^boolean (cts/shape? drawing-obj))
[:> drawarea/draw-area*
- {:shape drawing-obj
+ {:shape draw-area-shape
:zoom zoom
:tool drawing-tool}])
diff --git a/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs b/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs
index 9bcebcafc3..643a990eac 100644
--- a/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/drawarea.cljs
@@ -9,6 +9,7 @@
(:require
[app.common.data.macros :as dm]
[app.common.math :as mth]
+ [app.common.types.path :as path]
[app.main.refs :as refs]
[app.main.ui.shapes.path :refer [path-shape]]
[app.main.ui.workspace.shapes :as shapes]
@@ -20,6 +21,27 @@
(let [get-fn #(dm/get-in % [:edit-path id])]
(l/derived get-fn refs/workspace-local)))
+(def ^:private edit-fill-opacity
+ "Fill opacity used while editing a path."
+ 0.8)
+
+(def ^:private synced-edit-attrs
+ "Visual attributes copied into the live editing shape."
+ [:strokes :shadow :blur :background-blur :opacity :blend-mode])
+
+(defn- dim-fills
+ [fills]
+ (mapv (fn [fill]
+ (update fill :fill-opacity #(* (or % 1) edit-fill-opacity)))
+ fills))
+
+(defn path-edit-shape
+ "Builds the path shape rendered during editing."
+ [drawing-obj stored]
+ (-> (cond-> (merge drawing-obj (select-keys stored synced-edit-attrs))
+ (seq (:fills stored)) (assoc :fills (:fills stored)))
+ (update :fills dim-fills)))
+
(mf/defc generic-draw-area*
{::mf/private true}
[{:keys [shape zoom]}]
@@ -55,12 +77,36 @@
(mf/defc draw-area*
[{:keys [shape zoom tool] :as props}]
- [:g.draw-area
- [:g {:style {:pointer-events "none"}}
- [:& shapes/shape-wrapper {:shape shape}]]
+ (let [shape-id
+ (dm/get-prop shape :id)
- (case tool
- :path [:> path-draw-area* props]
- :curve [:& path-shape {:shape shape :zoom zoom}]
- #_:default [:> generic-draw-area* props])])
+ edit-path-ref
+ (mf/with-memo [shape-id]
+ (make-edit-path-ref shape-id))
+ ;; Keep command indices unchanged while applying drag modifiers.
+ dragging?
+ (some? (:content-modifiers (mf/deref edit-path-ref)))
+
+ ;; Close rendered subpaths while keeping editor content untouched.
+ render-shape
+ (mf/with-memo [shape dragging?]
+ (if (and (= :path (dm/get-prop shape :type)) (not dragging?))
+ (update shape :content #(-> % path/close-subpaths path/close-loops))
+ shape))]
+ [:g.draw-area
+ [:g {:style {:pointer-events "none"}}
+ [:& shapes/shape-wrapper {:shape render-shape}]]
+
+ (cond
+ (= tool :path)
+ [:> path-draw-area* props]
+
+ (= tool :curve)
+ [:& path-shape {:shape shape :zoom zoom}]
+
+ (= (:type shape) :path)
+ nil
+
+ :else
+ [:> generic-draw-area* props])]))
diff --git a/frontend/src/app/main/ui/workspace/viewport/hooks.cljs b/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
index d820f01aa2..9c6f763779 100644
--- a/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
@@ -25,6 +25,7 @@
[app.main.features :as features]
[app.main.store :as st]
[app.main.streams :as ms]
+ [app.main.ui.css-cursors :as cur]
[app.main.ui.hooks :as hooks]
[app.main.ui.workspace.shapes.frame.dynamic-modifiers :as sfd]
[app.main.ui.workspace.viewport.actions :as actions]
@@ -91,9 +92,9 @@
(when (not= size vport)
(st/emit! (dw/initialize-viewport (dom/get-client-size prnt)))))))
-(defn setup-cursor [cursor alt? mod? space? panning drawing-tool drawing-path? path-editing? z? workspace-read-only?]
+(defn setup-cursor [cursor alt? mod? space? panning drawing-tool drawing-path? path-editing? path-drag-cursor z? workspace-read-only?]
(mf/use-effect
- (mf/deps @cursor @alt? @mod? @space? panning drawing-tool drawing-path? path-editing? z? workspace-read-only?)
+ (mf/deps @cursor @alt? @mod? @space? panning drawing-tool drawing-path? path-editing? path-drag-cursor z? workspace-read-only?)
(fn []
(let [show-pen? (or (= drawing-tool :path)
(and drawing-path?
@@ -108,18 +109,20 @@
(cond
(and @mod? @space?) (utils/get-cursor :zoom)
(or panning @space?) (utils/get-cursor :hand)
+ ;; Keep the drag cursor across the viewport.
+ (some? path-drag-cursor) (cur/get-static path-drag-cursor)
(= drawing-tool :comments) (utils/get-cursor :comments)
(= drawing-tool :frame) (utils/get-cursor :create-artboard)
(= drawing-tool :rect) (utils/get-cursor :create-rectangle)
(= drawing-tool :circle) (utils/get-cursor :create-ellipse)
(and show-zoom? (not @alt?)) (utils/get-cursor :zoom-in)
(and show-zoom? @alt?) (utils/get-cursor :zoom-out)
- show-pen? (utils/get-cursor :pen)
+ show-pen? (utils/get-cursor :draw-path)
(= drawing-tool :curve) (utils/get-cursor :pencil)
drawing-tool (utils/get-cursor :create-shape)
+ path-editing? (utils/get-cursor :edit-path)
(and
@alt?
- (not path-editing?)
(not workspace-read-only?)) (utils/get-cursor :duplicate)
:else (utils/get-cursor :pointer-inner))]
diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
index fc70c97de6..caeff06444 100644
--- a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
@@ -7,12 +7,13 @@
(ns app.main.ui.workspace.viewport.path-actions
(:require-macros [app.main.style :as stl])
(:require
- [app.common.types.path.segment :as path.segm]
[app.main.data.workspace.path :as drp]
+ [app.main.data.workspace.path.helpers :as path.helpers]
[app.main.data.workspace.path.shortcuts :as sc]
[app.main.store :as st]
[app.main.ui.icons :as deprecated-icon]
[app.util.i18n :as i18n :refer [tr]]
+ [app.util.timers :as ts]
[rumext.v2 :as mf]))
(def ^:private pentool-icon
@@ -21,12 +22,6 @@
(def ^:private move-icon
(deprecated-icon/icon-xref :move (stl/css :move-icon :pathbar-icon)))
-(def ^:private add-icon
- (deprecated-icon/icon-xref :add (stl/css :add-icon :pathbar-icon)))
-
-(def ^:private remove-icon
- (deprecated-icon/icon-xref :remove (stl/css :remove :pathbar-icon)))
-
(def ^:private merge-nodes-icon
(deprecated-icon/icon-xref :merge-nodes (stl/css :merge-nodes-icon :pathbar-icon)))
@@ -42,40 +37,152 @@
(def ^:private to-curve-icon
(deprecated-icon/icon-xref :to-curve (stl/css :to-curve-icon :pathbar-icon)))
-(def ^:private snap-nodes-icon
- (deprecated-icon/icon-xref :snap-nodes (stl/css :snap-nodes-icon :pathbar-icon)))
+(def ^:private snap-icon
+ (deprecated-icon/icon-xref :snap (stl/css :snap-icon :pathbar-icon)))
-(defn check-enabled [content selected-points]
- (when content
- (let [segments (path.segm/get-segments-with-points content selected-points)
- num-segments (count segments)
- num-points (count selected-points)
- points-selected? (seq selected-points)
- segments-selected? (seq segments)
- ;; max segments for n points is (n × (n -1)) / 2
- max-segments (-> num-points
- (* (- num-points 1))
- (/ 2))
- is-curve? (some #(path.segm/is-curve? content %) selected-points)]
+;; Handler behavior icons: mirror, aligned, and independent.
+(def ^:private handler-mirror-icon
+ (deprecated-icon/icon-xref :handlers-equal (stl/css :pathbar-icon)))
- {:make-corner (and points-selected? is-curve?)
- :make-curve (and points-selected? (not is-curve?))
- :add-node segments-selected?
- :remove-node points-selected?
- :merge-nodes segments-selected?
- :join-nodes (and points-selected? (>= num-points 2) (< num-segments max-segments))
- :separate-nodes segments-selected?})))
+(def ^:private handler-aligned-icon
+ (deprecated-icon/icon-xref :handlers-mirror (stl/css :pathbar-icon)))
+
+(def ^:private handler-independent-icon
+ (deprecated-icon/icon-xref :handlers-independent (stl/css :pathbar-icon)))
+
+(defn- handler-type-icon [type]
+ (case type
+ :mirror handler-mirror-icon
+ :aligned handler-aligned-icon
+ :independent handler-independent-icon
+ ;; Use the independent icon for mixed selections.
+ :mixed handler-independent-icon
+ handler-independent-icon))
+
+(defn toolbar-group-visibility
+ [structural-visible? shape-visible? handler-visible?]
+ (let [shape-handler-visible? (or shape-visible? handler-visible?)]
+ {:shape-handler-visible? shape-handler-visible?
+ :node-groups-separator-visible? (and structural-visible? shape-handler-visible?)
+ :snap-separator-visible? (or structural-visible? shape-handler-visible?)}))
+
+(mf/defc topbar-button*
+ "A path node action button."
+ {::mf/private true}
+ [{:keys [title on-click icon]}]
+ [:button {:class (stl/css :topbar-btn)
+ :title title
+ :on-click on-click}
+ icon])
+
+(defn- cancel-timer!
+ [timer-ref*]
+ (when-let [timer (mf/ref-val timer-ref*)]
+ (ts/dispose! timer)
+ (mf/set-ref-val! timer-ref* nil)))
+
+(mf/defc handler-type-menu*
+ "Sets the handler behavior of selected nodes."
+ {::mf/private true}
+ [{:keys [active-type on-select]}]
+ (let [open* (mf/use-state false)
+ open? (deref open*)
+
+ open-timer* (mf/use-ref nil)
+ close-timer* (mf/use-ref nil)
+
+ select
+ (mf/use-fn
+ (mf/deps on-select)
+ (fn [type]
+ (reset! open* false)
+ (on-select type)))
+
+ on-trigger-click
+ (mf/use-fn
+ (mf/deps select active-type)
+ (fn []
+ (case (path.helpers/handler-trigger-action active-type)
+ :open
+ (do
+ (cancel-timer! close-timer*)
+ (cancel-timer! open-timer*)
+ (reset! open* true))
+
+ :select
+ (select active-type))))
+
+ on-display-menu
+ (mf/use-fn
+ (fn []
+ (cancel-timer! close-timer*)
+ (cancel-timer! open-timer*)
+ (mf/set-ref-val!
+ open-timer*
+ (ts/schedule 350
+ #(do
+ (reset! open* true)
+ (mf/set-ref-val! open-timer* nil))))))
+
+ on-hide-menu
+ (mf/use-fn
+ (fn []
+ (cancel-timer! open-timer*)
+ (cancel-timer! close-timer*)
+ (mf/set-ref-val!
+ close-timer*
+ (ts/schedule 350
+ #(do
+ (reset! open* false)
+ (mf/set-ref-val! close-timer* nil))))))]
+
+ (mf/with-effect []
+ (fn []
+ (cancel-timer! open-timer*)
+ (cancel-timer! close-timer*)))
+
+ [:div {:class (stl/css :handler-menu)
+ :on-pointer-enter on-display-menu
+ :on-pointer-leave on-hide-menu}
+ [:button {:class (stl/css :topbar-btn :handler-trigger)
+ :title (tr "workspace.path.actions.handler-type")
+ :aria-haspopup true
+ :aria-expanded open?
+ :on-click on-trigger-click}
+ (handler-type-icon active-type)
+ [:svg {:view-box "0 0 6 6"
+ :aria-hidden true
+ :class (stl/css :flyout-indicator)}
+ [:path {:d "M4,2 L4,3.15 C4,3.62 3.62,4 3.15,4 L2,4"
+ :stroke-linecap "round"}]]]
+ [:div {:class (stl/css-case :handler-popover true :open open?)
+ :data-dont-clear-path true}
+ [:button {:class (stl/css-case :is-toggled (= active-type :mirror) :topbar-btn true)
+ :title (tr "workspace.path.actions.handler-mirror")
+ :on-click #(select :mirror)}
+ handler-mirror-icon]
+ [:button {:class (stl/css-case :is-toggled (= active-type :aligned) :topbar-btn true)
+ :title (tr "workspace.path.actions.handler-aligned")
+ :on-click #(select :aligned)}
+ handler-aligned-icon]
+ [:button {:class (stl/css-case :is-toggled (= active-type :independent) :topbar-btn true)
+ :title (tr "workspace.path.actions.handler-independent")
+ :on-click #(select :independent)}
+ handler-independent-icon]]]))
(mf/defc path-actions*
[{:keys [shape state]}]
- (let [{:keys [edit-mode selected-points snap-toggled]} state
+ (let [{:keys [edit-mode selection snap-toggled]} state
content (:content shape)
+ ;; Include segment endpoints in node actions.
+ selected-nodes (path.helpers/selected-node-indices content selection)
+
enabled-buttons
(mf/use-memo
- (mf/deps content selected-points)
- #(check-enabled content selected-points))
+ (mf/deps content selection)
+ #(path.helpers/check-enabled content selected-nodes))
on-select-draw-mode
(mf/use-fn
@@ -87,20 +194,6 @@
(fn [_]
(st/emit! (drp/change-edit-mode :move))))
- on-add-node
- (mf/use-fn
- (mf/deps (:add-node enabled-buttons))
- (fn [_]
- (when (:add-node enabled-buttons)
- (st/emit! (drp/add-node)))))
-
- on-remove-node
- (mf/use-fn
- (mf/deps (:remove-node enabled-buttons))
- (fn [_]
- (when (:remove-node enabled-buttons)
- (st/emit! (drp/remove-node)))))
-
on-merge-nodes
(mf/use-fn
(mf/deps (:merge-nodes enabled-buttons))
@@ -139,81 +232,93 @@
on-toggle-snap
(mf/use-fn
(fn [_]
- (st/emit! (drp/toggle-snap))))]
+ (st/emit! (drp/toggle-snap))))
+
+ ;; Show node actions only when they apply.
+ structural-visible? (or (:merge-nodes enabled-buttons)
+ (:join-nodes enabled-buttons)
+ (:separate-nodes enabled-buttons))
+ shape-visible? (or (:make-corner enabled-buttons)
+ (:make-curve enabled-buttons))
+
+ ;; Resolve selected handlers to their curve nodes.
+ handler-nodes (path.helpers/handler-target-nodes content selection)
+ handler-state (path.helpers/handler-selection-state
+ content (:handler-types state) handler-nodes)
+ active-handler-type (:active-type handler-state)
+ handler-visible? (and (= edit-mode :move) (seq (:nodes handler-state)))
+
+ group-visibility
+ (toolbar-group-visibility structural-visible? shape-visible? handler-visible?)
+
+ node-groups-separator-visible?
+ (:node-groups-separator-visible? group-visibility)
+
+ middle-visible?
+ (:snap-separator-visible? group-visibility)
+
+ on-set-handler-type
+ (mf/use-fn
+ (fn [type]
+ (st/emit! (drp/set-handler-type type))))]
[:div {:class (stl/css :sub-actions)
:data-dont-clear-path true}
+ ;; Mode: draw / move (always visible)
[:div {:class (stl/css :sub-actions-group)}
-
- ;; Draw Mode
- [:button {:class (stl/css-case :is-toggled (= edit-mode :draw)
- :topbar-btn true)
+ [:button {:class (stl/css-case :is-toggled (= edit-mode :draw) :topbar-btn true)
:title (tr "workspace.path.actions.draw-nodes" (sc/get-tooltip :draw-nodes))
:on-click on-select-draw-mode}
pentool-icon]
-
- ;; Edit mode
- [:button {:class (stl/css-case :is-toggled (= edit-mode :move)
- :topbar-btn true)
+ [:button {:class (stl/css-case :is-toggled (= edit-mode :move) :topbar-btn true)
:title (tr "workspace.path.actions.move-nodes" (sc/get-tooltip :move-nodes))
:on-click on-select-edit-mode}
move-icon]]
- [:div {:class (stl/css :sub-actions-group)}
- ;; Add Node
- [:button {:disabled (not (:add-node enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.add-node" (sc/get-tooltip :add-node))
- :on-click on-add-node}
- add-icon]
+ [:div {:class (stl/css :separator)}]
- ;; Remove node
- [:button {:disabled (not (:remove-node enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.delete-node" (sc/get-tooltip :delete-node))
- :on-click on-remove-node}
- remove-icon]]
+ ;; Structural node ops: merge / join / separate
+ (when structural-visible?
+ [:div {:class (stl/css :sub-actions-group)}
+ (when (:merge-nodes enabled-buttons)
+ [:> topbar-button* {:title (tr "workspace.path.actions.merge-nodes" (sc/get-tooltip :merge-nodes))
+ :on-click on-merge-nodes
+ :icon merge-nodes-icon}])
+ (when (:join-nodes enabled-buttons)
+ [:> topbar-button* {:title (tr "workspace.path.actions.join-nodes" (sc/get-tooltip :join-nodes))
+ :on-click on-join-nodes
+ :icon join-nodes-icon}])
+ (when (:separate-nodes enabled-buttons)
+ [:> topbar-button* {:title (tr "workspace.path.actions.separate-nodes" (sc/get-tooltip :separate-nodes))
+ :on-click on-separate-nodes
+ :icon separate-nodes-icon}])])
- [:div {:class (stl/css :sub-actions-group)}
- ;; Merge Nodes
- [:button {:disabled (not (:merge-nodes enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.merge-nodes" (sc/get-tooltip :merge-nodes))
- :on-click on-merge-nodes}
- merge-nodes-icon]
+ (when node-groups-separator-visible?
+ [:div {:class (stl/css :separator)}])
- ;; Join Nodes
- [:button {:disabled (not (:join-nodes enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.join-nodes" (sc/get-tooltip :join-nodes))
- :on-click on-join-nodes}
- join-nodes-icon]
+ ;; Node shape and handler-behaviour ops
+ (when shape-visible?
+ [:div {:class (stl/css :sub-actions-group)}
+ (when (:make-corner enabled-buttons)
+ [:> topbar-button* {:title (tr "workspace.path.actions.make-corner" (sc/get-tooltip :make-corner))
+ :on-click on-make-corner
+ :icon to-corner-icon}])
+ (when (:make-curve enabled-buttons)
+ [:> topbar-button* {:title (tr "workspace.path.actions.make-curve" (sc/get-tooltip :make-curve))
+ :on-click on-make-curve
+ :icon to-curve-icon}])])
- ;; Separate Nodes
- [:button {:disabled (not (:separate-nodes enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.separate-nodes" (sc/get-tooltip :separate-nodes))
- :on-click on-separate-nodes}
- separate-nodes-icon]]
+ ;; Handler behaviour of the selected node(s)
+ (when handler-visible?
+ [:> handler-type-menu* {:active-type active-handler-type
+ :on-select on-set-handler-type}])
- [:div {:class (stl/css :sub-actions-group)}
- ; Make Corner
- [:button {:disabled (not (:make-corner enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.make-corner" (sc/get-tooltip :make-corner))
- :on-click on-make-corner}
- to-corner-icon]
+ (when middle-visible?
+ [:div {:class (stl/css :separator)}])
- ;; Make Curve
- [:button {:disabled (not (:make-curve enabled-buttons))
- :class (stl/css :topbar-btn)
- :title (tr "workspace.path.actions.make-curve" (sc/get-tooltip :make-curve))
- :on-click on-make-curve}
- to-curve-icon]]
- [:div {:class (stl/css :sub-actions-group)}
- ;; Toggle snap
- [:button {:class (stl/css-case :is-toggled snap-toggled
- :topbar-btn true)
+ ;; Toggle snap (always visible, pinned to the right)
+ [:div {:class (stl/css :sub-actions-group :snap-group)}
+ [:button {:class (stl/css-case :is-toggled snap-toggled :topbar-btn true)
:title (tr "workspace.path.actions.snap-nodes" (sc/get-tooltip :snap-nodes))
:on-click on-toggle-snap}
- snap-nodes-icon]]]))
+ snap-icon]]]))
diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.scss b/frontend/src/app/main/ui/workspace/viewport/path_actions.scss
index ca115480b6..7bc4aa0948 100644
--- a/frontend/src/app/main/ui/workspace/viewport/path_actions.scss
+++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.scss
@@ -5,22 +5,28 @@
// Copyright (c) KALEIDOS INC Sucursal en España SL
@use "refactor/common-refactor.scss" as deprecated;
+@use "ds/_borders.scss" as *;
+@use "ds/_sizes.scss" as *;
.sub-actions {
cursor: initial;
pointer-events: initial;
position: absolute;
- top: deprecated.$s-12;
+ top: var(--sp-xl);
left: 50%;
transform: translateX(-50%);
display: flex;
align-items: center;
- height: deprecated.$s-56;
- padding: deprecated.$s-8 deprecated.$s-16;
- border-radius: deprecated.$s-8;
- gap: deprecated.$s-16;
- border: deprecated.$s-2 solid var(--panel-border-color);
- z-index: deprecated.$z-index-3;
+ justify-content: flex-start;
+
+ // Keep the bar stable as actions change.
+ width: $sz-430;
+ height: $sz-48;
+ padding: var(--sp-s);
+ border-radius: $br-8;
+ gap: var(--sp-s);
+ border: $b-2 solid var(--panel-border-color);
+ z-index: var(--z-index-panels);
background-color: var(--color-background-primary);
transition:
top 0.3s,
@@ -33,22 +39,88 @@
display: flex;
align-items: center;
margin: 0;
- opacity: deprecated.$op-10;
+ opacity: 1;
transition: opacity 0.3s ease;
}
+// Pin the snap toggle to the right.
+.snap-group {
+ margin-left: auto;
+}
+
+.separator {
+ flex-shrink: 0;
+ width: $sz-1;
+ height: $sz-24;
+ margin: 0 var(--sp-xs);
+ background-color: var(--panel-border-color);
+}
+
+.handler-menu {
+ position: relative;
+ display: flex;
+ align-items: center;
+}
+
+// Handler behavior flyout trigger.
+.handler-trigger {
+ position: relative;
+}
+
+// Flyout corner indicator.
+.flyout-indicator {
+ position: absolute;
+ inset-block-end: var(--sp-xs);
+ inset-inline-end: var(--sp-xs);
+ inline-size: $sz-6;
+ block-size: $sz-6;
+ stroke: var(--pathbar-icon-color);
+ fill: none;
+ pointer-events: none;
+}
+
+.handler-popover {
+ position: absolute;
+ top: calc(100% + var(--sp-s));
+ left: 50%;
+ transform: translateX(-50%);
+ display: flex;
+ align-items: center;
+ padding: var(--sp-xs);
+ gap: var(--sp-xxs);
+ border-radius: $br-8;
+ border: $b-2 solid var(--panel-border-color);
+ background-color: var(--color-background-primary);
+ z-index: var(--z-index-dropdown);
+
+ // Hidden until the flyout opens.
+ opacity: 0;
+ visibility: hidden;
+ pointer-events: none;
+ transition:
+ opacity 80ms ease-out,
+ visibility 80ms linear;
+
+ &.open {
+ opacity: 1;
+ visibility: visible;
+ pointer-events: auto;
+ }
+}
+
.topbar-btn {
--pathbar-icon-color: var(--color-foreground-secondary);
+ --button-tertiary-background-color-hover: var(--color-background-tertiary);
@extend %button-tertiary;
- height: deprecated.$s-36;
- width: deprecated.$s-36;
+ height: $sz-32;
+ width: $sz-32;
flex-shrink: 0;
background-color: transparent;
- border-radius: deprecated.$s-8;
+ border-radius: $br-8;
border: none;
- margin: 0 deprecated.$s-2;
+ margin: 0 var(--sp-xxs);
&.is-toggled {
--pathbar-icon-color: var(--button-radio-foreground-color-active);
diff --git a/frontend/src/app/main/ui/workspace/viewport/path_state.cljs b/frontend/src/app/main/ui/workspace/viewport/path_state.cljs
new file mode 100644
index 0000000000..0f1d7da23b
--- /dev/null
+++ b/frontend/src/app/main/ui/workspace/viewport/path_state.cljs
@@ -0,0 +1,39 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+(ns app.main.ui.workspace.viewport.path-state
+ (:require
+ [app.common.types.path :as path]
+ [app.main.data.workspace.path.state :as path.state]
+ [app.main.ui.workspace.viewport.drawarea :as drawarea]))
+
+(defn derive-path-state
+ "Derives the shared path-editing view model used by classic and WASM viewports."
+ [edit-path edition drawing-tool drawing-object objects]
+ (let [edit-state (path.state/current-edit-state edit-path edition)
+ editing? (path.state/editing? edit-path edition)
+ drawing? (path.state/drawing? edit-state edition drawing-tool drawing-object)
+ editing-shape (when edition
+ (if editing?
+ drawing-object
+ (get objects edition)))
+ editing-shape (if editing?
+ (path/convert-to-path editing-shape objects)
+ editing-shape)
+ bar-state (or edit-state
+ (when drawing?
+ (get edit-path (get drawing-object :id))))
+ bar-shape (or editing-shape drawing-object)
+ drawing-shape (if (and editing? edition)
+ (drawarea/path-edit-shape drawing-object (get objects edition))
+ drawing-object)]
+ {:edit-state edit-state
+ :editing? editing?
+ :drawing? drawing?
+ :editing-shape editing-shape
+ :bar-state bar-state
+ :bar-shape bar-shape
+ :drawing-shape drawing-shape}))
diff --git a/frontend/src/app/main/ui/workspace/viewport/selection.cljs b/frontend/src/app/main/ui/workspace/viewport/selection.cljs
index 9e497ef8d0..2d63116419 100644
--- a/frontend/src/app/main/ui/workspace/viewport/selection.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/selection.cljs
@@ -14,6 +14,8 @@
[app.common.geom.shapes :as gsh]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
+ [app.common.types.path :as path]
+ [app.common.types.path.helpers :as path.helpers]
[app.common.types.shape :as cts]
[app.main.data.helpers :as dsh]
[app.main.data.workspace :as dw]
@@ -43,7 +45,7 @@
(mf/defc selection-rect
{::mf/wrap-props false}
- [{:keys [transform rect zoom color on-move-selected on-context-menu]}]
+ [{:keys [transform rect zoom color on-move-selected on-context-menu hide-outline?]}]
(let [x (dm/get-prop rect :x)
y (dm/get-prop rect :y)
width (dm/get-prop rect :width)
@@ -71,13 +73,15 @@
:transform (str transform)
:on-pointer-down on-move-selected
:on-context-menu on-context-menu
- :style {:stroke color
+ ;; Keep hidden outlines draggable.
+ :pointer-events (when ^boolean hide-outline? "all")
+ :style {:stroke (if ^boolean hide-outline? "none" color)
:stroke-width (/ selection-rect-width zoom)
:fill "none"}}]))
(defn- calculate-handlers
- "Calculates selection handlers for the current selection."
- [selection shape zoom]
+ "Calculates resize and rotation handles for the selection."
+ [selection shape zoom only-rotation?]
(let [x (dm/get-prop selection :x)
y (dm/get-prop selection :y)
width (dm/get-prop selection :width)
@@ -117,69 +121,72 @@
:props #js {:cx x :cy (+ y height)}}]]
- (when-not ^boolean horizontal-line?
- (array/conj! result
- #js {:type :resize-side
- :position :top
- :props #js {:x (if ^boolean small-width?
- (+ x (/ (- width threshold-small) 2))
- x)
- :y y
- :length (if ^boolean small-width?
- threshold-small
- width)
- :angle 0
- :align align
- :show-handler tiny-width?}}
- #js {:type :resize-side
- :position :bottom
- :props #js {:x (if ^boolean small-width?
- (+ x (/ (+ width threshold-small) 2))
- (+ x width))
- :y (+ y height)
- :length (if small-width? threshold-small width)
- :angle 180
- :align align
- :show-handler tiny-width?}}))
+ (if ^boolean only-rotation?
+ result
+ (do
+ (when-not ^boolean horizontal-line?
+ (array/conj! result
+ #js {:type :resize-side
+ :position :top
+ :props #js {:x (if ^boolean small-width?
+ (+ x (/ (- width threshold-small) 2))
+ x)
+ :y y
+ :length (if ^boolean small-width?
+ threshold-small
+ width)
+ :angle 0
+ :align align
+ :show-handler tiny-width?}}
+ #js {:type :resize-side
+ :position :bottom
+ :props #js {:x (if ^boolean small-width?
+ (+ x (/ (+ width threshold-small) 2))
+ (+ x width))
+ :y (+ y height)
+ :length (if small-width? threshold-small width)
+ :angle 180
+ :align align
+ :show-handler tiny-width?}}))
- (when-not vertical-line?
- (array/conj! result
- #js {:type :resize-side
- :position :right
- :props #js {:x (+ x width)
- :y (if small-height? (+ y (/ (- height threshold-small) 2)) y)
- :length (if small-height? threshold-small height)
- :angle 90
- :align align
- :show-handler tiny-height?}}
+ (when-not vertical-line?
+ (array/conj! result
+ #js {:type :resize-side
+ :position :right
+ :props #js {:x (+ x width)
+ :y (if small-height? (+ y (/ (- height threshold-small) 2)) y)
+ :length (if small-height? threshold-small height)
+ :angle 90
+ :align align
+ :show-handler tiny-height?}}
- #js {:type :resize-side
- :position :left
- :props #js {:x x
- :y (if ^boolean small-height?
- (+ y (/ (+ height threshold-small) 2))
- (+ y height))
- :length (if ^boolean small-height?
- threshold-small
- height)
- :angle 270
- :align align
- :show-handler tiny-height?}}))
+ #js {:type :resize-side
+ :position :left
+ :props #js {:x x
+ :y (if ^boolean small-height?
+ (+ y (/ (+ height threshold-small) 2))
+ (+ y height))
+ :length (if ^boolean small-height?
+ threshold-small
+ height)
+ :angle 270
+ :align align
+ :show-handler tiny-height?}}))
- (when (and (not tiny-width?) (not tiny-height?))
- (array/conj! result
- #js {:type :resize-point
- :position :top-left
- :props #js {:cx x :cy y :align align}}
- #js {:type :resize-point
- :position :top-right
- :props #js {:cx (+ x width) :cy y :align align}}
- #js {:type :resize-point
- :position :bottom-right
- :props #js {:cx (+ x width) :cy (+ y height) :align align}}
- #js {:type :resize-point
- :position :bottom-left
- :props #js {:cx x :cy (+ y height) :align align}}))))
+ (when (and (not tiny-width?) (not tiny-height?))
+ (array/conj! result
+ #js {:type :resize-point
+ :position :top-left
+ :props #js {:cx x :cy y :align align}}
+ #js {:type :resize-point
+ :position :top-right
+ :props #js {:cx (+ x width) :cy y :align align}}
+ #js {:type :resize-point
+ :position :bottom-right
+ :props #js {:cx (+ x width) :cy (+ y height) :align align}}
+ #js {:type :resize-point
+ :position :bottom-left
+ :props #js {:cx x :cy (+ y height) :align align}}))))))
(mf/defc rotation-handler
{::mf/wrap-props false}
@@ -328,7 +335,7 @@
:stroke-width 0}}]]))
(mf/defc controls-selection*
- [{:keys [shape zoom color on-move-selected on-context-menu disabled]}]
+ [{:keys [shape zoom color on-move-selected on-context-menu disabled hide-outline?]}]
(let [selrect-transform (mf/deref refs/workspace-selrect)
transform-type (mf/deref refs/current-transform)
[selrect transform] (dsh/get-selrect selrect-transform shape)]
@@ -342,12 +349,13 @@
:transform transform
:zoom zoom
:color color
+ :hide-outline? hide-outline?
:on-move-selected on-move-selected
:on-context-menu on-context-menu}]])))
(mf/defc controls-handlers*
{::mf/private true}
- [{:keys [shape zoom color on-resize on-rotate disabled]}]
+ [{:keys [shape zoom color on-resize on-rotate disabled only-rotation?]}]
(let [selrect-transform (mf/deref refs/workspace-selrect)
transform-type (mf/deref refs/current-transform)
@@ -374,7 +382,7 @@
(= transform-type :rotate))))
[:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
- (for [handler (calculate-handlers selrect shape zoom)]
+ (for [handler (calculate-handlers selrect shape zoom only-rotation?)]
(let [type (obj/get handler "type")
position (obj/get handler "position")
props (obj/get handler "props")
@@ -482,6 +490,46 @@
:on-move-selected on-move-selected
:on-context-menu on-context-menu}]))
+(mf/defc line-handlers*
+ "Endpoint handles for a straight path."
+ {::mf/private true}
+ [{:keys [shape zoom color disabled]}]
+ (let [read-only? (mf/use-ctx ctx/workspace-read-only?)
+ transform-type (mf/deref refs/current-transform)
+ content (dm/get-prop shape :content)
+ p1 (path.helpers/segment->point (nth content 0))
+ p2 (path.helpers/segment->point (nth content 1))]
+
+ (when (and (not ^boolean read-only?)
+ (not (:blocked shape))
+ (not (or (= transform-type :move)
+ (= transform-type :rotate))))
+ [:g.controls {:pointer-events (if ^boolean disabled "none" "visible")}
+ (for [[index point] [[0 p1] [1 p2]]]
+ (let [x (dm/get-prop point :x)
+ y (dm/get-prop point :y)
+
+ on-pointer-down
+ (fn [event]
+ (when (dom/left-mouse? event)
+ (dom/stop-propagation event)
+ (st/emit! (dw/start-move-line-point shape index))))]
+ [:g.path-point {:key index}
+ [:circle {:cx x
+ :cy y
+ :r (/ resize-point-radius zoom)
+ :style {:stroke-width "1px"
+ :stroke color
+ :fill "var(--app-white)"
+ :vectorEffect "non-scaling-stroke"}}]
+ [:circle {:cx x
+ :cy y
+ :r (/ resize-point-circle-radius zoom)
+ :on-pointer-down on-pointer-down
+ :class (cur/get-static "pointer-node")
+ :style {:fill (if (dbg/enabled? :handlers) "red" "none")
+ :stroke-width 0}}]]))])))
+
(mf/defc single-handlers*
{::mf/private true}
[{:keys [shape zoom color disabled]}]
@@ -489,6 +537,9 @@
grow-type (dm/get-prop shape :grow-type)
shape-type (dm/get-prop shape :type)
+ line? (and (cfh/path-shape? shape)
+ (path/single-line? (dm/get-prop shape :content)))
+
on-resize
(mf/use-fn
(mf/deps shape-id shape grow-type shape-type)
@@ -526,24 +577,44 @@
(dom/stop-propagation event)
(st/emit! (dw/start-rotate [shape])))))]
- [:> controls-handlers*
- {:shape shape
- :zoom zoom
- :color color
- :disabled disabled
- :on-rotate on-rotate
- :on-resize on-resize}]))
+ (if ^boolean line?
+ [:g.line-controls
+ ;; Use endpoint controls with corner rotation handles.
+ [:> controls-handlers*
+ {:shape shape
+ :zoom zoom
+ :color color
+ :disabled disabled
+ :on-rotate on-rotate
+ :on-resize on-resize
+ :only-rotation? true}]
+ [:> line-handlers*
+ {:shape shape
+ :zoom zoom
+ :color color
+ :disabled disabled}]]
+ [:> controls-handlers*
+ {:shape shape
+ :zoom zoom
+ :color color
+ :disabled disabled
+ :on-rotate on-rotate
+ :on-resize on-resize}])))
(mf/defc single-selection*
{::mf/private true}
[{:keys [shape zoom color disabled on-move-selected on-context-menu]}]
- [:> controls-selection*
- {:shape shape
- :zoom zoom
- :color color
- :disabled disabled
- :on-move-selected on-move-selected
- :on-context-menu on-context-menu}])
+ (let [line? (and (cfh/path-shape? shape)
+ (path/single-line? (dm/get-prop shape :content)))]
+ [:> controls-selection*
+ {:shape shape
+ :zoom zoom
+ :color color
+ :disabled disabled
+ ;; Keep the line body draggable without an outline.
+ :hide-outline? line?
+ :on-move-selected on-move-selected
+ :on-context-menu on-context-menu}]))
(mf/defc area*
[{:keys [shapes edition zoom disabled on-move-selected on-context-menu]}]
diff --git a/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs b/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs
index c92c357d25..c85d6aba0d 100644
--- a/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/top_bar.cljs
@@ -56,3 +56,23 @@
(mf/defc grid-edition-bar*
[{:keys [shape]}]
[:> grid-edition-actions* {:shape shape}])
+
+(mf/defc edition-bars*
+ [{:keys [layout
+ path-editing
+ path-drawing
+ path-state
+ path-shape
+ grid-editing
+ grid-shape
+ single-select]}]
+ [:*
+ (when (or (and ^boolean path-editing ^boolean single-select)
+ (and ^boolean path-drawing (some? path-state)))
+ [:> path-edition-bar* {:shape path-shape
+ :edit-path-state path-state
+ :layout layout}])
+
+ (when (and ^boolean grid-editing ^boolean single-select)
+ [:> grid-edition-bar* {:shape grid-shape}])])
+
diff --git a/frontend/src/app/main/ui/workspace/viewport/utils.cljs b/frontend/src/app/main/ui/workspace/viewport/utils.cljs
index 7858a07f46..d747d7047d 100644
--- a/frontend/src/app/main/ui/workspace/viewport/utils.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/utils.cljs
@@ -29,6 +29,8 @@
:create-ellipse (cur/get-static "create-ellipse")
:pen (cur/get-static "pen")
:pencil (cur/get-static "pencil")
+ :draw-path (cur/get-static "draw")
+ :edit-path (cur/get-static "move")
:create-shape (cur/get-static "create-shape")
:duplicate (cur/get-static "duplicate")
:zoom (cur/get-static "zoom")
diff --git a/frontend/src/app/main/ui/workspace/viewport/viewport_ref.cljs b/frontend/src/app/main/ui/workspace/viewport/viewport_ref.cljs
index 38349f8f24..a7609df35f 100644
--- a/frontend/src/app/main/ui/workspace/viewport/viewport_ref.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/viewport_ref.cljs
@@ -17,6 +17,11 @@
(defonce viewport-ref (atom nil))
(defonce viewport-brect (atom nil))
+(defn capture-pointer
+ [event]
+ (when-let [viewport @viewport-ref]
+ (.setPointerCapture viewport (.-pointerId event))))
+
(defn- init-observer
[node]
(let [on-change-bounds
diff --git a/frontend/src/app/main/ui/workspace/viewport_wasm.cljs b/frontend/src/app/main/ui/workspace/viewport_wasm.cljs
index 906f68eb2a..8a953f1a1c 100644
--- a/frontend/src/app/main/ui/workspace/viewport_wasm.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport_wasm.cljs
@@ -13,7 +13,6 @@
[app.common.geom.shapes :as gsh]
[app.common.types.color :as clr]
[app.common.types.component :as ctk]
- [app.common.types.path :as path]
[app.common.types.shape :as cts]
[app.common.types.shape.layout :as ctl]
[app.main.data.modal :as modal]
@@ -44,6 +43,7 @@
[app.main.ui.workspace.viewport.hooks :as hooks]
[app.main.ui.workspace.viewport.interactions :as interactions]
[app.main.ui.workspace.viewport.outline :as outline]
+ [app.main.ui.workspace.viewport.path-state :as path-state]
[app.main.ui.workspace.viewport.pixel-overlay :as pixel-overlay]
[app.main.ui.workspace.viewport.presence :as presence]
[app.main.ui.workspace.viewport.rulers :as rulers]
@@ -51,8 +51,7 @@
[app.main.ui.workspace.viewport.selection :as selection]
[app.main.ui.workspace.viewport.snap-distances :as snap-distances]
[app.main.ui.workspace.viewport.snap-points :as snap-points]
- [app.main.ui.workspace.viewport.top-bar :refer [grid-edition-bar*
- path-edition-bar*
+ [app.main.ui.workspace.viewport.top-bar :refer [edition-bars*
view-only-bar*]]
[app.main.ui.workspace.viewport.utils :as utils]
[app.main.ui.workspace.viewport.viewport-ref :as vp-ref :refer [create-viewport-ref]]
@@ -282,21 +281,22 @@
;; Only when we have all the selected shapes in one frame
selected-frame (when (= (count selected-frames) 1) (get base-objects (first selected-frames)))
- edit-path-state (get edit-path edition)
- edit-path-mode (get edit-path-state :edit-mode)
+ {:keys [edit-state
+ editing?
+ drawing?
+ editing-shape
+ bar-state
+ bar-shape
+ drawing-shape]}
+ (mf/with-memo [edit-path edition drawing-tool drawing-obj base-objects]
+ (path-state/derive-path-state edit-path edition drawing-tool drawing-obj base-objects))
- path-editing? (some? edit-path-state)
- path-drawing? (or (= edit-path-mode :draw)
- (and (= :path (get drawing-obj :type))
- (not= :curve drawing-tool)))
-
- editing-shape (when edition
- (get base-objects edition))
-
- editing-shape (mf/with-memo [editing-shape path-editing? base-objects]
- (if path-editing?
- (path/convert-to-path editing-shape base-objects)
- editing-shape))
+ edit-path-state edit-state
+ path-editing? editing?
+ path-drawing? drawing?
+ path-bar-state bar-state
+ path-bar-shape bar-shape
+ draw-area-shape drawing-shape
create-comment? (= :comments drawing-tool)
@@ -372,8 +372,9 @@
show-snap-points? (and (or (contains? layout :dynamic-alignment)
(contains? layout :snap-guides))
(or drawing-obj transform)
+ (not path-editing?)
(not page-transition?))
- show-selrect? (and selrect (empty? drawing) (not text-editing?) (not page-transition?))
+ show-selrect? (and selrect (or (empty? drawing) path-editing?) (not text-editing?) (not page-transition?))
show-measures? (and (not transform)
(not path-editing?)
(or show-distances? mode-inspect? read-only?)
@@ -629,13 +630,24 @@
(hooks/setup-dom-events zoom disable-paste-ref in-viewport-ref read-only? drawing-tool path-drawing?)
(hooks/setup-viewport-size vport viewport-ref)
- (hooks/setup-cursor cursor alt? mod? space? panning drawing-tool path-drawing? path-editing? z? read-only?)
+ (hooks/setup-cursor cursor alt? mod? space? panning drawing-tool path-drawing? path-editing? (get path-bar-state :drag-cursor) z? read-only?)
(hooks/setup-keyboard alt? mod? space? z? shift?)
(hooks/setup-hover-shapes page-id move-stream base-objects selected mod? hover measure-hover
hover-ids hover-top-frame-id @hover-disabled? focus zoom show-measures? read-only? transform)
(hooks/setup-shortcuts path-editing? path-drawing? text-editing? grid-editing?)
(hooks/setup-active-frames base-objects hover-ids selected active-frames zoom transform vbox)
+ (mf/with-effect [path-editing? edition @initialized?]
+ (when (and path-editing? edition @initialized?)
+ (wasm.api/use-shape edition)
+ (wasm.api/set-shape-hidden true)
+ (wasm.api/request-render "start-path-edition")
+ (fn []
+ (when (wasm.api/initialized?)
+ (wasm.api/use-shape edition)
+ (wasm.api/set-shape-hidden false)
+ (wasm.api/request-render "stop-path-edition")))))
+
[:div {:class (stl/css :viewport) :style #js {"--zoom" zoom} :data-testid "viewport"}
(cond
@@ -650,15 +662,14 @@
(when-not hide-ui?
[:> top-toolbar* {:layout layout}])
- (when (and ^boolean path-editing?
- ^boolean single-select?)
- [:> path-edition-bar* {:shape editing-shape
- :edit-path-state edit-path-state
- :layout layout}])
-
- (when (and ^boolean grid-editing?
- ^boolean single-select?)
- [:> grid-edition-bar* {:shape editing-shape}])])
+ [:> edition-bars* {:layout layout
+ :path-editing path-editing?
+ :path-drawing path-drawing?
+ :path-state path-bar-state
+ :path-shape path-bar-shape
+ :grid-editing grid-editing?
+ :grid-shape editing-shape
+ :single-select single-select?}]])
[:div {:class (stl/css :viewport-overlays)}
(when show-comments?
@@ -863,7 +874,7 @@
(when (and ^boolean show-draw-area?
^boolean (cts/shape? drawing-obj))
[:> drawarea/draw-area*
- {:shape drawing-obj
+ {:shape draw-area-shape
:zoom zoom
:tool drawing-tool}])
diff --git a/frontend/test/frontend_tests/logic/path_actions_test.cljs b/frontend/test/frontend_tests/logic/path_actions_test.cljs
new file mode 100644
index 0000000000..09451937ee
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_actions_test.cljs
@@ -0,0 +1,120 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+(ns frontend-tests.logic.path-actions-test
+ (:require
+ [app.common.geom.point :as gpt]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.path.helpers :as path.helpers]
+ [app.main.ui.workspace.viewport.path-actions :as path.actions]
+ [cljs.test :as t :include-macros true]
+ [frontend-tests.logic.path-test-helpers :as pth]))
+
+(t/deftest mixed-corner-and-curve-selection-enables-both-conversions
+ (let [content (pth/mixed-corner-curve-content)
+ points (path/get-points content)
+ enabled (path.helpers/check-enabled content #{0 1})]
+ (t/is (false? (path/is-curve-point? content (first points))))
+ (t/is (true? (path/is-curve-point? content (second points))))
+ (t/is (true? (:make-corner enabled)))
+ (t/is (true? (:make-curve enabled)))))
+
+(t/deftest action-eligibility-keeps-coincident-node-identities
+ (let [content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 2 :c2x 8 :c2y 2 :x 10 :y 0}}])
+ enabled (path.helpers/check-enabled content #{0 2})]
+ (t/is (true? (:make-corner enabled)))
+ (t/is (true? (:make-curve enabled)))
+ (t/is (true? (:merge-nodes enabled)))
+ (t/is (true? (:join-nodes enabled)))))
+
+(t/deftest toolbar-separators-only-render-between-visible-tool-groups
+ (t/are [structural? shape? handler? expected]
+ (= expected
+ (path.actions/toolbar-group-visibility structural? shape? handler?))
+ false false false
+ {:shape-handler-visible? false
+ :node-groups-separator-visible? false
+ :snap-separator-visible? false}
+
+ true false false
+ {:shape-handler-visible? false
+ :node-groups-separator-visible? false
+ :snap-separator-visible? true}
+
+ false true false
+ {:shape-handler-visible? true
+ :node-groups-separator-visible? false
+ :snap-separator-visible? true}
+
+ true true false
+ {:shape-handler-visible? true
+ :node-groups-separator-visible? true
+ :snap-separator-visible? true}
+
+ true false true
+ {:shape-handler-visible? true
+ :node-groups-separator-visible? true
+ :snap-separator-visible? true}))
+
+(t/deftest handler-toolbar-represents-equal-and-mixed-multi-node-modes
+ (let [content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 0 :c2x 8 :c2y 0 :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 0 :c2x 18 :c2y 0 :x 20 :y 0}}
+ {:command :curve-to
+ :params {:c1x 22 :c1y 0 :c2x 28 :c2y 0 :x 30 :y 0}}])
+ nodes #{1 2}]
+ ;; Matching nodes share one active mode.
+ (t/is (= {:nodes #{1 2} :active-type :mirror}
+ (path.helpers/handler-selection-state content {} nodes)))
+ ;; Stored mixed modes return `:mixed`.
+ (t/is (= {:nodes #{1 2} :active-type :mixed}
+ (path.helpers/handler-selection-state content {2 :aligned} nodes)))
+ (t/is (= {:nodes #{1 2} :active-type :aligned}
+ (path.helpers/handler-selection-state
+ content {1 :aligned 2 :aligned} nodes)))
+ (t/is (= :open (path.helpers/handler-trigger-action :mixed)))
+ (t/is (= :select (path.helpers/handler-trigger-action :mirror)))))
+
+(t/deftest handler-toolbar-detects-derived-independent-and-mirror-targets
+ (let [content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 0 :c2x 8 :c2y 0 :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 0 :c2x 18 :c2y 5 :x 20 :y 0}}])
+ node-targets #{1 2}
+ handler-targets (path.helpers/handler-target-nodes
+ content
+ {:nodes #{}
+ :segments #{}
+ :handlers #{[1 :c2] [2 :c2]}})]
+ (t/is (= :mirror (path.helpers/derive-handler-type content 1)))
+ (t/is (= :independent (path.helpers/derive-handler-type content 2)))
+ (t/is (= {:nodes #{1 2} :active-type :mixed}
+ (path.helpers/handler-selection-state content {} node-targets)))
+ (t/is (= #{1 2} handler-targets))
+ (t/is (= {:nodes #{1 2} :active-type :mixed}
+ (path.helpers/handler-selection-state content {} handler-targets)))))
+
+(t/deftest opposite-handler-target-matches-handler-mode
+ (let [node (gpt/point 10 0)
+ handler (gpt/point 14 3)
+ opposite (gpt/point 6 0)]
+ (t/is (= (gpt/point 6 -3)
+ (path.helpers/opposite-handler-target node handler opposite :mirror)))
+ (t/is (= 4
+ (gpt/distance
+ node
+ (path.helpers/opposite-handler-target node handler opposite :aligned))))))
+
diff --git a/frontend/test/frontend_tests/logic/path_clipboard_test.cljs b/frontend/test/frontend_tests/logic/path_clipboard_test.cljs
new file mode 100644
index 0000000000..486cd83a8f
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_clipboard_test.cljs
@@ -0,0 +1,204 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+
+(ns frontend-tests.logic.path-clipboard-test
+ (:require
+ [app.common.geom.point :as gpt]
+ [app.common.geom.rect :as grc]
+ [app.common.test-helpers.files :as cthf]
+ [app.common.test-helpers.shapes :as cths]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.path.clipboard :as path.clipboard]
+ [app.main.data.workspace.path.edition :as path.edition]
+ [app.main.data.workspace.path.helpers :as path.helpers]
+ [app.main.streams :as ms]
+ [beicon.v2.core :as rx]
+ [cljs.test :as t :include-macros true]
+ [clojure.set :as set]
+ [frontend-tests.helpers.state :as ths]
+ [frontend-tests.logic.path-test-helpers :as pth]
+ [potok.v2.core :as ptk]))
+
+(t/deftest cut-selected-nodes-copies-then-removes
+ ;; Cut emits copy followed by the regular delete action.
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content {:nodes #{1} :segments #{} :handlers #{}})
+ events (atom [])
+ _ (->> (ptk/watch (path.clipboard/cut-selected-nodes) state nil)
+ (rx/subs! #(swap! events conj %)))
+ del (atom [])
+ _ (->> (ptk/watch (second @events) state nil)
+ (rx/subs! #(swap! del conj %)))
+ state' (ptk/update (first @del) state)
+ nodes (count (path/get-points (get-in state' [:workspace-drawing :object :content])))]
+ ;; two events emitted (copy, then the removal)
+ (t/is (= 2 (count @events)))
+ ;; The removal leaves fewer than three nodes.
+ (t/is (< nodes 3))))
+
+(t/deftest duplicate-selection-content-copies-nodes-and-segments
+ (let [content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}])]
+ ;; A lone node copies its incoming segment.
+ (let [{:keys [sub selected]}
+ (path.helpers/duplicate-selection-content
+ content {:nodes #{2} :segments #{}} (gpt/point 10 10))]
+ (t/is (= [[:move-to {:x 10 :y 0}]
+ [:line-to {:x 30 :y 10}]]
+ (mapv (juxt :command :params) sub)))
+ ;; only the new endpoint (index 1) is selected, not the attach point
+ (t/is (= #{1} selected)))
+ ;; Interior-node copies meet at one offset node.
+ (let [{:keys [sub selected]}
+ (path.helpers/duplicate-selection-content
+ content {:nodes #{1} :segments #{}} (gpt/point 10 10))]
+ (t/is (= [[:move-to {:x 0 :y 0}]
+ [:line-to {:x 20 :y 10}]
+ [:move-to {:x 20 :y 0}]
+ [:line-to {:x 20 :y 10}]]
+ (mapv (juxt :command :params) sub)))
+ (t/is (= #{1 3} selected)))
+ ;; Segment copies select both offset endpoints.
+ (let [{:keys [sub selected]}
+ (path.helpers/duplicate-selection-content
+ content {:nodes #{} :segments #{1}} (gpt/point 10 10))]
+ (t/is (= [[:move-to {:x 10 :y 10}]
+ [:line-to {:x 20 :y 10}]]
+ (mapv (juxt :command :params) sub)))
+ (t/is (= #{0 1} selected)))))
+
+(t/deftest duplicate-offset-stays-constant-in-screen-pixels
+ (t/is (= (gpt/point 10 10) (path.edition/duplicate-offset 1)))
+ (t/is (= (gpt/point 2.5 2.5) (path.edition/duplicate-offset 4)))
+ (t/is (= (gpt/point 20 20) (path.edition/duplicate-offset 0.5))))
+
+(t/deftest splice-duplicated-appends-copies-and-selects-only-new-nodes
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}])
+ result (path.helpers/duplicate-selection-content
+ content {:nodes #{2} :segments #{}} (gpt/point 10 10))
+ state (pth/selectable-path-state id content {:nodes #{2} :segments #{} :handlers #{}})
+ state' (ptk/update (path.edition/splice-duplicated result) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; Append the copy as a new subpath.
+ (t/is (= 5 (count content')))
+ ;; Select only the new endpoint.
+ (t/is (= #{4}
+ (get-in state' [:workspace-local :edit-path id :selection :nodes])))))
+
+(t/deftest pasting-path-content-splices-and-selects-new-nodes
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{1}
+ :segments #{}
+ :handlers #{}})
+ sub [{:command :move-to :params {:x 30 :y 30}}
+ {:command :line-to :params {:x 40 :y 30}}]
+ ;; Center the pasted fragment at the pointer.
+ _ (rx/push! ms/mouse-position (gpt/point 100 100))
+ state' (ptk/update (path.clipboard/paste-content sub) state)
+ content' (vec (get-in state' [:workspace-drawing :object :content]))
+ pasted (subvec content' 3)]
+ (t/is (= (vec content) (subvec content' 0 3)))
+ (t/is (= {:x 95 :y 100} (select-keys (:params (first pasted)) [:x :y])))
+ (t/is (= {:x 105 :y 100} (select-keys (:params (second pasted)) [:x :y])))
+ (t/is (= {:nodes #{3 4}
+ :segments #{}
+ :handlers #{}}
+ (get-in state' [:workspace-local :edit-path id :selection])))))
+
+(t/deftest pasting-over-identical-nodes-offsets-the-fragment
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content path.helpers/empty-selection)
+ ;; Same coordinates as the existing segment between nodes 0 and 1
+ sub [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to :params {:c1x 2 :c1y 0
+ :c2x 8 :c2y 0
+ :x 10 :y 0}}]
+ ;; Overlapping pasted nodes receive the collision offset.
+ _ (rx/push! ms/mouse-position (gpt/point 5 0))
+ state' (ptk/update (path.clipboard/paste-content sub) state)
+ content' (vec (get-in state' [:workspace-drawing :object :content]))
+ pasted (subvec content' 3)]
+ ;; Pasted nodes do not overlap existing nodes.
+ (t/is (= {:x 10 :y 10} (select-keys (:params (first pasted)) [:x :y])))
+ (t/is (= {:x 20 :y 10} (select-keys (:params (second pasted)) [:x :y])))))
+
+(t/deftest pasting-finds-a-free-offset-after-more-than-one-hundred-collisions
+ (let [id (random-uuid)
+ content (path/content
+ (into [{:command :move-to :params {:x 0 :y 0}}]
+ (map (fn [step]
+ {:command :line-to
+ :params {:x (* step 10) :y (* step 10)}}))
+ (range 1 101)))
+ state (pth/selectable-path-state id content path.helpers/empty-selection)
+ sub (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 1 :y 0}}])
+ _ (rx/push! ms/mouse-position nil)
+ state' (ptk/update (path.clipboard/paste-content sub) state)
+ content' (get-in state' [:workspace-drawing :object :content])
+ pasted (take-last 2 content')]
+ (t/is (= [{:x 1010 :y 1010} {:x 1011 :y 1010}]
+ (mapv #(select-keys (:params %) [:x :y]) pasted)))
+ (t/is (empty? (set/intersection
+ (set (path/get-points content))
+ (set (path/get-points pasted)))))))
+
+(defn- page-paths
+ [state]
+ (->> (:objects (cthf/current-page (ths/get-file-from-state state)))
+ vals
+ (filter #(= :path (:type %)))))
+
+(t/deftest pasting-path-nodes-outside-editor-creates-a-new-path-shape
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ store (ths/setup-store file)
+ content (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 40 :y 0}}
+ {:command :line-to :params {:x 40 :y 40}}])
+ target (gpt/point 300 300)]
+ ;; a new path shape is centred at the pointer position
+ (rx/push! ms/mouse-position target)
+ (ths/run-store
+ store done
+ [(path.clipboard/paste-nodes-as-shape content)]
+ (fn [new-state]
+ (let [paths (page-paths new-state)
+ pasted (first paths)]
+ (t/is (= 1 (count paths)))
+ (when pasted
+ (t/is (= target (grc/rect->center (:selrect pasted))))
+ (t/is (contains? (get-in new-state [:workspace-local :selected]) (:id pasted))))))))))
+
+(t/deftest pasting-path-nodes-while-editing-does-not-create-a-shape
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ id (:id (cths/get-shape file :rect1))
+ store (ths/setup-store file)
+ content (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 40 :y 0}}])
+ ;; Outside-editor paste does nothing during path editing.
+ events (conj (pth/start-path-edition-events id)
+ (path.clipboard/paste-nodes-as-shape content))]
+ (rx/push! ms/mouse-position (gpt/point 300 300))
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (t/is (empty? (page-paths new-state))))))))
diff --git a/frontend/test/frontend_tests/logic/path_helpers_test.cljs b/frontend/test/frontend_tests/logic/path_helpers_test.cljs
new file mode 100644
index 0000000000..ba0c28038f
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_helpers_test.cljs
@@ -0,0 +1,117 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+
+(ns frontend-tests.logic.path-helpers-test
+ (:require
+ [app.common.geom.point :as gpt]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.path.helpers :as path.helpers]
+ [app.main.data.workspace.path.streams :as path.streams]
+ [app.main.store :as st]
+ [cljs.test :as t :include-macros true]
+ [frontend-tests.logic.path-test-helpers :as pth]))
+
+(t/deftest to-pixel-snap-quantises-to-half-pixels-past-the-zoom-threshold
+ ;; Pixel snapping uses half steps above 300% zoom.
+ (let [original @st/state
+ snap (fn [zoom p]
+ (reset! st/state {:workspace-layout #{:snap-pixel-grid}
+ :workspace-local {:zoom zoom}})
+ (path.streams/to-pixel-snap p))]
+ (try
+ ;; at or below the threshold, snapping rounds to whole pixels
+ (t/is (= (gpt/point 100 100) (snap 1 (gpt/point 100.4 100.4))))
+ (t/is (= (gpt/point 100 100) (snap 3 (gpt/point 100.4 100.4))))
+ ;; above 300% zoom it rounds to the nearest half pixel
+ (t/is (= (gpt/point 100.5 100.5) (snap 6 (gpt/point 100.4 100.4))))
+ ;; with pixel snapping off the position passes through unchanged
+ (reset! st/state {:workspace-layout #{} :workspace-local {:zoom 6}})
+ (t/is (= (gpt/point 100.4 100.4)
+ (path.streams/to-pixel-snap (gpt/point 100.4 100.4))))
+ (finally
+ (reset! st/state original)))))
+
+(t/deftest node-merge-snap-finds-the-closest-target-for-multiple-moving-points
+ (let [start-point (gpt/point 0 0)
+ selected-points #{start-point (gpt/point 100 0)}
+ points (into selected-points
+ [(gpt/point 8 14)
+ (gpt/point 111 10.5)
+ (gpt/point 500 500)])
+ snap-position (path.streams/make-node-merge-snap
+ start-point selected-points points 10)]
+ ;; The closest merge target moves the full selection.
+ (t/is (= (gpt/point 11 10.5)
+ (snap-position (gpt/point 10 10))))
+ ;; Missing merge targets return no snap delta.
+ (t/is (nil? (snap-position (gpt/point 300 300))))))
+
+(t/deftest insertion-preview-reuses-precomputed-segment-midpoints
+ (let [content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 10 :c1y 0
+ :c2x 20 :c2y 10
+ :x 20 :y 0}}
+ {:command :close-path :params {}}])
+ midpoints (path.helpers/insertion-mid-points content)
+ line-mid (first midpoints)
+ curve-mid (second midpoints)]
+ (t/is (= 2 (count midpoints)))
+ (t/is (= (gpt/point 5 0) line-mid))
+ (t/is (= {:from-p (gpt/point 0 0)
+ :to-p (gpt/point 10 0)
+ :t 0.5}
+ (meta line-mid)))
+ (t/is (= line-mid
+ (path.helpers/insertion-point
+ content (gpt/point 5.5 0) 1 false midpoints)))
+ (t/is (nil? (path.helpers/insertion-point
+ content (gpt/point 200 200) 1 false midpoints)))
+ ;; Alt/insert-anywhere remains dynamic and ignores the midpoint cache.
+ (t/is (some? (path.helpers/insertion-point
+ content curve-mid 1 true [])))))
+
+(t/deftest selected-node-indices-folds-segment-endpoints
+ (let [content (pth/selectable-path-content)]
+ ;; segment index 1 connects nodes 0 and 1
+ (t/is (= #{0 1}
+ (path.helpers/selected-node-indices content {:nodes #{} :segments #{1}})))
+ ;; explicit nodes and segment endpoints are unioned
+ (t/is (= #{0 1 2}
+ (path.helpers/selected-node-indices content {:nodes #{2} :segments #{1}})))))
+
+(t/deftest remap-selection-follows-content-structure
+ (let [content (pth/selectable-path-content)
+ ;; Same command layout: index 1 turned into a line-to
+ corner (path/content
+ (assoc (vec content) 1 {:command :line-to
+ :params {:x 10 :y 0}}))
+ ;; Different layout: the middle node was removed
+ shorter (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :line-to
+ :params {:x 20 :y 0}}])
+ selection {:nodes #{1 2}
+ :segments #{2}
+ :handlers #{[1 :c1] [2 :c2]}}]
+ (t/is (= {:nodes #{1 2}
+ :segments #{2}
+ :handlers #{[2 :c2]}}
+ (path.helpers/remap-selection selection content corner)))
+ (t/is (= {:nodes #{1}
+ :segments #{}
+ :handlers #{}}
+ (path.helpers/remap-selection selection content shorter)))))
+
+(t/deftest handlers-joined-detects-smooth-vs-corner-nodes
+ ;; node (10,0): incoming [1 :c2]=(8,0), outgoing [2 :c1]
+ (t/is (path.helpers/handlers-joined? (pth/selectable-path-content) 2 :c1))
+ (t/is (not (path.helpers/handlers-joined? (pth/corner-path-content) 2 :c1))))
+
diff --git a/frontend/test/frontend_tests/logic/path_lifecycle_test.cljs b/frontend/test/frontend_tests/logic/path_lifecycle_test.cljs
new file mode 100644
index 0000000000..66b20090c8
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_lifecycle_test.cljs
@@ -0,0 +1,542 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+
+(ns frontend-tests.logic.path-lifecycle-test
+ (:require
+ [app.common.data.undo-stack :as u]
+ [app.common.geom.point :as gpt]
+ [app.common.test-helpers.files :as cthf]
+ [app.common.test-helpers.shapes :as cths]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.drawing.common :as dwdc]
+ [app.main.data.workspace.edition :as dwe]
+ [app.main.data.workspace.path.changes :as path.changes]
+ [app.main.data.workspace.path.common :as path.common]
+ [app.main.data.workspace.path.drawing :as path.drawing]
+ [app.main.data.workspace.path.edition :as path.edition]
+ [app.main.data.workspace.path.helpers :as path.helpers]
+ [app.main.data.workspace.path.selection :as path.selection]
+ [app.main.data.workspace.path.shortcuts :as path.shortcuts]
+ [app.main.data.workspace.path.state :as path.state]
+ [app.main.data.workspace.path.streams :as path.streams]
+ [app.main.data.workspace.path.tools :as path.tools]
+ [app.main.data.workspace.path.undo :as path.undo]
+ [beicon.v2.core :as rx]
+ [cljs.test :as t :include-macros true]
+ [frontend-tests.helpers.state :as ths]
+ [frontend-tests.logic.path-test-helpers :as pth]
+ [potok.v2.core :as ptk]))
+
+(t/deftest path-lifecycle-selectors-use-the-active-path
+ (let [id (random-uuid)
+ edit-state {:edit-mode :draw}
+ edit-path {id edit-state}
+ state {:workspace-local {:edition id
+ :edit-path edit-path}
+ :workspace-drawing {:object {:id id :type :path}}}]
+ (t/is (= edit-state (path.state/current-edit-state state)))
+ (t/is (= edit-state (path.state/current-edit-state edit-path id)))
+ (t/is (path.state/editing? state))
+ (t/is (path.state/editing? edit-path id))
+ (t/is (path.state/drawing? edit-state id :path {:id id :type :path}))))
+
+(t/deftest path-drawing-selector-finds-new-paths
+ (let [id (random-uuid)
+ state {:workspace-local {:edition nil
+ :edit-path {id {}}}
+ :workspace-drawing {:tool :path
+ :object {:id id :type :path}}}]
+ (t/is (path.state/drawing? state))
+ (t/is (not (path.state/editing? state)))
+ (t/is (path.state/drawing? nil nil :path {:id id :type :path}))
+ (t/is (not (path.state/drawing? nil nil :curve {:id id :type :path})))))
+
+(t/deftest clear-edition-mode-finishes-path-streams
+ (t/is (path.streams/finish-edition? (dwe/clear-edition-mode)))
+ (t/is (not (path.streams/finish-edition? :interrupt))))
+
+(t/deftest clear-edition-mode-finishes-active-path-before-finalizing
+ (let [id (random-uuid)
+ event (dwe/clear-edition-mode)
+ state {:workspace-local {:edition id
+ :edit-path {id {:edit-mode :move}}}
+ :workspace-drawing {:object {:id id}}}
+ state' (ptk/update event state)
+ emissions (atom [])]
+ (->> (ptk/watch event state' nil)
+ (rx/subs! #(swap! emissions conj %)))
+ (t/is (nil? (get-in state' [:workspace-local :edition])))
+ (t/is (some? (get-in state' [:workspace-local :edit-path id])))
+ (t/is (= [::path.common/finish-path]
+ (mapv ptk/type @emissions)))))
+
+(t/deftest clear-non-path-edition-does-not-emit-finish-path
+ (let [id (random-uuid)
+ event (dwe/clear-edition-mode)
+ state {:workspace-local {:edition id}}
+ state' (ptk/update event state)
+ emissions (atom [])]
+ (->> (ptk/watch event state' nil)
+ (rx/subs! #(swap! emissions conj %)))
+ (t/is (nil? (get-in state' [:workspace-local :edition])))
+ (t/is (empty? @emissions))))
+
+(t/deftest restarting-draw-mode-finishes-pending-subpath
+ (let [file (pth/setup-rect-file)
+ shape (-> (cths/get-shape file :rect1)
+ (path/convert-to-path))
+ id (:id shape)
+ last-point (last (path/get-points (:content shape)))
+ state {:workspace-local
+ {:edition id
+ :edit-path
+ {id {:edit-mode :draw
+ :last-point last-point
+ :preview {:command :line-to
+ :params {:x 150 :y 150}}
+ :old-content (:content shape)}}}
+ :workspace-drawing {:object shape}}
+ stream (rx/subject)
+ emissions (atom [])]
+ (->> (ptk/watch (path.drawing/start-draw-mode*) state stream)
+ (rx/take 4)
+ (rx/subs! #(swap! emissions conj %)))
+ (rx/push! stream (ptk/data-event ::path.drawing/end-edition
+ {:restart? true}))
+ (t/is (= [::path.drawing/start-edition
+ ::path.common/finish-path
+ ::path.drawing/check-changed-content
+ ::path.drawing/start-draw-mode*]
+ (mapv ptk/type @emissions)))
+ (let [state' (ptk/update (second @emissions) state)
+ state'' (ptk/update (path.drawing/preview-next-point
+ {:x 200 :y 200})
+ state')]
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :last-point])))
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :preview])))
+ (t/is (= :move-to
+ (get-in state'' [:workspace-local :edit-path id :preview :command]))))))
+
+(t/deftest escape-does-not-restart-edited-path-draw-loop
+ (let [id (random-uuid)
+ state {:workspace-local
+ {:edition id
+ :edit-path {id {:edit-mode :draw}}}}
+ stream (rx/subject)
+ emissions (atom [])]
+ (t/is (path.drawing/restart-draw-loop? (path.common/finish-path)))
+ (->> (ptk/watch (path.drawing/start-draw-mode*) state stream)
+ (rx/subs! #(swap! emissions conj %)))
+ (rx/push! stream (ptk/data-event ::path.drawing/end-edition
+ {:restart? false}))
+ (t/is (= [::path.drawing/start-edition]
+ (mapv ptk/type @emissions)))))
+
+(defn- run-handle-drawing-end
+ "Runs the draw-ending flow and passes its events to `callback`."
+ [restart? callback]
+ (let [state (pth/drawing-path-state)
+ stream (rx/subject)
+ emissions (atom [])]
+ (->> (ptk/watch (path.drawing/handle-drawing) state stream)
+ (rx/subs! #(swap! emissions conj %)))
+ (rx/push! stream (ptk/data-event ::path.drawing/end-edition
+ {:restart? restart?}))
+ ;; Wait for the asynchronous drawing-end event.
+ (js/setTimeout
+ (fn []
+ (let [end-event (last @emissions)
+ end-emissions (atom [])]
+ (->> (ptk/watch end-event state stream)
+ (rx/subs! #(swap! end-emissions conj %)))
+ (callback @end-emissions))))))
+
+(t/deftest escape-ending-new-path-draw-does-not-reenter-edition
+ (t/async
+ done
+ (run-handle-drawing-end
+ false
+ (fn [emissions]
+ (t/is (= [::path.drawing/close-drawn-loops
+ ::path.drawing/setup-frame
+ ::dwdc/handle-finish-drawing
+ ::dwe/clear-edition-mode]
+ (mapv ptk/type emissions)))
+ (done)))))
+
+(t/deftest finishing-new-path-draw-reenters-edition
+ (t/async
+ done
+ (run-handle-drawing-end
+ true
+ (fn [emissions]
+ (t/is (= [::path.common/finish-path
+ ::path.drawing/close-drawn-loops
+ ::path.drawing/setup-frame
+ ::dwdc/handle-finish-drawing
+ ::path.drawing/start-created-path-edition]
+ (mapv ptk/type emissions)))
+ (done)))))
+
+(t/deftest escape-with-pending-segment-cancels-it-and-keeps-drawing
+ (let [id (random-uuid)
+ state {:workspace-local
+ {:edition id
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 10 10)
+ :preview {:command :line-to
+ :params {:x 20 :y 20}}}}}}
+ emissions (atom [])]
+ (->> (ptk/watch (path.shortcuts/esc-pressed) state nil)
+ (rx/subs! #(swap! emissions conj %)))
+ (t/is (= [::path.common/cancel-pending-segment]
+ (mapv ptk/type @emissions)))
+ (let [state' (ptk/update (first @emissions) state)]
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :last-point])))
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :preview])))
+ (t/is (= :draw (get-in state' [:workspace-local :edit-path id :edit-mode]))))))
+
+(t/deftest escape-while-creating-path-finishes-it-into-edition
+ (let [id (random-uuid)
+ state {:workspace-local
+ {:edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 10 10)}}}
+ :workspace-drawing {:object {:id id :type :path}}}
+ emissions (atom [])]
+ (->> (ptk/watch (path.shortcuts/esc-pressed) state nil)
+ (rx/subs! #(swap! emissions conj %)))
+ ;; Finishing creates the shape and clears its pending segment.
+ (t/is (= [::path.common/finish-path]
+ (mapv ptk/type @emissions)))))
+
+(t/deftest escape-without-pending-segment-interrupts-edition
+ (let [id (random-uuid)
+ state {:workspace-local
+ {:edition id
+ :edit-path {id {:edit-mode :draw}}}}
+ emissions (atom [])]
+ (->> (ptk/watch (path.shortcuts/esc-pressed) state nil)
+ (rx/subs! #(swap! emissions conj %)))
+ (t/is (= [:interrupt] @emissions))))
+
+(t/deftest editing-path-only-updates-drawing-copy
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ original-rect (cths/get-shape file :rect1)
+ id (:id original-rect)
+ delta (gpt/point 10 5)
+ store (ths/setup-store file)
+ events (conj (pth/start-path-edition-events id)
+ (pth/move-drawing-content delta))]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [file' (ths/get-file-from-state new-state)
+ stored-shape (cths/get-shape file' :rect1)
+ drawing-copy (get-in new-state [:workspace-drawing :object])]
+ (t/is (= original-rect stored-shape))
+ (t/is (= :path (:type drawing-copy)))
+ (t/is (= (path/move-content
+ (:content (path/convert-to-path original-rect))
+ delta)
+ (:content drawing-copy)))))))))
+
+(t/deftest unchanged-path-edition-preserves-simple-shape
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ original-rect (cths/get-shape file :rect1)
+ id (:id original-rect)
+ store (ths/setup-store file)
+ events (conj (pth/start-path-edition-events id) :interrupt)]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [file' (ths/get-file-from-state new-state)
+ stored-shape (cths/get-shape file' :rect1)]
+ (t/is (= original-rect stored-shape))
+ (t/is (= :rect (:type stored-shape)))
+ (t/is (nil? (get-in new-state [:workspace-drawing :object])))))))))
+
+(t/deftest changed-path-edition-is-persisted-when-finalized
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ original-rect (cths/get-shape file :rect1)
+ id (:id original-rect)
+ delta (gpt/point 10 5)
+ original-path (path/convert-to-path original-rect)
+ ;; Persist the rectangle with an explicit close command.
+ changed-content (-> (:content original-path)
+ (path/move-content delta)
+ (path/close-loops))
+ expected-shape (-> original-path
+ (assoc :content changed-content)
+ (path/update-geometry))
+ store (ths/setup-store file)
+ events (into (pth/start-path-edition-events id)
+ [(pth/move-drawing-content delta)
+ :interrupt])]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [file' (ths/get-file-from-state new-state)
+ stored-shape (cths/get-shape file' :rect1)]
+ (t/is (= expected-shape stored-shape))
+ (t/is (= :path (:type stored-shape)))
+ (t/is (nil? (get-in new-state [:workspace-drawing :object])))))))))
+
+(t/deftest created-path-edition-cleans-drawing-state-on-exit
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ original-rect (cths/get-shape file :rect1)
+ id (:id original-rect)
+ store (ths/setup-store file)
+ events [(path.drawing/start-created-path-edition id)
+ :interrupt]]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [file' (ths/get-file-from-state new-state)
+ stored-shape (cths/get-shape file' :rect1)]
+ (t/is (= original-rect stored-shape))
+ (t/is (nil? (get-in new-state [:workspace-local :edition])))
+ (t/is (nil? (get-in new-state [:workspace-local :edit-path id])))
+ (t/is (nil? (get-in new-state [:workspace-drawing :object])))))))))
+
+(defn- with-dangling-subpath-start
+ [content]
+ (path/content (conj (vec content)
+ {:command :move-to
+ :params {:x 30 :y 40}})))
+
+(t/deftest cancel-pending-segment-drops-dangling-subpath-start
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state {:workspace-local
+ {:edition id
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 30 40)
+ :preview {:command :line-to
+ :params {:x 50 :y 50}}}}}
+ :workspace-drawing
+ {:object {:id id
+ :type :path
+ :content (with-dangling-subpath-start content)}}}
+ state' (ptk/update (path.common/cancel-pending-segment) state)]
+ (t/is (= (vec content)
+ (vec (get-in state' [:workspace-drawing :object :content]))))
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :last-point])))
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :preview])))))
+
+(t/deftest finish-path-drops-dangling-subpath-start
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state {:workspace-local
+ {:edition id
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 30 40)}}}
+ :workspace-drawing
+ {:object {:id id
+ :type :path
+ :content (with-dangling-subpath-start content)}}}
+ state' (ptk/update (path.common/finish-path) state)]
+ (t/is (= (vec (path/close-subpaths content))
+ (vec (get-in state' [:workspace-drawing :object :content]))))
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :last-point])))))
+
+(t/deftest finalize-ignores-dangling-subpath-start
+ (let [file (pth/setup-rect-file)
+ rect (cths/get-shape file :rect1)
+ id (:id rect)
+ path-shape (path/convert-to-path rect)
+ old-content (:content path-shape)
+ state {:current-file-id (:id file)
+ :current-page-id (cthf/current-page-id file)
+ :files {(:id file) file}
+ :workspace-local
+ {:edition id
+ :edit-path {id {:old-content old-content}}}
+ :workspace-drawing
+ {:object (assoc path-shape
+ :content
+ (with-dangling-subpath-start old-content))}}
+ emissions (atom [])]
+ (->> (ptk/watch (path.changes/finalize-path-content id) state nil)
+ (rx/subs! #(swap! emissions conj %)))
+ (t/is (empty? @emissions))))
+
+(t/deftest next-point-preview-is-suppressed-during-a-modifier-drag
+ (let [id (random-uuid)
+ content (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 100 :y 0}}])
+ mk (fn [modifiers]
+ ;; Draw mode keeps the path in the drawing object.
+ {:workspace-drawing {:object {:id id :type :path :content content}}
+ :workspace-local {:edition nil
+ :zoom 1
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 100 0)
+ :content-modifiers modifiers}}}})
+ event (path.drawing/preview-next-point {:x 150 :y 40 :shift? false})
+ idle (ptk/update event (mk {}))
+ during (ptk/update event (mk {1 {:c1x 5 :c1y 5}}))]
+ ;; no active drag: the next-point preview updates as usual
+ (t/is (some? (get-in idle [:workspace-local :edit-path id :preview])))
+ ;; a placed handler is being dragged mid-draw: the preview must not move
+ (t/is (nil? (get-in during [:workspace-local :edit-path id :preview])))))
+
+(t/deftest dragging-the-current-curve-forward-handle-while-drawing
+ (let [id (random-uuid)
+ content (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:x 100 :y 0 :c1x 30 :c1y 0 :c2x 70 :c2y 0}}])
+ mk (fn []
+ ;; Store the backward handle and transient forward handle.
+ {:workspace-drawing {:object {:id id :type :path :content content}}
+ :workspace-local {:edition nil
+ :zoom 1
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 100 0)
+ :prev-handler (gpt/point 130 0)}}}})
+ drag (fn [alt?]
+ (ptk/update (path.drawing/drag-prev-handler
+ {:x 100 :y 50 :alt? alt? :shift? false})
+ (mk)))
+ finish (fn [state] (ptk/update (path.drawing/finish-drag) state))
+ c2-of (fn [state]
+ (-> (get-in state [:workspace-drawing :object :content])
+ (vec) (nth 1) :params (select-keys [:c2x :c2y])))]
+
+ (t/testing "no alt: the forward handle follows the pointer and the committed backward handle mirrors it"
+ (let [dragged (drag false)]
+ ;; the forward handle tracks the pointer
+ (t/is (= (gpt/point 100 50)
+ (get-in dragged [:workspace-local :edit-path id :drag-handler])))
+ ;; the stale transient forward handle is cleared so it is not double-rendered
+ (t/is (nil? (get-in dragged [:workspace-local :edit-path id :prev-handler])))
+ (let [committed (finish dragged)]
+ ;; c2 = 2*node - forward = (100,-50)
+ (t/is (= {:c2x 100 :c2y -50} (c2-of committed)))
+ ;; the new forward handle becomes the prev-handler
+ (t/is (= (gpt/point 100 50)
+ (get-in committed [:workspace-local :edit-path id :prev-handler]))))))
+
+ (t/testing "alt: the forward handle moves on its own, the backward handle stays put"
+ (let [committed (finish (drag true))]
+ (t/is (= {:c2x 70 :c2y 0} (c2-of committed)))))))
+
+(t/deftest dragging-the-current-curve-backward-handle-while-drawing
+ ;; Dragging the backward handle mirrors the transient forward handle.
+ (let [id (random-uuid)
+ content (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:x 100 :y 0 :c1x 30 :c1y 0 :c2x 70 :c2y 0}}])
+ mk (fn []
+ {:workspace-drawing {:object {:id id :type :path :content content}}
+ :workspace-local {:edition nil
+ :zoom 1
+ :edit-path {id {:edit-mode :draw
+ :last-point (gpt/point 100 0)
+ :prev-handler (gpt/point 130 0)}}}})
+ ;; Drag the backward handle to `(70, -40)`.
+ drag (fn [mode]
+ (ptk/update (path.edition/modify-selected-handlers
+ id [1 :c2] {} 0 -40 mode (= mode :smart))
+ (mk)))
+ prev-of (fn [state] (get-in state [:workspace-local :edit-path id :prev-handler]))]
+
+ (t/testing "smart (no modifier): the forward handle mirrors the angle, keeping its own length"
+ ;; Keep the forward handle's length while mirroring its angle.
+ (t/is (= (gpt/point 118 24) (prev-of (drag :smart)))))
+
+ (t/testing "mirror (mod): the forward handle full-mirrors to equal length"
+ ;; Mirror the forward handle around the node.
+ (t/is (= (gpt/point 130 40) (prev-of (drag :mirror)))))
+
+ (t/testing "independent (alt): the forward handle is left untouched"
+ (t/is (= (gpt/point 130 0) (prev-of (drag :independent)))))))
+
+(t/deftest path-local-undo-redo-restores-content-and-clears-preview
+ (let [id (random-uuid)
+ content-a (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}])
+ content-b (path/content [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 5}}])
+ base (-> (pth/selectable-path-state id content-a path.helpers/empty-selection)
+ (assoc-in [:workspace-local :edit-path id :undo-stack] (u/make-stack)))
+ ;; Capture both content states around a stale preview.
+ s1 (ptk/update (path.undo/add-undo-entry) base)
+ s2 (-> (path.state/set-content s1 content-b)
+ (assoc-in [:workspace-local :edit-path id :preview]
+ {:command :line-to :params {:x 99 :y 99}}))
+ s3 (ptk/update (path.undo/add-undo-entry) s2)
+ s4 (ptk/update (path.undo/undo-path) s3)
+ s5 (ptk/update (path.undo/redo-path) s4)]
+ (t/is (= content-b (path.state/get-path s3 :content)))
+ (t/is (= content-a (path.state/get-path s4 :content)))
+ ;; Restoring an entry drops its render-only preview.
+ (t/is (nil? (get-in s4 [:workspace-local :edit-path id :preview])))
+ (t/is (= content-b (path.state/get-path s5 :content)))))
+
+(t/deftest path-undo-entry-never-captures-the-transient-preview
+ (let [id (random-uuid)
+ state (-> (pth/selectable-path-state id (pth/selectable-path-content)
+ path.helpers/empty-selection)
+ (assoc-in [:workspace-local :edit-path id :undo-stack] (u/make-stack))
+ (assoc-in [:workspace-local :edit-path id :preview]
+ {:command :line-to :params {:x 99 :y 99}}))
+ state' (ptk/update (path.undo/add-undo-entry) state)
+ entry (u/peek (get-in state' [:workspace-local :edit-path id :undo-stack]))]
+ (t/is (some? entry))
+ (t/is (not (contains? entry :preview)))))
+
+;; Tool operations through the full edition lifecycle.
+
+(t/deftest tool-make-curve-persists-through-edition-lifecycle
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ rect (cths/get-shape file :rect1)
+ id (:id rect)
+ store (ths/setup-store file)
+ events (into (pth/start-path-edition-events id)
+ [(path.selection/select-node 1 false)
+ (path.tools/make-curve)
+ :interrupt])]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [stored (cths/get-shape (ths/get-file-from-state new-state) :rect1)]
+ (t/is (= :path (:type stored)))
+ ;; make-curve on a corner introduces at least one curve segment
+ (t/is (some #(= :curve-to (:command %)) (seq (:content stored))))
+ (t/is (nil? (get-in new-state [:workspace-drawing :object])))))))))
+
+(t/deftest tool-remove-node-persists-through-edition-lifecycle
+ (t/async
+ done
+ (let [file (pth/setup-rect-file)
+ rect (cths/get-shape file :rect1)
+ id (:id rect)
+ orig-nodes (count (path/get-points (:content (path/convert-to-path rect))))
+ store (ths/setup-store file)
+ events (into (pth/start-path-edition-events id)
+ [(path.selection/select-node 1 false)
+ (path.tools/remove-node)
+ :interrupt])]
+ (ths/run-store
+ store done events
+ (fn [new-state]
+ (let [stored (cths/get-shape (ths/get-file-from-state new-state) :rect1)]
+ (t/is (= :path (:type stored)))
+ ;; removing a node leaves fewer nodes than the converted rect had
+ (t/is (< (count (path/get-points (:content stored))) orig-nodes))
+ (t/is (nil? (get-in new-state [:workspace-drawing :object])))))))))
+
diff --git a/frontend/test/frontend_tests/logic/path_test_helpers.cljs b/frontend/test/frontend_tests/logic/path_test_helpers.cljs
new file mode 100644
index 0000000000..d55fcd17a4
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_test_helpers.cljs
@@ -0,0 +1,94 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+
+(ns frontend-tests.logic.path-test-helpers
+ (:require
+ [app.common.test-helpers.compositions :as ctho]
+ [app.common.test-helpers.files :as cthf]
+ [app.common.test-helpers.shapes :as cths]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.edition :as dwe]
+ [app.main.data.workspace.path.edition :as path.edition]
+ [app.main.data.workspace.path.state :as path.state]))
+
+(defn setup-rect-file
+ []
+ (ctho/add-rect (cthf/sample-file :file1)
+ :rect1
+ :x 10
+ :y 20
+ :width 100
+ :height 80))
+
+(defn start-path-edition-events
+ [id]
+ [(dwe/start-edition-mode id)
+ (path.edition/start-path-edit id)])
+
+(defn move-drawing-content
+ [delta]
+ (fn [state]
+ (path.state/set-content
+ state
+ (path/move-content (path.state/get-path state :content) delta))))
+
+(defn drawing-path-state
+ []
+ (let [file (setup-rect-file)
+ shape (-> (cths/get-shape file :rect1)
+ (path/convert-to-path))]
+ {:workspace-drawing {:object shape}}))
+
+(defn selectable-path-content
+ []
+ (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 0
+ :c2x 8 :c2y 0
+ :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 0
+ :c2x 18 :c2y 0
+ :x 20 :y 0}}]))
+
+(defn selectable-path-state
+ [id content selection]
+ {:workspace-local {:edition id
+ :edit-path {id {:selection selection}}}
+ :workspace-drawing {:object {:id id
+ :type :path
+ :content content}}})
+
+(defn mixed-corner-curve-content
+ []
+ (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :line-to
+ :params {:x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 4
+ :c2x 18 :c2y 4
+ :x 20 :y 0}}]))
+
+(defn corner-path-content
+ "Returns selectable content with a corner at `(10, 0)`."
+ []
+ (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 0
+ :c2x 8 :c2y 0
+ :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 6
+ :c2x 18 :c2y 0
+ :x 20 :y 0}}]))
+
diff --git a/frontend/test/frontend_tests/logic/path_tools_test.cljs b/frontend/test/frontend_tests/logic/path_tools_test.cljs
new file mode 100644
index 0000000000..fd286ff728
--- /dev/null
+++ b/frontend/test/frontend_tests/logic/path_tools_test.cljs
@@ -0,0 +1,804 @@
+;; 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/.
+;;
+;; Copyright (c) KALEIDOS INC Sucursal en España SL
+
+
+(ns frontend-tests.logic.path-tools-test
+ (:require
+ [app.common.geom.point :as gpt]
+ [app.common.geom.rect :as grc]
+ [app.common.types.path :as path]
+ [app.main.data.workspace.path.drawing :as path.drawing]
+ [app.main.data.workspace.path.edition :as path.edition]
+ [app.main.data.workspace.path.helpers :as path.helpers]
+ [app.main.data.workspace.path.selection :as path.selection]
+ [app.main.data.workspace.path.state :as path.state]
+ [app.main.data.workspace.path.tools :as path.tools]
+ [beicon.v2.core :as rx]
+ [cljs.test :as t :include-macros true]
+ [frontend-tests.logic.path-test-helpers :as pth]
+ [potok.v2.core :as ptk]))
+
+(t/deftest mixed-node-conversions-only-change-opposite-node-type
+ (let [id (random-uuid)
+ content (pth/mixed-corner-curve-content)
+ points (path/get-points content)
+ corner-point (first points)
+ curve-point (second points)
+ state (pth/selectable-path-state
+ id content
+ {:nodes #{0 1} :segments #{} :handlers #{}})
+ curved-state (ptk/update (path.tools/make-curve) state)
+ cornered-state (ptk/update (path.tools/make-corner) state)
+ curved-content (path.state/get-path curved-state :content)
+ corner-content (path.state/get-path cornered-state :content)]
+ (t/is (path/is-curve-point? curved-content corner-point))
+ (t/is (= (nth content 2) (nth curved-content 2)))
+ (t/is (not (path/is-curve-point? corner-content corner-point)))
+ (t/is (not (path/is-curve-point? corner-content curve-point)))))
+
+(t/deftest plain-and-shift-selection-work-across-path-element-types
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state
+ id content
+ {:nodes #{0}
+ :segments #{1}
+ :handlers #{[1 :c1]}})
+ state' (ptk/update (path.selection/select-handler 1 :c2 false) state)
+ state'' (ptk/update (path.selection/select-segment 2 true) state')
+ state''' (ptk/update (path.selection/select-handler 1 :c2 true) state'')
+ state'''' (ptk/update (path.selection/select-handler 2 :c1 true) state''')]
+ (t/is (= {:nodes #{}
+ :segments #{}
+ :handlers #{[1 :c2]}}
+ (get-in state' [:workspace-local :edit-path id :selection])))
+ (t/is (= {:nodes #{}
+ :segments #{2}
+ :handlers #{[1 :c2]}}
+ (get-in state'' [:workspace-local :edit-path id :selection])))
+ (t/is (= {:nodes #{}
+ :segments #{2}
+ :handlers #{[2 :c1]}}
+ (get-in state'''' [:workspace-local :edit-path id :selection])))))
+
+(t/deftest path-area-selection-prioritizes-nodes-over-segments-over-handlers
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ selection path.helpers/empty-selection
+ state (pth/selectable-path-state id content selection)
+ ;; Contains segment 1 and handler [1 :c1] but no node
+ rect (grc/make-rect 1 -2 3 4)
+ state' (ptk/update (path.selection/select-path-area
+ rect selection false)
+ state)
+ ;; Contains node 0, segment 1 and handler [1 :c1]
+ node-rect (grc/make-rect -1 -1 4 2)
+ state'' (ptk/update (path.selection/select-path-area
+ node-rect selection false)
+ state)]
+ (t/is (= {:nodes #{}
+ :segments #{1}
+ :handlers #{}}
+ (get-in state' [:workspace-local :edit-path id :selection])))
+ (t/is (= {:nodes #{0}
+ :segments #{}
+ :handlers #{}}
+ (get-in state'' [:workspace-local :edit-path id :selection])))))
+
+(t/deftest path-area-selection-picks-handlers-only-when-nothing-else-is-inside
+ (let [id (random-uuid)
+ ;; Curve bulging up to y 7.5 with both handlers on y 10, away
+ ;; from the curve itself
+ content (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 0 :c1y 10
+ :c2x 10 :c2y 10
+ :x 10 :y 0}}])
+ selection path.helpers/empty-selection
+ state (pth/selectable-path-state id content selection)
+ ;; Contains only the [1 :c1] handler control point
+ handler-rect (grc/make-rect -1 9 2 2)
+ state' (ptk/update (path.selection/select-path-area
+ handler-rect selection false)
+ state)
+ ;; Contains both handlers and the top of the curve
+ mixed-rect (grc/make-rect -1 5 12 7)
+ state'' (ptk/update (path.selection/select-path-area
+ mixed-rect selection false)
+ state)]
+ (t/is (= {:nodes #{}
+ :segments #{}
+ :handlers #{[1 :c1]}}
+ (get-in state' [:workspace-local :edit-path id :selection])))
+ (t/is (= {:nodes #{}
+ :segments #{1}
+ :handlers #{}}
+ (get-in state'' [:workspace-local :edit-path id :selection])))))
+
+(t/deftest path-area-selection-ignores-empty-buffer-emissions
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ selection path.helpers/empty-selection
+ state (pth/selectable-path-state id content selection)]
+ (t/is (= state
+ (ptk/update (path.selection/select-path-area
+ nil selection false)
+ state)))))
+
+(t/deftest selected-segments-resolve-to-unique-endpoint-nodes
+ (let [content (pth/selectable-path-content)]
+ (t/is (= #{0 1}
+ (path.helpers/segment-node-indices content #{1})))
+ (t/is (= #{0 1 2}
+ (path.helpers/segment-node-indices content #{1 2})))))
+
+(t/deftest moving-selected-segments-translates-endpoints-and-handlers
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ selection {:nodes #{}
+ :segments #{1}
+ :handlers #{}}
+ state (pth/selectable-path-state id content selection)
+ event (path.edition/move-selected-path-segment
+ (gpt/point 5 0)
+ (gpt/point 8 4))
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= (gpt/point 3 4) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 13 4) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 5 4) (path/get-handler-point content' 1 :c1)))
+ (t/is (= (gpt/point 11 4) (path/get-handler-point content' 1 :c2)))
+ (t/is (= (gpt/point 15 4) (path/get-handler-point content' 2 :c1)))))
+
+(t/deftest moving-a-segment-between-selected-nodes-moves-the-node-selection
+ ;; A segment between selected nodes moves with the node selection.
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ selection {:nodes #{0 1} :segments #{} :handlers #{}}
+ state (pth/selectable-path-state id content selection)
+ event (path.edition/move-selected-path-segment
+ (gpt/point 5 0)
+ (gpt/point 8 4))
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ ;; both selected nodes translate by (+3,+4); the unselected node stays put
+ (t/is (= (gpt/point 3 4) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 13 4) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 20 0) (path.helpers/node-position content' 2)))))
+
+(t/deftest moving-selected-opposite-handlers-translates-both
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ selection {:nodes #{}
+ :segments #{}
+ :handlers #{[1 :c2] [2 :c1]}}
+ state (pth/selectable-path-state id content selection)
+ event (path.edition/modify-selected-handlers
+ id [1 :c2] {} 3 4 :smart true)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= {:c2x 3 :c2y 4} (get modifiers 1)))
+ (t/is (= {:c1x 3 :c1y 4} (get modifiers 2)))
+ (t/is (= (gpt/point 11 4) (path/get-handler-point content' 1 :c2)))
+ (t/is (= (gpt/point 15 4) (path/get-handler-point content' 2 :c1)))))
+
+(t/deftest moving-selected-handlers-honours-each-explicit-node-mode
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 0 :c2x 8 :c2y 0 :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 0 :c2x 18 :c2y 0 :x 20 :y 0}}
+ {:command :curve-to
+ :params {:c1x 22 :c1y 0 :c2x 28 :c2y 0 :x 30 :y 0}}])
+ selection {:nodes #{}
+ :segments #{}
+ :handlers #{[2 :c1] [3 :c1]}}
+ state (-> (pth/selectable-path-state id content selection)
+ (assoc-in [:workspace-local :edit-path id :handler-types]
+ {1 :independent 2 :mirror}))
+ event (path.edition/modify-selected-handlers
+ id [2 :c1] {} 3 4 :independent true)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ ;; Selected handlers receive the same drag delta.
+ (t/is (= (gpt/point 15 4) (path/get-handler-point content' 2 :c1)))
+ (t/is (= (gpt/point 25 4) (path/get-handler-point content' 3 :c1)))
+ ;; Each node applies its own mode to the opposite handle.
+ (t/is (= (gpt/point 8 0) (path/get-handler-point content' 1 :c2)))
+ (t/is (= (gpt/point 15 -4) (path/get-handler-point content' 2 :c2)))))
+
+(t/deftest arrow-move-nudges-selected-handlers
+ ;; Arrow keys nudge selected handlers.
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{} :handlers #{[2 :c1]}})
+ state' (ptk/update (path.edition/set-move-modifier [] #{[2 :c1]} (gpt/point 0 5))
+ state)
+ mods (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content mods)]
+ (t/is (= {:c1x 0 :c1y 5} (get mods 2)))
+ ;; [2 :c1] base (12,0) -> (12,5); node 1 and its opposite handle stay put
+ (t/is (= (gpt/point 12 5) (path/get-handler-point content' 2 :c1)))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 8 0) (path/get-handler-point content' 1 :c2)))))
+
+(t/deftest arrow-move-nudges-selected-segment-endpoints
+ ;; Arrow keys nudge segment endpoints and their handles.
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{1} :handlers #{}})
+ node-idx (path.helpers/segment-node-indices content #{1})
+ points (path.helpers/node-positions content node-idx)
+ state' (ptk/update (path.edition/set-move-modifier points #{} (gpt/point 0 5))
+ state)
+ mods (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content mods)]
+ ;; segment 1 connects node 0 (0,0) and node 1 (10,0); both move by (0,5)
+ (t/is (= (gpt/point 0 5) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 10 5) (path.helpers/node-position content' 1)))
+ ;; the endpoint nodes' handles move rigidly with them
+ (t/is (= (gpt/point 2 5) (path/get-handler-point content' 1 :c1)))
+ (t/is (= (gpt/point 12 5) (path/get-handler-point content' 2 :c1)))))
+
+(t/deftest align-nodes-aligns-selected-nodes-to-an-edge
+ ;; Aligning nodes updates the drawing content.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 4}}
+ {:command :line-to :params {:x 4 :y 20}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{0 1 2} :segments #{} :handlers #{}})
+ state' (ptk/update (path.tools/align-nodes :hleft) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; every selected node's x becomes the min x (0), y is untouched
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 0 4) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 0 20) (path.helpers/node-position content' 2)))))
+
+(t/deftest distribute-nodes-spaces-selected-nodes-evenly
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 3 :y 5}}
+ {:command :line-to :params {:x 10 :y 9}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{0 1 2} :segments #{} :handlers #{}})
+ state' (ptk/update (path.tools/distribute-nodes :horizontal) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; the middle node is centered on x between the two extremes (0 and 10)
+ (t/is (= (gpt/point 5 5) (path.helpers/node-position content' 1)))
+ ;; the extreme nodes stay put
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 10 9) (path.helpers/node-position content' 2)))))
+
+(t/deftest set-selection-coordinate-moves-selected-points
+ ;; Coordinate edits move selected nodes and handlers.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}])]
+ ;; single node: only that node moves
+ (let [state (pth/selectable-path-state id content
+ {:nodes #{1} :segments #{} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :y 7) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 10 7) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 20 0) (path.helpers/node-position content' 2))))
+ ;; multi node: every selected node's coordinate is set to the value
+ (let [state (pth/selectable-path-state id content
+ {:nodes #{0 2} :segments #{} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 5) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 5 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 5 0) (path.helpers/node-position content' 2)))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 1)))))
+ ;; a coincident closed-seam node moves as one logical node
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 0 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{0} :segments #{} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :y 7) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 0 7) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 0 7) (path.helpers/node-position content' 2))))
+ ;; a selected handler on an independent node moves only its own control point
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to :params {:c1x 2 :c1y 2 :c2x 8 :c2y 2 :x 10 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{} :handlers #{[1 :c1]}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 4) state)
+ curve (nth (get-in state' [:workspace-drawing :object :content]) 1)]
+ ;; c1 x set to 4; c1y, c2 and the anchor untouched
+ (t/is (= 4 (get-in curve [:params :c1x])))
+ (t/is (= 2 (get-in curve [:params :c1y])))
+ (t/is (= 8 (get-in curve [:params :c2x])))
+ (t/is (= 10 (get-in curve [:params :x])))))
+
+(t/deftest set-selection-coordinate-mirrors-opposite-handler
+ ;; Moving a mirrored handler updates its opposite.
+ (let [id (random-uuid)
+ ;; node 1 (10,0) has collinear equal handles: c2 of cmd1 at (8,-2) and
+ ;; c1 of cmd2 at (12,2) — a mirror node by geometry
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to :params {:c1x 2 :c1y 0 :c2x 8 :c2y -2 :x 10 :y 0}}
+ {:command :curve-to :params {:c1x 12 :c1y 2 :c2x 18 :c2y 0 :x 20 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{} :handlers #{[1 :c2]}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 6) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; dragged handle c2 of cmd1 -> x=6 (keeps y=-2)
+ (t/is (= (gpt/point 6 -2) (path/get-handler-point content' 1 :c2)))
+ ;; opposite (c1 of cmd2) mirrors it about the node (10,0): 2*10-6=14, 2*0-(-2)=2
+ (t/is (= (gpt/point 14 2) (path/get-handler-point content' 2 :c1)))))
+
+(t/deftest change-to-draw-mode-starts-a-line-from-the-selected-node
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}])]
+ ;; a middle node: opens a new subpath (move-to) at the node and makes it the
+ ;; pending origin, so the next click draws a line from it
+ (let [state (pth/selectable-path-state id content
+ {:nodes #{1} :segments #{} :handlers #{}})
+ state' (ptk/update (path.drawing/change-edit-mode :draw) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 10 0)
+ (get-in state' [:workspace-local :edit-path id :last-point])))
+ (t/is (= 4 (count content')))
+ (t/is (= :move-to (:command (nth content' 3))))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 3))))
+ ;; the drawing tip: just becomes the pending origin (extends), no new subpath
+ (let [state (pth/selectable-path-state id content
+ {:nodes #{2} :segments #{} :handlers #{}})
+ state' (ptk/update (path.drawing/change-edit-mode :draw) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 20 0)
+ (get-in state' [:workspace-local :edit-path id :last-point])))
+ (t/is (= 3 (count content'))))
+ ;; nothing selected: no pending line
+ (let [state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{} :handlers #{}})
+ state' (ptk/update (path.drawing/change-edit-mode :draw) state)]
+ (t/is (nil? (get-in state' [:workspace-local :edit-path id :last-point]))))))
+
+(t/deftest set-selection-coordinate-translates-segments
+ ;; Coordinate edits translate selected segments by their bounds.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 10 :y 10}}])
+ ;; select segment index 2 (the vertical line from (10,0) to (10,10));
+ ;; its surrounding rect top-left x is 10
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{2} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 30) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; the segment's endpoint nodes (1 and 2) move +20 in x; node 0 stays
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 30 0) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 30 10) (path.helpers/node-position content' 2))))
+ ;; Moving a segment attached to a closed seam keeps both seam commands together.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 10 :y 10}}
+ {:command :line-to :params {:x 0 :y 10}}
+ {:command :line-to :params {:x 0 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{4} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 20) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 20 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 20 10) (path.helpers/node-position content' 3)))
+ (t/is (= (gpt/point 20 0) (path.helpers/node-position content' 4)))))
+
+(t/deftest set-selection-coordinate-translates-mixed-segment-and-node-selection
+ ;; Selected segments and nodes translate as one group.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ ;; The combined bounds start at x=0.
+ state (pth/selectable-path-state id content
+ {:nodes #{0} :segments #{3} :handlers #{}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 10) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 30 0) (path.helpers/node-position content' 2)))
+ (t/is (= (gpt/point 40 0) (path.helpers/node-position content' 3)))))
+
+(t/deftest set-selection-coordinate-translates-mixed-segment-and-handler-selection
+ ;; Standalone selected handlers translate with the group.
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 2 :c1y 2 :c2x 8 :c2y 2 :x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ ;; The standalone handler makes the bounds start at x=2.
+ state (pth/selectable-path-state id content
+ {:nodes #{}
+ :segments #{3}
+ :handlers #{[1 :c1]}})
+ state' (ptk/update (path.tools/set-selection-coordinate :x 12) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= (gpt/point 12 2) (path/get-handler-point content' 1 :c1)))
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 1)))
+ (t/is (= (gpt/point 30 0) (path.helpers/node-position content' 2)))
+ (t/is (= (gpt/point 40 0) (path.helpers/node-position content' 3)))))
+
+(t/deftest flip-nodes-includes-selected-segment-endpoints
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{1} :handlers #{}})
+ state' (ptk/update (path.tools/flip-nodes :horizontal) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; segment 1's endpoints (nodes 0 and 1) mirror across their bbox centre (x=5)
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 0 0) (path.helpers/node-position content' 1)))
+ ;; node 2 is not an endpoint of segment 1, so it stays put
+ (t/is (= (gpt/point 20 0) (path.helpers/node-position content' 2)))))
+
+(t/deftest merge-nodes-includes-selected-segment-endpoints
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{1} :handlers #{}})
+ state' (ptk/update (path.tools/merge-nodes) state)
+ content' (get-in state' [:workspace-drawing :object :content])
+ pts (path/get-points content')]
+ ;; segment 1's endpoints (0,0) and (10,0) merge to their midpoint (5,0)
+ (t/is (some #(= (gpt/point 5 0) %) pts))
+ (t/is (< (count pts) 3))))
+
+(t/deftest delete-selected-opens-segments-else-removes-nodes
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ run (fn [selection]
+ (let [state (pth/selectable-path-state id content selection)
+ events (atom [])]
+ (->> (ptk/watch (path.tools/delete-selected) state nil)
+ (rx/subs! #(swap! events conj %)))
+ ;; delete-selected emits a single node-tool event; apply it
+ (ptk/update (first @events) state)))
+ move-tos (fn [st] (->> (get-in st [:workspace-drawing :object :content])
+ vec
+ (filter #(= :move-to (:command %)))
+ count))
+ nodes (fn [st] (count (path/get-points
+ (get-in st [:workspace-drawing :object :content]))))]
+ ;; deleting the middle segment (index 2) opens the path into two subpaths
+ (t/is (> (move-tos (run {:nodes #{} :segments #{2} :handlers #{}})) 1))
+ ;; Deleting a node leaves fewer than four nodes.
+ (t/is (< (nodes (run {:nodes #{1} :segments #{} :handlers #{}})) 4))
+ ;; Mixed node and segment deletion heals the selected node.
+ (let [mixed (run {:nodes #{1} :segments #{2} :handlers #{}})]
+ (t/is (< (nodes mixed) 4))
+ (t/is (= 1 (move-tos mixed))))))
+
+(t/deftest deleting-a-closed-seam-node-heals-its-adjacent-segments
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 10 :y 10}}
+ {:command :line-to :params {:x 0 :y 10}}
+ {:command :line-to :params {:x 0 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{0} :segments #{} :handlers #{}})
+ events (atom [])
+ _ (->> (ptk/watch (path.tools/delete-selected) state nil)
+ (rx/subs! #(swap! events conj %)))
+ state' (ptk/update (first @events) state)
+ content' (vec (get-in state' [:workspace-drawing :object :content]))]
+ (t/is (= [:move-to :line-to :line-to :curve-to]
+ (mapv :command content')))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point 10 0) (path.helpers/node-position content' 3)))))
+
+(t/deftest deleting-a-touching-subpath-seam-heals-before-exiting-edition
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 10}}
+ {:command :line-to :params {:x -10 :y 7}}
+ {:command :line-to :params {:x -10 :y 3}}
+ {:command :line-to :params {:x 0 :y 0}}
+ {:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 3}}
+ {:command :line-to :params {:x 10 :y 7}}
+ {:command :line-to :params {:x 0 :y 10}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{0 7} :segments #{} :handlers #{}})
+ events (atom [])
+ _ (->> (ptk/watch (path.tools/delete-selected) state nil)
+ (rx/subs! #(swap! events conj %)))
+ state' (ptk/update (first @events) state)
+ content' (vec (get-in state' [:workspace-drawing :object :content]))]
+ (t/is (= [:move-to :line-to :line-to :line-to :line-to :curve-to]
+ (mapv :command content')))
+ (t/is (= (gpt/point -10 7) (path.helpers/node-position content' 0)))
+ (t/is (= (gpt/point -10 7) (path.helpers/node-position content' 5)))))
+
+(t/deftest delete-selected-with-segments-opens-a-gap-around-the-node
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}
+ {:command :line-to :params {:x 40 :y 0}}])
+ state (pth/selectable-path-state id content {:nodes #{2} :segments #{} :handlers #{}})
+ events (atom [])
+ _ (->> (ptk/watch (path.tools/delete-selected-with-segments) state nil)
+ (rx/subs! #(swap! events conj %)))
+ state' (ptk/update (first @events) state)
+ content' (get-in state' [:workspace-drawing :object :content])
+ move-tos (->> content' vec (filter #(= :move-to (:command %))) count)
+ nodes (count (path/get-points content'))]
+ ;; Removing incident segments opens a gap around the node.
+ (t/is (= 4 nodes))
+ (t/is (= 2 move-tos))))
+
+(t/deftest group-handler-drag-ignores-stale-handler-identities
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to
+ :params {:x 0 :y 0}}
+ {:command :line-to
+ :params {:x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 0
+ :c2x 18 :c2y 0
+ :x 20 :y 0}}])
+ selection {:nodes #{}
+ :segments #{}
+ ;; [1 :c1] points to a line-to and [9 :c2] is out of range
+ :handlers #{[1 :c1] [2 :c1] [9 :c2]}}
+ state (pth/selectable-path-state id content selection)
+ event (path.edition/modify-selected-handlers
+ id [2 :c1] {} 3 4 :smart true)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])]
+ (t/is (= {:c1x 3 :c1y 4} (get modifiers 2)))
+ (t/is (nil? (get modifiers 1)))
+ (t/is (nil? (get modifiers 9)))))
+
+(t/deftest handler-drag-smart-keeps-a-smooth-node-smooth
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content {:nodes #{} :segments #{}
+ :handlers #{[2 :c1]}})
+ ;; Smart mode keeps the handles aligned.
+ event (path.edition/modify-selected-handlers id [2 :c1] {} 0 4 :smart true)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= (gpt/point 12 4) (path/get-handler-point content' 2 :c1)))
+ ;; the opposite rotated to stay collinear -> still a smooth node
+ (t/is (not= (gpt/point 8 0) (path/get-handler-point content' 1 :c2)))
+ (t/is (path.helpers/handlers-joined? content' 2 :c1))))
+
+(t/deftest handler-drag-independent-breaks-a-smooth-node
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content {:nodes #{} :segments #{}
+ :handlers #{[2 :c1]}})
+ ;; Independent mode leaves the opposite handle in place.
+ event (path.edition/modify-selected-handlers id [2 :c1] {} 0 4 :independent false)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= (gpt/point 12 4) (path/get-handler-point content' 2 :c1)))
+ (t/is (= (gpt/point 8 0) (path/get-handler-point content' 1 :c2)))
+ (t/is (not (path.helpers/handlers-joined? content' 2 :c1)))))
+
+(t/deftest handler-drag-mirror-rejoins-a-corner-node
+ (let [id (random-uuid)
+ content (pth/corner-path-content)
+ state (pth/selectable-path-state id content {:nodes #{} :segments #{}
+ :handlers #{[2 :c1]}})
+ ;; Mirror mode matches the opposite handle's angle and length.
+ event (path.edition/modify-selected-handlers id [2 :c1] {} 2 -6 :mirror false)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= (gpt/point 14 0) (path/get-handler-point content' 2 :c1)))
+ (t/is (= (gpt/point 6 0) (path/get-handler-point content' 1 :c2)))
+ (t/is (path.helpers/handlers-joined? content' 2 :c1))))
+
+(t/deftest handler-drag-aligned-mirrors-angle-keeping-length
+ (let [id (random-uuid)
+ content (pth/corner-path-content)
+ state (pth/selectable-path-state id content {:nodes #{} :segments #{}
+ :handlers #{}})
+ ;; Aligned mode matches the angle and keeps the opposite length.
+ event (path.edition/modify-selected-handlers id [2 :c1] {} -2 -2 :aligned false)
+ state' (ptk/update event state)
+ modifiers (get-in state' [:workspace-local :edit-path id :content-modifiers])
+ content' (path/apply-content-modifiers content modifiers)]
+ (t/is (= (gpt/point 10 4) (path/get-handler-point content' 2 :c1)))
+ (t/is (= (gpt/point 10 -2) (path/get-handler-point content' 1 :c2)))
+ (t/is (path.helpers/handlers-joined? content' 2 :c1))))
+
+(t/deftest remove-handler-collapses-the-clicked-handler
+ (let [id (random-uuid)
+ content (pth/selectable-path-content)
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{}
+ :handlers #{[1 :c2]}})
+ state' (ptk/update (path.tools/remove-handler 1 :c2) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; the clicked handler rests on its node (10,0); the others are untouched
+ (t/is (= (gpt/point 10 0) (path/get-handler-point content' 1 :c2)))
+ (t/is (= (gpt/point 2 0) (path/get-handler-point content' 1 :c1)))
+ (t/is (= (gpt/point 12 0) (path/get-handler-point content' 2 :c1)))))
+
+(t/deftest toggle-segment-curve-switches-line-and-curve
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ state (pth/selectable-path-state id content path.helpers/empty-selection)
+ state' (ptk/update (path.tools/toggle-segment-curve 1) state)
+ content' (get-in state' [:workspace-drawing :object :content])
+ state'' (ptk/update (path.tools/toggle-segment-curve 1) state')
+ content'' (get-in state'' [:workspace-drawing :object :content])]
+ (t/is (= :curve-to (:command (nth content' 1))))
+ ;; handles a third along, offset perpendicular (0.25 * length) into a bow
+ (t/is (= (gpt/point 10 7.5) (path/get-handler-point content' 1 :c1)))
+ (t/is (= (gpt/point 20 7.5) (path/get-handler-point content' 1 :c2)))
+ (t/is (= :line-to (:command (nth content'' 1))))))
+
+(t/deftest remove-segment-opens-the-path-keeping-nodes
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ state (pth/selectable-path-state id content
+ {:nodes #{} :segments #{2} :handlers #{}})
+ state' (ptk/update (path.tools/remove-segment 2) state)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ (t/is (= [[:move-to {:x 0 :y 0}] [:line-to {:x 10 :y 0}]
+ [:move-to {:x 20 :y 0}] [:line-to {:x 30 :y 0}]]
+ (mapv (juxt :command :params) content')))
+ ;; the removed segment's now-stale selection is pruned
+ (t/is (= #{} (get-in state' [:workspace-local :edit-path id :selection :segments])))))
+
+(t/deftest remove-segment-remaps-handler-types-when-node-indices-shift
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 12 :c1y 4 :c2x 18 :c2y 4 :x 20 :y 0}}
+ {:command :curve-to
+ :params {:c1x 22 :c1y -4 :c2x 28 :c2y -4 :x 30 :y 0}}])
+ state (-> (pth/selectable-path-state
+ id content {:nodes #{2} :segments #{} :handlers #{}})
+ (assoc-in [:workspace-local :edit-path id :handler-types]
+ {2 :aligned}))
+ state' (ptk/update (path.tools/remove-segment 1) state)]
+ ;; Remap the selected node after dropping the dangling start.
+ (t/is (= 3 (count (get-in state' [:workspace-drawing :object :content]))))
+ (t/is (= #{1} (get-in state' [:workspace-local :edit-path id :selection :nodes])))
+ ;; Keep the mode attached to the surviving node.
+ (t/is (= {1 :aligned}
+ (get-in state' [:workspace-local :edit-path id :handler-types])))))
+
+(t/deftest removing-an-earlier-node-preserves-a-surviving-mirror-mode
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :curve-to
+ :params {:c1x 3 :c1y 0 :c2x 7 :c2y 0 :x 10 :y 0}}
+ {:command :curve-to
+ :params {:c1x 13 :c1y 0 :c2x 17 :c2y 0 :x 20 :y 0}}
+ {:command :curve-to
+ :params {:c1x 23 :c1y 0 :c2x 28 :c2y 0 :x 30 :y 0}}
+ {:command :curve-to
+ :params {:c1x 34 :c1y 0 :c2x 37 :c2y 0 :x 40 :y 0}}
+ {:command :curve-to
+ :params {:c1x 43 :c1y 0 :c2x 47 :c2y 0 :x 50 :y 0}}])
+ state (-> (pth/selectable-path-state
+ id content {:nodes #{0} :segments #{} :handlers #{}})
+ (assoc-in [:workspace-local :edit-path id :handler-types]
+ {3 :mirror}))
+ state' (ptk/update (path.tools/remove-node) state)]
+ ;; Geometry alone derives the fourth node as aligned.
+ (t/is (= :aligned (path.helpers/derive-handler-type content 3)))
+ ;; Remap the explicit mode with the surviving node.
+ (t/is (= {2 :mirror}
+ (get-in state' [:workspace-local :edit-path id :handler-types])))))
+
+(t/deftest remove-node-with-segments-opens-a-gap
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :line-to :params {:x 20 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ state (pth/selectable-path-state id content path.helpers/empty-selection)
+ emitted (atom [])
+ _ (->> (ptk/watch (path.tools/remove-node-with-segments 1) state nil)
+ (rx/subs! #(swap! emitted conj %)))
+ state' (reduce #(ptk/update %2 %1) state @emitted)
+ content' (get-in state' [:workspace-drawing :object :content])]
+ ;; node (10,0) and both incident segments are gone; the (0,0) start is
+ ;; left dangling and dropped too, the rest of the path survives
+ (t/is (= [[:move-to {:x 20 :y 0}] [:line-to {:x 30 :y 0}]]
+ (mapv (juxt :command :params) content')))))
+
+(t/deftest dragging-a-node-or-segment-onto-another-merges-them
+ (let [id (random-uuid)
+ content (path/content
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 10 :y 0}}
+ {:command :move-to :params {:x 12 :y 0}}
+ {:command :line-to :params {:x 30 :y 0}}])
+ mk (fn [selection]
+ (-> (pth/selectable-path-state id content selection)
+ (assoc-in [:workspace-local :zoom] 1)))
+ emit-of (fn [state]
+ (let [out (atom [])]
+ (->> (ptk/watch (path.edition/merge-dragged-on-drop)
+ state (rx/subject))
+ (rx/subs! #(swap! out conj %)))
+ @out))
+ welded [{:x 0 :y 0} {:x 11 :y 0} {:x 30 :y 0}]]
+ (t/testing "a single node dropped within range of another node merges them"
+ (let [state (mk {:nodes #{1} :segments #{} :handlers #{}})
+ events (emit-of state)
+ content' (vec (get-in (ptk/update (first events) state)
+ [:workspace-drawing :object :content]))]
+ (t/is (= 1 (count events)))
+ ;; Dropped subpath endpoints weld at their midpoint.
+ (t/is (= welded (mapv :params content')))))
+ (t/testing "a dragged segment whose endpoint lands on a node merges too"
+ ;; segment 1 (nodes (0,0)-(10,0)); its (10,0) end is within range of (12,0)
+ (let [state (mk {:nodes #{} :segments #{1} :handlers #{}})
+ events (emit-of state)
+ content' (vec (get-in (ptk/update (first events) state)
+ [:workspace-drawing :object :content]))]
+ (t/is (= 1 (count events)))
+ (t/is (= welded (mapv :params content')))))
+ (t/testing "a node dropped with no neighbour in range does not merge"
+ (t/is (empty? (emit-of (mk {:nodes #{3} :segments #{} :handlers #{}})))))))
+
+;; Path-local undo and redo events use a seeded local stack.
diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs
index 2f4bb3d591..144913cc79 100644
--- a/frontend/test/frontend_tests/runner.cljs
+++ b/frontend/test/frontend_tests/runner.cljs
@@ -31,6 +31,11 @@
[frontend-tests.logic.groups-test]
[frontend-tests.logic.nudge-selected-shapes-test]
[frontend-tests.logic.pasting-in-containers-test]
+ [frontend-tests.logic.path-actions-test]
+ [frontend-tests.logic.path-clipboard-test]
+ [frontend-tests.logic.path-helpers-test]
+ [frontend-tests.logic.path-lifecycle-test]
+ [frontend-tests.logic.path-tools-test]
[frontend-tests.main-errors-test]
[frontend-tests.plugins.comments-test]
[frontend-tests.plugins.context-shapes-test]
@@ -118,6 +123,11 @@
'frontend-tests.logic.frame-guides-test
'frontend-tests.logic.groups-test
'frontend-tests.logic.nudge-selected-shapes-test
+ 'frontend-tests.logic.path-actions-test
+ 'frontend-tests.logic.path-clipboard-test
+ 'frontend-tests.logic.path-helpers-test
+ 'frontend-tests.logic.path-lifecycle-test
+ 'frontend-tests.logic.path-tools-test
'frontend-tests.logic.pasting-in-containers-test
'frontend-tests.main-errors-test
'frontend-tests.plugins.comments-test
diff --git a/frontend/translations/en.po b/frontend/translations/en.po
index 3799d37643..c6c187a2cd 100644
--- a/frontend/translations/en.po
+++ b/frontend/translations/en.po
@@ -5297,6 +5297,14 @@ msgid "shortcuts.delete-node"
msgstr "Delete node"
#: src/app/main/ui/workspace/sidebar/shortcuts.cljs:103
+msgid "shortcuts.delete-node-and-segments"
+msgstr "Delete node and segments"
+
+#: src/app/main/ui/workspace/sidebar/shortcuts.cljs:103
+msgid "shortcuts.deselect-all"
+msgstr "Deselect all"
+
+#: src/app/main/ui/workspace/sidebar/shortcuts.cljs:104
msgid "shortcuts.detach-component"
msgstr "Detach component"
@@ -8745,6 +8753,22 @@ msgstr "To corner (%s)"
msgid "workspace.path.actions.make-curve"
msgstr "To curve (%s)"
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-type"
+msgstr "Handler behaviour"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-mirror"
+msgstr "Equal"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-aligned"
+msgstr "Aligned"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-independent"
+msgstr "Independent"
+
#: src/app/main/ui/workspace/viewport/path_actions.cljs:181
msgid "workspace.path.actions.merge-nodes"
msgstr "Merge nodes (%s)"
diff --git a/frontend/translations/es.po b/frontend/translations/es.po
index 0660023ff4..0a80b97209 100644
--- a/frontend/translations/es.po
+++ b/frontend/translations/es.po
@@ -5164,6 +5164,13 @@ msgid "shortcuts.delete-node"
msgstr "Borrar nodo"
#: src/app/main/ui/workspace/sidebar/shortcuts.cljs:103
+msgid "shortcuts.delete-node-and-segments"
+msgstr "Borrar nodo y segmentos"
+
+#: src/app/main/ui/workspace/sidebar/shortcuts.cljs:103
+msgid "shortcuts.deselect-all"
+msgstr "Deseleccionar todo"
+
msgid "shortcuts.detach-component"
msgstr "Desvincular componente"
@@ -9606,6 +9613,22 @@ msgstr "Comentarios (%s)"
msgid "workspace.toolbar.curve"
msgstr "Curva (%s)"
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-type"
+msgstr "Comportamiento manejador"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-mirror"
+msgstr "Igual"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-aligned"
+msgstr "Alineado"
+
+#: src/app/main/ui/workspace/viewport/path_actions.cljs
+msgid "workspace.path.actions.handler-independent"
+msgstr "Independiente"
+
#: src/app/main/ui/workspace/top_toolbar.cljs:231
#, unused
msgid "workspace.toolbar.debug"
diff --git a/render-wasm/src/shapes.rs b/render-wasm/src/shapes.rs
index 47269c5288..cc064c8fad 100644
--- a/render-wasm/src/shapes.rs
+++ b/render-wasm/src/shapes.rs
@@ -1504,7 +1504,6 @@ impl Shape {
};
let path_transform = self.to_path_transform();
- let apply_doc_transform = path_transform.is_some();
for stroke in self.visible_strokes() {
let Some(stroke_region) = stroke_to_path(
@@ -1517,10 +1516,7 @@ impl Shape {
) else {
continue;
};
- let mut sk = stroke_region.to_skia_path(self.svg_attrs.as_ref());
- if apply_doc_transform {
- sk = sk.make_transform(&self.shape_document_transform());
- }
+ let sk = stroke_region.to_skia_path(self.svg_attrs.as_ref());
acc = acc.op(&sk, skia::PathOp::Union).unwrap_or(acc);
}