From a91537bc3fbd101694b342781608c50cdc7389e7 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Wed, 22 Jul 2026 16:16:52 +0200 Subject: [PATCH] :sparkles: Improve path operations and edition --- common/src/app/common/types/path.cljc | 189 +++- common/src/app/common/types/path/fit.cljc | 209 ++++ common/src/app/common/types/path/helpers.cljc | 82 +- common/src/app/common/types/path/segment.cljc | 826 ++++++++++----- .../src/app/common/types/path/selection.cljc | 208 ++++ common/src/app/common/types/path/subpath.cljc | 39 +- common/src/app/common/types/shape.cljc | 3 +- .../common_tests/types/path_data_test.cljc | 960 +++++++++++++++++- .../playwright/ui/specs/workspace.spec.js | 34 +- .../resources/images/cursors/draw-add.svg | 6 + .../resources/images/cursors/draw-node.svg | 6 + .../resources/images/cursors/draw-remove.svg | 6 + frontend/resources/images/cursors/draw.svg | 6 + .../resources/images/cursors/move-add.svg | 8 + .../resources/images/cursors/move-copy.svg | 6 + .../resources/images/cursors/move-curve.svg | 7 + .../resources/images/cursors/move-handles.svg | 8 + .../resources/images/cursors/move-move.svg | 8 + .../resources/images/cursors/move-node.svg | 7 + .../resources/images/cursors/move-remove.svg | 7 + frontend/resources/images/cursors/move.svg | 6 + .../resources/images/icons/handlers-equal.svg | 3 + .../images/icons/handlers-independent.svg | 3 + .../images/icons/handlers-mirror.svg | 3 + frontend/resources/images/icons/snap.svg | 3 + .../styles/common/refactor/color-defs.scss | 1 + frontend/src/app/main/data/workspace.cljs | 1 + .../app/main/data/workspace/clipboard.cljs | 6 +- .../main/data/workspace/drawing/common.cljs | 16 +- .../main/data/workspace/drawing/curve.cljs | 6 +- .../src/app/main/data/workspace/edition.cljs | 47 +- .../src/app/main/data/workspace/path.cljs | 29 + .../app/main/data/workspace/path/changes.cljs | 117 +-- .../main/data/workspace/path/clipboard.cljs | 209 ++++ .../app/main/data/workspace/path/common.cljs | 30 +- .../app/main/data/workspace/path/drawing.cljs | 448 ++++++-- .../app/main/data/workspace/path/edition.cljs | 842 ++++++++++++--- .../app/main/data/workspace/path/helpers.cljs | 495 ++++++++- .../main/data/workspace/path/selection.cljs | 160 +-- .../data/workspace/path/shapes_to_path.cljs | 40 +- .../main/data/workspace/path/shortcuts.cljs | 69 +- .../app/main/data/workspace/path/state.cljs | 50 +- .../app/main/data/workspace/path/streams.cljs | 119 ++- .../app/main/data/workspace/path/tools.cljs | 358 ++++++- .../app/main/data/workspace/path/undo.cljs | 32 +- .../app/main/data/workspace/transforms.cljs | 67 ++ frontend/src/app/main/refs.cljs | 3 + frontend/src/app/main/ui/css_cursors.cljs | 12 + frontend/src/app/main/ui/cursors.clj | 19 +- frontend/src/app/main/ui/cursors.cljs | 12 + frontend/src/app/main/ui/icons.cljs | 4 + frontend/src/app/main/ui/measurements.cljs | 111 +- .../app/main/ui/workspace/context_menu.cljs | 5 +- .../main/ui/workspace/shapes/path/editor.cljs | 507 ++++++--- .../main/ui/workspace/sidebar/options.cljs | 31 +- .../sidebar/options/menus/align.cljs | 30 +- .../sidebar/options/menus/measures.cljs | 23 + .../sidebar/options/shapes/path.cljs | 100 +- .../app/main/ui/workspace/top_toolbar.cljs | 15 +- .../src/app/main/ui/workspace/viewport.cljs | 67 +- .../main/ui/workspace/viewport/drawarea.cljs | 60 +- .../app/main/ui/workspace/viewport/hooks.cljs | 11 +- .../ui/workspace/viewport/path_actions.cljs | 313 ++++-- .../ui/workspace/viewport/path_actions.scss | 96 +- .../ui/workspace/viewport/path_state.cljs | 39 + .../main/ui/workspace/viewport/selection.cljs | 233 +++-- .../main/ui/workspace/viewport/top_bar.cljs | 20 + .../app/main/ui/workspace/viewport/utils.cljs | 2 + .../ui/workspace/viewport/viewport_ref.cljs | 5 + .../app/main/ui/workspace/viewport_wasm.cljs | 69 +- .../logic/path_actions_test.cljs | 120 +++ .../logic/path_clipboard_test.cljs | 204 ++++ .../logic/path_helpers_test.cljs | 117 +++ .../logic/path_lifecycle_test.cljs | 542 ++++++++++ .../logic/path_test_helpers.cljs | 94 ++ .../frontend_tests/logic/path_tools_test.cljs | 804 +++++++++++++++ frontend/test/frontend_tests/runner.cljs | 10 + frontend/translations/en.po | 24 + frontend/translations/es.po | 23 + render-wasm/src/shapes.rs | 6 +- 80 files changed, 8261 insertions(+), 1255 deletions(-) create mode 100644 common/src/app/common/types/path/fit.cljc create mode 100644 common/src/app/common/types/path/selection.cljc create mode 100644 frontend/resources/images/cursors/draw-add.svg create mode 100644 frontend/resources/images/cursors/draw-node.svg create mode 100644 frontend/resources/images/cursors/draw-remove.svg create mode 100644 frontend/resources/images/cursors/draw.svg create mode 100644 frontend/resources/images/cursors/move-add.svg create mode 100644 frontend/resources/images/cursors/move-copy.svg create mode 100644 frontend/resources/images/cursors/move-curve.svg create mode 100644 frontend/resources/images/cursors/move-handles.svg create mode 100644 frontend/resources/images/cursors/move-move.svg create mode 100644 frontend/resources/images/cursors/move-node.svg create mode 100644 frontend/resources/images/cursors/move-remove.svg create mode 100644 frontend/resources/images/cursors/move.svg create mode 100644 frontend/resources/images/icons/handlers-equal.svg create mode 100644 frontend/resources/images/icons/handlers-independent.svg create mode 100644 frontend/resources/images/icons/handlers-mirror.svg create mode 100644 frontend/resources/images/icons/snap.svg create mode 100644 frontend/src/app/main/data/workspace/path/clipboard.cljs create mode 100644 frontend/src/app/main/ui/workspace/viewport/path_state.cljs create mode 100644 frontend/test/frontend_tests/logic/path_actions_test.cljs create mode 100644 frontend/test/frontend_tests/logic/path_clipboard_test.cljs create mode 100644 frontend/test/frontend_tests/logic/path_helpers_test.cljs create mode 100644 frontend/test/frontend_tests/logic/path_lifecycle_test.cljs create mode 100644 frontend/test/frontend_tests/logic/path_test_helpers.cljs create mode 100644 frontend/test/frontend_tests/logic/path_tools_test.cljs 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); }