diff --git a/CHANGES.md b/CHANGES.md index 7efcc54743..3eb09081cf 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ - Add integration with gitpod.io (an online IDE) [#807](https://github.com/penpot/penpot/pull/807) - Allow to group assets (components and graphics) [Taiga #1289](https://tree.taiga.io/project/penpot/us/1289) - Internal: refactor of http client, replace internal xhr usage with more modern Fetch API. +- New features for paths: snap points on edition, add/remove nodes, merge/join/split nodes. [Taiga #907](https://tree.taiga.io/project/penpot/us/907) ### :bug: Bugs fixed diff --git a/common/app/common/geom/point.cljc b/common/app/common/geom/point.cljc index 0124b142da..6e656d8889 100644 --- a/common/app/common/geom/point.cljc +++ b/common/app/common/geom/point.cljc @@ -220,7 +220,9 @@ v2-unit (point scalar-projection scalar-projection)))) -(defn center-points [points] +(defn center-points + "Centroid of a group of points" + [points] (let [k (point (count points))] (reduce #(add %1 (divide %2 k)) (point) points))) @@ -253,7 +255,16 @@ (and (mth/almost-zero? x) (mth/almost-zero? y))) +(defn line-val + "Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector + generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return + the point (0.25, 0.25)" + [p1 p2 v] + (let [v (-> (to-vec p1 p2) + (scale v))] + (add p1 v))) ;; --- Debug (defmethod pp/simple-dispatch Point [obj] (pr obj)) + diff --git a/common/app/common/geom/shapes.cljc b/common/app/common/geom/shapes.cljc index de6826249d..28e110b736 100644 --- a/common/app/common/geom/shapes.cljc +++ b/common/app/common/geom/shapes.cljc @@ -253,3 +253,4 @@ ;; Intersection (d/export gin/overlaps?) (d/export gin/has-point?) +(d/export gin/has-point-rect?) diff --git a/common/app/common/geom/shapes/intersect.cljc b/common/app/common/geom/shapes/intersect.cljc index 6b9e3f5be8..0b6fbcd6f5 100644 --- a/common/app/common/geom/shapes/intersect.cljc +++ b/common/app/common/geom/shapes/intersect.cljc @@ -285,6 +285,11 @@ (or (not path?) (overlaps-path? shape rect)) (or (not circle?) (overlaps-ellipse? shape rect)))))) +(defn has-point-rect? + [rect point] + (let [lines (gpr/rect->lines rect)] + (is-point-inside-evenodd? point lines))) + (defn has-point? "Check if the shape contains a point" [shape point] diff --git a/common/app/common/geom/shapes/path.cljc b/common/app/common/geom/shapes/path.cljc index 2072ade317..eaa1772544 100644 --- a/common/app/common/geom/shapes/path.cljc +++ b/common/app/common/geom/shapes/path.cljc @@ -41,6 +41,20 @@ (gpt/point (coord-v :x) (coord-v :y)))) +(defn curve-split + "Splits a curve into two at the given parametric value `t`. + Calculates the Casteljau's algorithm intermediate points" + [start end h1 h2 t] + + (let [p1 (gpt/line-val start h1 t) + p2 (gpt/line-val h1 h2 t) + p3 (gpt/line-val h2 end t) + p4 (gpt/line-val p1 p2 t) + p5 (gpt/line-val p2 p3 t) + sp (gpt/line-val p4 p5 t)] + [[start sp p1 p4] + [sp end p5 p3]])) + ;; https://pomax.github.io/bezierinfo/#extremities (defn curve-extremities "Given a cubic bezier cube finds its roots in t. This are the extremities @@ -211,3 +225,92 @@ point)) (conj result [prev-point last-start])))) + +(defonce path-closest-point-accuracy 0.01) +(defn curve-closest-point + [position start end h1 h2] + (let [d (memoize (fn [t] (gpt/distance position (curve-values start end h1 h2 t))))] + (loop [t1 0 + t2 1] + (if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy) + (curve-values start end h1 h2 t1) + + (let [ht (+ t1 (/ (- t2 t1) 2)) + ht1 (+ t1 (/ (- t2 t1) 4)) + ht2 (+ t1 (/ (* 3 (- t2 t1)) 4)) + + [t1 t2] (cond + (< (d ht1) (d ht2)) + [t1 ht] + + (< (d ht2) (d ht1)) + [ht t2] + + (and (< (d ht) (d t1)) (< (d ht) (d t2))) + [ht1 ht2] + + (< (d t1) (d t2)) + [t1 ht] + + :else + [ht t2])] + (recur t1 t2)))))) + +(defn line-closest-point + "Point on line" + [position from-p to-p] + + (let [{v1x :x v1y :y} from-p + {v2x :x v2y :y} to-p + {px :x py :y} position + + e1 (gpt/point (- v2x v1x) (- v2y v1y)) + e2 (gpt/point (- px v1x) (- py v1y)) + + len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1))) + val-dp (/ (gpt/dot e1 e2) len2)] + + (if (and (>= val-dp 0) + (<= val-dp 1) + (not (mth/almost-zero? len2))) + (gpt/point (+ v1x (* val-dp (:x e1))) + (+ v1y (* val-dp (:y e1)))) + ;; There is no perpendicular projection in the line so the closest + ;; point will be one of the extremes + (if (<= (gpt/distance position from-p) (gpt/distance position to-p)) + from-p + to-p)))) + +(defn path-closest-point + "Given a path and a position" + [shape position] + + (let [point+distance (fn [[cur-cmd prev-cmd]] + (let [point + (case (:command cur-cmd) + :line-to (line-closest-point + position + (command->point prev-cmd) + (command->point cur-cmd)) + :curve-to (curve-closest-point + position + (command->point prev-cmd) + (command->point cur-cmd) + (gpt/point (get-in cur-cmd [:params :c1x]) + (get-in cur-cmd [:params :c1y])) + (gpt/point (get-in cur-cmd [:params :c2x]) + (get-in cur-cmd [:params :c2y]))) + nil)] + (when point + [point (gpt/distance point position)]))) + + find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]] + (if (and (some? acc) (or (not cur) (<= min-dist cur-dist))) + [min-p min-dist] + [cur-p cur-dist]))] + + (->> (:content shape) + (d/with-prev) + (map point+distance) + (reduce find-min-point) + (first)))) diff --git a/common/app/common/geom/shapes/rect.cljc b/common/app/common/geom/shapes/rect.cljc index be221b1d91..91e7d18a9a 100644 --- a/common/app/common/geom/shapes/rect.cljc +++ b/common/app/common/geom/shapes/rect.cljc @@ -19,6 +19,12 @@ (gpt/point (+ x width) (+ y height)) (gpt/point x (+ y height))]) +(defn rect->lines [{:keys [x y width height]}] + [[(gpt/point x y) (gpt/point (+ x width) y)] + [(gpt/point (+ x width) y) (gpt/point (+ x width) (+ y height))] + [(gpt/point (+ x width) (+ y height)) (gpt/point x (+ y height))] + [(gpt/point x (+ y height)) (gpt/point x y)]]) + (defn points->rect [points] (let [minx (transduce gco/map-x-xf min ##Inf points) diff --git a/frontend/deps.edn b/frontend/deps.edn index 51d43a0f60..313e8db1a0 100644 --- a/frontend/deps.edn +++ b/frontend/deps.edn @@ -11,7 +11,7 @@ danlentz/clj-uuid {:mvn/version "0.1.9"} frankiesardo/linked {:mvn/version "1.3.0"} - funcool/beicon {:mvn/version "2021.04.09-1"} + funcool/beicon {:mvn/version "2021.04.12-1"} funcool/cuerdas {:mvn/version "2020.03.26-3"} funcool/okulary {:mvn/version "2020.04.14-0"} funcool/potok {:mvn/version "3.2.0"} diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index b5ce81ae24..5b629986d3 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -24,7 +24,7 @@ [app.main.data.messages :as dm] [app.main.data.workspace.common :as dwc] [app.main.data.workspace.drawing :as dwd] - [app.main.data.workspace.drawing.path :as dwdp] + [app.main.data.workspace.path :as dwdp] [app.main.data.workspace.groups :as dwg] [app.main.data.workspace.libraries :as dwl] [app.main.data.workspace.notifications :as dwn] diff --git a/frontend/src/app/main/data/workspace/common.cljs b/frontend/src/app/main/data/workspace/common.cljs index afec9744c0..e993573bf9 100644 --- a/frontend/src/app/main/data/workspace/common.cljs +++ b/frontend/src/app/main/data/workspace/common.cljs @@ -360,25 +360,30 @@ (ptk/reify ::undo ptk/WatchEvent (watch [_ state stream] - (let [undo (:workspace-undo state) - items (:items undo) - index (or (:index undo) (dec (count items)))] - (when-not (or (empty? items) (= index -1)) - (let [changes (get-in items [index :undo-changes])] - (rx/of (materialize-undo changes (dec index)) - (commit-changes changes [] {:save-undo? false})))))))) + (let [edition (get-in state [:workspace-local :edition])] + ;; Editors handle their own undo's + (when-not (some? edition) + (let [undo (:workspace-undo state) + items (:items undo) + index (or (:index undo) (dec (count items)))] + (when-not (or (empty? items) (= index -1)) + (let [changes (get-in items [index :undo-changes])] + (rx/of (materialize-undo changes (dec index)) + (commit-changes changes [] {:save-undo? false})))))))))) (def redo (ptk/reify ::redo ptk/WatchEvent (watch [_ state stream] - (let [undo (:workspace-undo state) - items (:items undo) - index (or (:index undo) (dec (count items)))] - (when-not (or (empty? items) (= index (dec (count items)))) - (let [changes (get-in items [(inc index) :redo-changes])] - (rx/of (materialize-undo changes (inc index)) - (commit-changes changes [] {:save-undo? false})))))))) + (let [edition (get-in state [:workspace-local :edition])] + (when-not (some? edition) + (let [undo (:workspace-undo state) + items (:items undo) + index (or (:index undo) (dec (count items)))] + (when-not (or (empty? items) (= index (dec (count items)))) + (let [changes (get-in items [(inc index) :redo-changes])] + (rx/of (materialize-undo changes (inc index)) + (commit-changes changes [] {:save-undo? false})))))))))) (def reinitialize-undo (ptk/reify ::reset-undo diff --git a/frontend/src/app/main/data/workspace/drawing.cljs b/frontend/src/app/main/data/workspace/drawing.cljs index 9c011c373b..553b310384 100644 --- a/frontend/src/app/main/data/workspace/drawing.cljs +++ b/frontend/src/app/main/data/workspace/drawing.cljs @@ -14,8 +14,8 @@ [app.common.uuid :as uuid] [app.main.data.workspace.common :as dwc] [app.main.data.workspace.selection :as dws] + [app.main.data.workspace.path :as path] [app.main.data.workspace.drawing.common :as common] - [app.main.data.workspace.drawing.path :as path] [app.main.data.workspace.drawing.curve :as curve] [app.main.data.workspace.drawing.box :as box])) diff --git a/frontend/src/app/main/data/workspace/drawing/path.cljs b/frontend/src/app/main/data/workspace/drawing/path.cljs deleted file mode 100644 index 494d796af2..0000000000 --- a/frontend/src/app/main/data/workspace/drawing/path.cljs +++ /dev/null @@ -1,860 +0,0 @@ -;; 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) UXBOX Labs SL - -(ns app.main.data.workspace.drawing.path - (:require - [app.common.data :as d] - [app.common.geom.matrix :as gmt] - [app.common.geom.point :as gpt] - [app.common.geom.shapes :as gsh] - [app.common.geom.shapes.path :as gsp] - [app.common.math :as mth] - [app.common.pages :as cp] - [app.common.spec :as us] - [app.main.data.workspace.common :as dwc] - [app.main.data.workspace.drawing.common :as common] - [app.main.store :as st] - [app.main.streams :as ms] - [app.util.geom.path :as ugp] - [beicon.core :as rx] - [clojure.spec.alpha :as s] - [potok.core :as ptk])) - -;; SCHEMAS - -(s/def ::command #{:move-to - :line-to - :line-to-horizontal - :line-to-vertical - :curve-to - :smooth-curve-to - :quadratic-bezier-curve-to - :smooth-quadratic-bezier-curve-to - :elliptical-arc - :close-path}) - -(s/def :paths.params/x number?) -(s/def :paths.params/y number?) -(s/def :paths.params/c1x number?) -(s/def :paths.params/c1y number?) -(s/def :paths.params/c2x number?) -(s/def :paths.params/c2y number?) - -(s/def ::relative? boolean?) - -(s/def ::params - (s/keys :req-un [:path.params/x - :path.params/y] - :opt-un [:path.params/c1x - :path.params/c1y - :path.params/c2x - :path.params/c2y])) - -(s/def ::content-entry - (s/keys :req-un [::command] - :req-opt [::params - ::relative?])) -(s/def ::content - (s/coll-of ::content-entry :kind vector?)) - - -;; CONSTANTS -(defonce enter-keycode 13) -(defonce drag-threshold 5) - -;; PRIVATE METHODS - -(defn get-path-id - "Retrieves the currently editing path id" - [state] - (or (get-in state [:workspace-local :edition]) - (get-in state [:workspace-drawing :object :id]))) - -(defn get-path - "Retrieves the location of the path object and additionaly can pass - the arguments. This location can be used in get-in, assoc-in... functions" - [state & path] - (let [edit-id (get-in state [:workspace-local :edition]) - page-id (:current-page-id state)] - (d/concat - (if edit-id - [:workspace-data :pages-index page-id :objects edit-id] - [:workspace-drawing :object]) - path))) - -(defn- points->components [shape content] - (let [transform (:transform shape (gmt/matrix)) - transform-inverse (:transform-inverse shape (gmt/matrix)) - center (gsh/center-shape shape) - base-content (gsh/transform-content - content - (gmt/transform-in center transform-inverse)) - - ;; Calculates the new selrect with points given the old center - points (-> (gsh/content->selrect base-content) - (gsh/rect->points) - (gsh/transform-points center (:transform shape (gmt/matrix)))) - - points-center (gsh/center-points points) - - ;; Points is now the selrect but the center is different so we can create the selrect - ;; through points - selrect (-> points - (gsh/transform-points points-center (:transform-inverse shape (gmt/matrix))) - (gsh/points->selrect))] - [points selrect])) - -(defn update-selrect - "Updates the selrect and points for a path" - [shape] - (if (= (:rotation shape 0) 0) - (let [content (:content shape) - selrect (gsh/content->selrect content) - points (gsh/rect->points selrect)] - (assoc shape :points points :selrect selrect)) - - (let [content (:content shape) - [points selrect] (points->components shape content)] - (assoc shape :points points :selrect selrect)))) - -(defn closest-angle [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)) - -(defn position-fixed-angle [point from-point] - (if (and from-point point) - (let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360) - to-angle (closest-angle angle) - distance (gpt/distance point from-point)] - (gpt/angle->point from-point (mth/radians to-angle) distance)) - point)) - -(defn next-node - "Calculates the next-node to be inserted." - [shape position prev-point prev-handler] - (let [last-command (-> shape :content last :command) - add-line? (and prev-point (not prev-handler) (not= last-command :close-path)) - add-curve? (and prev-point prev-handler (not= last-command :close-path))] - (cond - add-line? {:command :line-to - :params position} - add-curve? {:command :curve-to - :params (ugp/make-curve-params position prev-handler)} - :else {:command :move-to - :params position}))) - -(defn append-node - "Creates a new node in the path. Usualy used when drawing." - [shape position prev-point prev-handler] - (let [command (next-node shape position prev-point prev-handler)] - (-> shape - (update :content (fnil conj []) command) - (update-selrect)))) - -(defn move-handler-modifiers [content index prefix match-opposite? dx dy] - (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) - [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) - opposite-index (ugp/opposite-index content index prefix)] - - (cond-> {} - :always - (update index assoc cx dx cy dy) - - (and match-opposite? opposite-index) - (update opposite-index assoc ocx (- dx) ocy (- dy))))) - -(defn end-path-event? [{:keys [type shift] :as event}] - (or (= (ptk/type event) ::finish-path) - (= (ptk/type event) :esc-pressed) - (= event :interrupt) ;; ESC - (and (ms/mouse-double-click? event)))) - -(defn generate-path-changes [page-id shape old-content new-content] - (us/verify ::content old-content) - (us/verify ::content new-content) - (let [shape-id (:id shape) - [old-points old-selrect] (points->components shape old-content) - [new-points new-selrect] (points->components shape new-content) - - rch [{:type :mod-obj - :id shape-id - :page-id page-id - :operations [{:type :set :attr :content :val new-content} - {:type :set :attr :selrect :val new-selrect} - {:type :set :attr :points :val new-points}]} - {:type :reg-objects - :page-id page-id - :shapes [shape-id]}] - - uch [{:type :mod-obj - :id shape-id - :page-id page-id - :operations [{:type :set :attr :content :val old-content} - {:type :set :attr :selrect :val old-selrect} - {:type :set :attr :points :val old-points}]} - {:type :reg-objects - :page-id page-id - :shapes [shape-id]}]] - [rch uch])) - -(defn clean-edit-state - [state] - (dissoc state :last-point :prev-handler :drag-handler :preview)) - -(defn dragging? [start zoom] - (fn [current] - (>= (gpt/distance start current) (/ drag-threshold zoom)))) - -(defn drag-stream [to-stream] - (let [start @ms/mouse-position - zoom (get-in @st/state [:workspace-local :zoom] 1) - mouse-up (->> st/stream (rx/filter #(ms/mouse-up? %)))] - (->> ms/mouse-position - (rx/take-until mouse-up) - (rx/filter (dragging? start zoom)) - (rx/take 1) - (rx/merge-map (fn [] to-stream))))) - -(defn position-stream [] - (->> ms/mouse-position - (rx/with-latest merge (->> ms/mouse-position-shift (rx/map #(hash-map :shift? %)))) - (rx/with-latest merge (->> ms/mouse-position-alt (rx/map #(hash-map :alt? %)))))) - -;; EVENTS - -(defn init-path [] - (ptk/reify ::init-path)) - -(defn finish-path [source] - (ptk/reify ::finish-path - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (-> state - (update-in [:workspace-local :edit-path id] clean-edit-state)))))) - -(defn preview-next-point [{:keys [x y shift?]}] - (ptk/reify ::preview-next-point - ptk/UpdateEvent - (update [_ state] - (let [id (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? (position-fixed-angle last-point)) - shape (get-in state (get-path state)) - {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) - command (next-node shape position last-point prev-handler)] - (assoc-in state [:workspace-local :edit-path id :preview] command))))) - -(defn add-node [{:keys [x y shift?]}] - (ptk/reify ::add-node - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state) - fix-angle? shift? - {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) - position (cond-> (gpt/point x y) - fix-angle? (position-fixed-angle last-point))] - (if-not (= last-point position) - (-> state - (assoc-in [:workspace-local :edit-path id :last-point] position) - (update-in [:workspace-local :edit-path id] dissoc :prev-handler) - (update-in [:workspace-local :edit-path id] dissoc :preview) - (update-in (get-path state) append-node position last-point prev-handler)) - state))))) - -(defn start-drag-handler [] - (ptk/reify ::start-drag-handler - ptk/UpdateEvent - (update [_ state] - (let [content (get-in state (get-path state :content)) - index (dec (count content)) - command (get-in state (get-path state :content index :command)) - - make-curve - (fn [command] - (let [params (ugp/make-curve-params - (get-in content [index :params]) - (get-in content [(dec index) :params]))] - (-> command - (assoc :command :curve-to :params params))))] - - (cond-> state - (= command :line-to) - (update-in (get-path state :content index) make-curve)))))) - -(defn drag-handler [{:keys [x y alt? shift?]}] - (ptk/reify ::drag-handler - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state) - shape (get-in state (get-path state)) - content (:content shape) - index (dec (count content)) - node-position (ugp/command->point (nth content index)) - handler-position (cond-> (gpt/point x y) - shift? (position-fixed-angle node-position)) - {dx :x dy :y} (gpt/subtract handler-position node-position) - match-opposite? (not alt?) - modifiers (move-handler-modifiers content (inc index) :c1 match-opposite? dx dy)] - (-> state - (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) - (assoc-in [:workspace-local :edit-path id :prev-handler] handler-position) - (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position)))))) - -(defn finish-drag [] - (ptk/reify ::finish-drag - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state) - modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) - handler (get-in state [:workspace-local :edit-path id :drag-handler])] - (-> state - (update-in (get-path state :content) ugp/apply-content-modifiers modifiers) - (update-in [:workspace-local :edit-path id] dissoc :drag-handler) - (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) - (assoc-in [:workspace-local :edit-path id :prev-handler] handler) - (update-in (get-path state) update-selrect)))) - - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - handler (get-in state [:workspace-local :edit-path id :prev-handler])] - ;; Update the preview because can be outdated after the dragging - (rx/of (preview-next-point handler)))))) - -(declare close-path-drag-end) - -(defn close-path-drag-start [position] - (ptk/reify ::close-path-drag-start - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - zoom (get-in state [:workspace-local :zoom]) - start-position @ms/mouse-position - - stop-stream - (->> stream (rx/filter #(or (end-path-event? %) - (ms/mouse-up? %)))) - - drag-events-stream - (->> (position-stream) - (rx/take-until stop-stream) - (rx/map #(drag-handler %)))] - - (rx/concat - (rx/of (add-node position)) - (drag-stream - (rx/concat - (rx/of (start-drag-handler)) - drag-events-stream - (rx/of (finish-drag)) - (rx/of (close-path-drag-end)))) - (rx/of (finish-path "close-path"))))))) - -(defn close-path-drag-end [] - (ptk/reify ::close-path-drag-end - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (update-in state [:workspace-local :edit-path id] dissoc :prev-handler))))) - -(defn path-pointer-enter [position] - (ptk/reify ::path-pointer-enter - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (update-in state [:workspace-local :edit-path id :hover-points] (fnil conj #{}) position))))) - -(defn path-pointer-leave [position] - (ptk/reify ::path-pointer-leave - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (update-in state [:workspace-local :edit-path id :hover-points] disj position))))) - -(defn start-path-from-point [position] - (ptk/reify ::start-path-from-point - ptk/WatchEvent - (watch [_ state stream] - (let [start-point @ms/mouse-position - zoom (get-in state [:workspace-local :zoom]) - mouse-up (->> stream (rx/filter #(or (end-path-event? %) - (ms/mouse-up? %)))) - drag-events (->> ms/mouse-position - (rx/take-until mouse-up) - (rx/map #(drag-handler %)))] - - (rx/concat - (rx/of (add-node position)) - (drag-stream - (rx/concat - (rx/of (start-drag-handler)) - drag-events - (rx/of (finish-drag))))))))) - -(defn make-corner [] - (ptk/reify ::make-corner - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - page-id (:current-page-id state) - shape (get-in state (get-path state)) - selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) - new-content (reduce ugp/make-corner-point (:content shape) selected-points) - [rch uch] (generate-path-changes page-id shape (:content shape) new-content)] - (rx/of (dwc/commit-changes rch uch {:commit-local? true})))))) - -(defn make-curve [] - (ptk/reify ::make-curve - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - page-id (:current-page-id state) - shape (get-in state (get-path state)) - selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) - new-content (reduce ugp/make-curve-point (:content shape) selected-points) - [rch uch] (generate-path-changes page-id shape (:content shape) new-content)] - (rx/of (dwc/commit-changes rch uch {:commit-local? true})))))) - -(defn path-handler-enter [index prefix] - (ptk/reify ::path-handler-enter - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (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 (get-path-id state)] - (update-in state [:workspace-local :edit-path id :hover-handlers] disj [index prefix]))))) - -;; EVENT STREAMS - -(defn make-drag-stream - [stream down-event zoom] - (let [mouse-up (->> stream (rx/filter #(or (end-path-event? %) - (ms/mouse-up? %)))) - drag-events (->> (position-stream) - (rx/take-until mouse-up) - (rx/map #(drag-handler %)))] - - (rx/concat - (rx/of (add-node down-event)) - (drag-stream - (rx/concat - (rx/of (start-drag-handler)) - 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)))) - -;; MAIN ENTRIES - -(defn handle-drawing-path - [id] - (ptk/reify ::handle-drawing-path - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (-> state - (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) - - ptk/WatchEvent - (watch [_ state stream] - (let [zoom (get-in state [:workspace-local :zoom]) - mouse-down (->> stream (rx/filter ms/mouse-down?)) - end-path-events (->> stream (rx/filter end-path-event?)) - - ;; Mouse move preview - mousemove-events - (->> (position-stream) - (rx/take-until end-path-events) - (rx/map #(preview-next-point %))) - - ;; From mouse down we can have: click, drag and double click - mousedown-events - (->> mouse-down - (rx/take-until end-path-events) - (rx/with-latest merge (position-stream)) - - ;; We change to the stream that emits the first event - (rx/switch-map - #(rx/race (make-node-events-stream stream) - (make-drag-stream stream % zoom))))] - - (rx/concat - (rx/of (init-path)) - (rx/merge mousemove-events - mousedown-events) - (rx/of (finish-path "after-events"))))))) - - - -(defn modify-point [index prefix dx dy] - (ptk/reify ::modify-point - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition]) - [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] - (-> state - (update-in [:workspace-local :edit-path id :content-modifiers (inc index)] assoc - :c1x dx :c1y dy) - (update-in [:workspace-local :edit-path id :content-modifiers index] assoc - :x dx :y dy :c2x dx :c2y dy)))))) - -(defn modify-handler [id index prefix dx dy match-opposite?] - (ptk/reify ::modify-point - ptk/UpdateEvent - (update [_ state] - (let [content (get-in state (get-path state :content)) - [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) - [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) - opposite-index (ugp/opposite-index content index prefix)] - (cond-> state - :always - (update-in [:workspace-local :edit-path id :content-modifiers index] assoc - cx dx cy dy) - - (and match-opposite? opposite-index) - (update-in [:workspace-local :edit-path id :content-modifiers opposite-index] assoc - ocx (- dx) ocy (- dy))))))) - -(defn apply-content-modifiers [] - (ptk/reify ::apply-content-modifiers - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - page-id (:current-page-id state) - shape (get-in state (get-path state)) - content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) - new-content (ugp/apply-content-modifiers (:content shape) content-modifiers) - [rch uch] (generate-path-changes page-id shape (:content shape) new-content)] - - (rx/of (dwc/commit-changes rch uch {:commit-local? true}) - (fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers))))))) - -(defn save-path-content [] - (ptk/reify ::save-path-content - ptk/UpdateEvent - (update [_ state] - (let [content (get-in state (get-path state :content)) - content (if (= (-> content last :command) :move-to) - (into [] (take (dec (count content)) content)) - content)] - (assoc-in state (get-path state :content) content))) - - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-in state [:workspace-local :edition]) - old-content (get-in state [:workspace-local :edit-path id :old-content])] - (if (some? old-content) - (let [shape (get-in state (get-path state)) - page-id (:current-page-id state) - [rch uch] (generate-path-changes page-id shape old-content (:content shape))] - (rx/of (dwc/commit-changes rch uch {:commit-local? true}))) - (rx/empty)))))) - -(declare start-draw-mode) -(defn check-changed-content [] - (ptk/reify ::check-changed-content - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state) - content (get-in state (get-path state :content)) - old-content (get-in state [:workspace-local :edit-path id :old-content]) - mode (get-in state [:workspace-local :edit-path id :edit-mode])] - - (cond - (not= content old-content) (rx/of (save-path-content) - (start-draw-mode)) - (= mode :draw) (rx/of :interrupt) - :else (rx/of (finish-path "changed-content"))))))) - -(defn move-path-point [start-point end-point] - (ptk/reify ::move-point - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state) - content (get-in state (get-path state :content)) - - {dx :x dy :y} (gpt/subtract end-point start-point) - - handler-indices (-> (ugp/content->handlers content) - (get start-point)) - - command-for-point (fn [[index command]] - (let [point (ugp/command->point command)] - (= point start-point))) - - point-indices (->> (d/enumerate content) - (filter command-for-point) - (map first)) - - - point-reducer (fn [modifiers index] - (-> modifiers - (assoc-in [index :x] dx) - (assoc-in [index :y] dy))) - - handler-reducer (fn [modifiers [index prefix]] - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (-> modifiers - (assoc-in [index cx] dx) - (assoc-in [index cy] dy)))) - - modifiers (as-> (get-in state [:workspace-local :edit-path id :content-modifiers] {}) $ - (reduce point-reducer $ point-indices) - (reduce handler-reducer $ handler-indices))] - - (assoc-in state [:workspace-local :edit-path id :content-modifiers] modifiers))))) - -(defn start-move-path-point - [position] - (ptk/reify ::start-move-path-point - ptk/WatchEvent - (watch [_ state stream] - (let [start-position @ms/mouse-position - stopper (->> stream (rx/filter ms/mouse-up?)) - zoom (get-in state [:workspace-local :zoom])] - - (drag-stream - (rx/concat - (->> ms/mouse-position - (rx/take-until stopper) - (rx/map #(move-path-point position %))) - (rx/of (apply-content-modifiers)))))))) - -(defn start-move-handler - [index prefix] - (ptk/reify ::start-move-handler - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-in state [:workspace-local :edition]) - cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y) - start-point @ms/mouse-position - modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) - start-delta-x (get-in modifiers [index cx] 0) - start-delta-y (get-in modifiers [index cy] 0) - - content (get-in state (get-path state :content)) - opposite-index (ugp/opposite-index content index prefix) - opposite-prefix (if (= prefix :c1) :c2 :c1) - opposite-handler (-> content (get opposite-index) (ugp/get-handler opposite-prefix)) - - point (-> content (get (if (= prefix :c1) (dec index) index)) (ugp/command->point)) - handler (-> content (get index) (ugp/get-handler prefix)) - - current-distance (when opposite-handler (gpt/distance (ugp/opposite-handler point handler) opposite-handler)) - match-opposite? (and opposite-handler (mth/almost-zero? current-distance))] - - (drag-stream - (rx/concat - (->> (position-stream) - (rx/take-until (->> stream (rx/filter ms/mouse-up?))) - (rx/map - (fn [{:keys [x y alt? shift?]}] - (let [pos (cond-> (gpt/point x y) - shift? (position-fixed-angle point))] - (modify-handler - id - index - prefix - (+ start-delta-x (- (:x pos) (:x start-point))) - (+ start-delta-y (- (:y pos) (:y start-point))) - (and (not alt?) match-opposite?)))))) - (rx/concat (rx/of (apply-content-modifiers))))))))) - -(defn start-draw-mode [] - (ptk/reify ::start-draw-mode - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition]) - page-id (:current-page-id state) - old-content (get-in state [:workspace-data :pages-index page-id :objects id :content])] - (-> state - (assoc-in [:workspace-local :edit-path id :old-content] old-content)))) - - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-in state [:workspace-local :edition]) - edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])] - (if (= :draw edit-mode) - (rx/concat - (rx/of (handle-drawing-path id)) - (->> stream - (rx/filter (ptk/type? ::finish-path)) - (rx/take 1) - (rx/merge-map #(rx/of (check-changed-content))))) - (rx/empty)))))) - -(defn change-edit-mode [mode] - (ptk/reify ::change-edit-mode - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition])] - (cond-> state - id (assoc-in [:workspace-local :edit-path id :edit-mode] mode)))) - - ptk/WatchEvent - (watch [_ state stream] - (let [id (get-path-id state)] - (cond - (and id (= :move mode)) (rx/of (finish-path "change-edit-mode")) - (and id (= :draw mode)) (rx/of (start-draw-mode)) - :else (rx/empty)))))) - -(defn select-handler [index type] - (ptk/reify ::select-handler - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition])] - (-> state - (update-in [:workspace-local :edit-path id :selected-handlers] (fnil conj #{}) [index type])))))) - -(defn select-node [position] - (ptk/reify ::select-node - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition])] - (-> state - (assoc-in [:workspace-local :edit-path id :selected-points] #{position})))))) - -(defn deselect-node [position] - (ptk/reify ::deselect-node - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition])] - (-> state - (update-in [:workspace-local :edit-path id :selected-points] (fnil disj #{}) position)))))) - -(defn add-to-selection-handler [index type] - (ptk/reify ::add-to-selection-handler - ptk/UpdateEvent - (update [_ state] - state))) - -(defn add-to-selection-node [index] - (ptk/reify ::add-to-selection-node - ptk/UpdateEvent - (update [_ state] - state))) - -(defn remove-from-selection-handler [index] - (ptk/reify ::remove-from-selection-handler - ptk/UpdateEvent - (update [_ state] - state))) - -(defn remove-from-selection-node [index] - (ptk/reify ::remove-from-selection-handler - ptk/UpdateEvent - (update [_ state] - state))) - -(defn deselect-all [] - (ptk/reify ::deselect-all - ptk/UpdateEvent - (update [_ state] - (let [id (get-path-id state)] - (-> state - (assoc-in [:workspace-local :edit-path id :selected-handlers] #{}) - (assoc-in [:workspace-local :edit-path id :selected-points] #{})))))) - -(defn setup-frame-path [] - (ptk/reify ::setup-frame-path - ptk/UpdateEvent - (update [_ state] - - (let [objects (dwc/lookup-page-objects state) - content (get-in state [:workspace-drawing :object :content] []) - position (get-in content [0 :params] nil) - frame-id (cp/frame-id-by-position objects position)] - (-> state - (assoc-in [:workspace-drawing :object :frame-id] frame-id)))))) - -(defn handle-new-shape-result [shape-id] - (ptk/reify ::handle-new-shape-result - ptk/UpdateEvent - (update [_ state] - (let [content (get-in state [:workspace-drawing :object :content] [])] - (us/verify ::content content) - (if (> (count content) 1) - (assoc-in state [:workspace-drawing :object :initialized?] true) - state))) - - ptk/WatchEvent - (watch [_ state stream] - (->> (rx/of (setup-frame-path) - common/handle-finish-drawing - (dwc/start-edition-mode shape-id) - (change-edit-mode :draw)))))) - -(defn handle-new-shape - "Creates a new path shape" - [] - (ptk/reify ::handle-new-shape - ptk/WatchEvent - (watch [_ state stream] - (let [shape-id (get-in state [:workspace-drawing :object :id])] - (rx/concat - (rx/of (handle-drawing-path shape-id)) - (->> stream - (rx/filter (ptk/type? ::finish-path)) - (rx/take 1) - (rx/observe-on :async) - (rx/map #(handle-new-shape-result shape-id)))))))) - -(defn stop-path-edit [] - (ptk/reify ::stop-path-edit - ptk/UpdateEvent - (update [_ state] - (let [id (get-in state [:workspace-local :edition])] - (update state :workspace-local dissoc :edit-path id))))) - -(defn start-path-edit - [id] - (ptk/reify ::start-path-edit - ptk/UpdateEvent - (update [_ state] - (let [edit-path (get-in state [:workspace-local :edit-path id])] - - (cond-> state - (or (not edit-path) (= :draw (:edit-mode edit-path))) - (assoc-in [:workspace-local :edit-path id] {:edit-mode :move - :selected #{} - :snap-toggled true}) - - (and (some? edit-path) (= :move (:edit-mode edit-path))) - (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) - - ptk/WatchEvent - (watch [_ state stream] - (let [mode (get-in state [:workspace-local :edit-path id :edit-mode])] - (rx/concat - (rx/of (change-edit-mode mode)) - (->> stream - (rx/take-until (->> stream (rx/filter (ptk/type? ::start-path-edit)))) - (rx/filter #(= % :interrupt)) - (rx/take 1) - (rx/map #(stop-path-edit)))))))) diff --git a/frontend/src/app/main/data/workspace/path.cljs b/frontend/src/app/main/data/workspace/path.cljs new file mode 100644 index 0000000000..e4c04a5a71 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path.cljs @@ -0,0 +1,43 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path + (:require + [app.common.data :as d] + [app.main.data.workspace.path.drawing :as drawing] + [app.main.data.workspace.path.edition :as edition] + [app.main.data.workspace.path.selection :as selection] + [app.main.data.workspace.path.tools :as tools])) + +;; Drawing +(d/export drawing/handle-new-shape) +(d/export drawing/start-path-from-point) +(d/export drawing/close-path-drag-start) +(d/export drawing/change-edit-mode) + +;; Edition +(d/export edition/start-move-handler) +(d/export edition/start-move-path-point) +(d/export edition/start-path-edit) + +;; Selection +(d/export selection/handle-selection) +(d/export selection/select-node) +(d/export selection/path-handler-enter) +(d/export selection/path-handler-leave) +(d/export selection/path-pointer-enter) +(d/export selection/path-pointer-leave) + +;; Path tools +(d/export tools/make-curve) +(d/export tools/make-corner) +(d/export tools/add-node) +(d/export tools/remove-node) +(d/export tools/merge-nodes) +(d/export tools/join-nodes) +(d/export tools/separate-nodes) +(d/export tools/toggle-snap) + diff --git a/frontend/src/app/main/data/workspace/path/changes.cljs b/frontend/src/app/main/data/workspace/path/changes.cljs new file mode 100644 index 0000000000..84e2de5741 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/changes.cljs @@ -0,0 +1,68 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.changes + (:require + [app.common.spec :as us] + [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.path.helpers :as helpers] + [app.main.data.workspace.path.spec :as spec] + [app.main.data.workspace.path.state :as st] + [beicon.core :as rx] + [potok.core :as ptk])) + +(defn generate-path-changes + "Generates content changes and the undos for the content given" + [page-id shape old-content new-content] + (us/verify ::spec/content old-content) + (us/verify ::spec/content new-content) + (let [shape-id (:id shape) + [old-points old-selrect] (helpers/content->points+selrect shape old-content) + [new-points new-selrect] (helpers/content->points+selrect shape new-content) + + rch [{:type :mod-obj + :id shape-id + :page-id page-id + :operations [{:type :set :attr :content :val new-content} + {:type :set :attr :selrect :val new-selrect} + {:type :set :attr :points :val new-points}]} + {:type :reg-objects + :page-id page-id + :shapes [shape-id]}] + + uch [{:type :mod-obj + :id shape-id + :page-id page-id + :operations [{:type :set :attr :content :val old-content} + {:type :set :attr :selrect :val old-selrect} + {:type :set :attr :points :val old-points}]} + {:type :reg-objects + :page-id page-id + :shapes [shape-id]}]] + [rch uch])) + +(defn save-path-content [] + (ptk/reify ::save-path-content + ptk/UpdateEvent + (update [_ state] + (let [content (get-in state (st/get-path state :content)) + content (if (= (-> content last :command) :move-to) + (into [] (take (dec (count content)) content)) + content)] + (assoc-in state (st/get-path state :content) content))) + + ptk/WatchEvent + (watch [_ state stream] + (let [id (get-in state [:workspace-local :edition]) + old-content (get-in state [:workspace-local :edit-path id :old-content])] + (if (some? old-content) + (let [shape (get-in state (st/get-path state)) + page-id (:current-page-id state) + [rch uch] (generate-path-changes page-id shape old-content (:content shape))] + (rx/of (dwc/commit-changes rch uch {:commit-local? true}))) + (rx/empty)))))) + + diff --git a/frontend/src/app/main/data/workspace/path/common.cljs b/frontend/src/app/main/data/workspace/path/common.cljs new file mode 100644 index 0000000000..d8e6e19cbf --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/common.cljs @@ -0,0 +1,25 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.common + (:require + [app.main.data.workspace.path.state :as st] + [potok.core :as ptk])) + +(defn init-path [] + (ptk/reify ::init-path)) + +(defn clean-edit-state + [state] + (dissoc state :last-point :prev-handler :drag-handler :preview)) + +(defn finish-path [source] + (ptk/reify ::finish-path + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state)] + (-> state + (update-in [:workspace-local :edit-path id] clean-edit-state)))))) diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs new file mode 100644 index 0000000000..f4621fbc83 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -0,0 +1,357 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.drawing + (:require + [app.common.geom.point :as gpt] + [app.common.pages :as cp] + [app.common.spec :as us] + [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.drawing.common :as dwdc] + [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.spec :as spec] + [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.streams :as ms] + [app.util.geom.path :as ugp] + [beicon.core :as rx] + [potok.core :as ptk])) + +(declare change-edit-mode) + +(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? (helpers/position-fixed-angle last-point)) + shape (get-in state (st/get-path state)) + {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) + command (helpers/next-node shape position last-point prev-handler)] + (assoc-in state [:workspace-local :edit-path id :preview] command))))) + +(defn add-node [{:keys [x y shift?]}] + (ptk/reify ::add-node + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state) + fix-angle? shift? + {:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id]) + position (cond-> (gpt/point x y) + fix-angle? (helpers/position-fixed-angle last-point))] + (if-not (= last-point position) + (-> state + (assoc-in [:workspace-local :edit-path id :last-point] position) + (update-in [:workspace-local :edit-path id] dissoc :prev-handler) + (update-in [:workspace-local :edit-path id] dissoc :preview) + (update-in (st/get-path state) helpers/append-node position last-point prev-handler)) + state))))) + +(defn start-drag-handler [] + (ptk/reify ::start-drag-handler + ptk/UpdateEvent + (update [_ state] + (let [content (get-in state (st/get-path state :content)) + index (dec (count content)) + command (get-in state (st/get-path state :content index :command)) + + make-curve + (fn [command] + (let [params (ugp/make-curve-params + (get-in content [index :params]) + (get-in content [(dec index) :params]))] + (-> command + (assoc :command :curve-to :params params))))] + + (cond-> state + (= command :line-to) + (update-in (st/get-path state :content index) make-curve)))))) + +(defn drag-handler [{:keys [x y alt? shift?]}] + (ptk/reify ::drag-handler + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state) + shape (get-in state (st/get-path state)) + content (:content shape) + index (dec (count content)) + node-position (ugp/command->point (nth content index)) + handler-position (cond-> (gpt/point x y) + shift? (helpers/position-fixed-angle node-position)) + {dx :x dy :y} (gpt/subtract handler-position node-position) + match-opposite? (not alt?) + modifiers (helpers/move-handler-modifiers content (inc index) :c1 match-opposite? dx dy)] + (-> state + (update-in [:workspace-local :edit-path id :content-modifiers] merge modifiers) + (assoc-in [:workspace-local :edit-path id :prev-handler] handler-position) + (assoc-in [:workspace-local :edit-path id :drag-handler] handler-position)))))) + +(defn finish-drag [] + (ptk/reify ::finish-drag + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state) + modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) + handler (get-in state [:workspace-local :edit-path id :drag-handler])] + (-> state + (update-in (st/get-path state :content) ugp/apply-content-modifiers modifiers) + (update-in [:workspace-local :edit-path id] dissoc :drag-handler) + (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) + (assoc-in [:workspace-local :edit-path id :prev-handler] handler) + (update-in (st/get-path state) helpers/update-selrect)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state) + handler (get-in state [:workspace-local :edit-path id :prev-handler])] + ;; Update the preview because can be outdated after the dragging + (rx/of (preview-next-point handler)))))) + +(declare close-path-drag-end) + +(defn close-path-drag-start [position] + (ptk/reify ::close-path-drag-start + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state) + zoom (get-in state [:workspace-local :zoom]) + start-position @ms/mouse-position + + stop-stream + (->> stream (rx/filter #(or (helpers/end-path-event? %) + (ms/mouse-up? %)))) + + content (get-in state (st/get-path state :content)) + snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) + points (ugp/content->points content) + + drag-events-stream + (->> (streams/position-stream snap-toggled points) + (rx/take-until stop-stream) + (rx/map #(drag-handler %)))] + + (rx/concat + (rx/of (add-node position)) + (streams/drag-stream + (rx/concat + (rx/of (start-drag-handler)) + drag-events-stream + (rx/of (finish-drag)) + (rx/of (close-path-drag-end)))) + (rx/of (common/finish-path "close-path"))))))) + +(defn close-path-drag-end [] + (ptk/reify ::close-path-drag-end + ptk/UpdateEvent + (update [_ state] + (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 [start-point @ms/mouse-position + zoom (get-in state [:workspace-local :zoom]) + mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %) + (ms/mouse-up? %)))) + content (get-in state (st/get-path state :content)) + points (ugp/content->points content) + + id (st/get-path-id state) + snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) + + drag-events (->> (streams/position-stream snap-toggled points) + (rx/take-until mouse-up) + (rx/map #(drag-handler %)))] + + (rx/concat + (rx/of (add-node position)) + (streams/drag-stream + (rx/concat + (rx/of (start-drag-handler)) + 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)))) + +(defn make-drag-stream + [stream snap-toggled zoom points down-event] + (let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %) + (ms/mouse-up? %)))) + + drag-events (->> (streams/position-stream snap-toggled points) + (rx/take-until mouse-up) + (rx/map #(drag-handler %)))] + + (rx/concat + (rx/of (add-node down-event)) + (streams/drag-stream + (rx/concat + (rx/of (start-drag-handler)) + drag-events + (rx/of (finish-drag))))))) + +(defn handle-drawing-path + [id] + (ptk/reify ::handle-drawing-path + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state)] + (-> state + (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [zoom (get-in state [:workspace-local :zoom]) + mouse-down (->> stream (rx/filter ms/mouse-down?)) + end-path-events (->> stream (rx/filter helpers/end-path-event?)) + + content (get-in state (st/get-path state :content)) + points (ugp/content->points content) + + id (st/get-path-id state) + snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) + + ;; Mouse move preview + mousemove-events + (->> (streams/position-stream snap-toggled points) + (rx/take-until end-path-events) + (rx/map #(preview-next-point %))) + + ;; From mouse down we can have: click, drag and double click + mousedown-events + (->> mouse-down + (rx/take-until end-path-events) + (rx/with-latest merge (streams/position-stream snap-toggled points)) + + ;; We change to the stream that emits the first event + (rx/switch-map + #(rx/race (make-node-events-stream stream) + (make-drag-stream stream snap-toggled zoom points %))))] + + (rx/concat + (rx/of (common/init-path)) + (rx/merge mousemove-events + mousedown-events) + (rx/of (common/finish-path "after-events"))))))) + + +(defn setup-frame-path [] + (ptk/reify ::setup-frame-path + ptk/UpdateEvent + (update [_ state] + (let [objects (dwc/lookup-page-objects state) + content (get-in state [:workspace-drawing :object :content] []) + position (get-in content [0 :params] nil) + frame-id (cp/frame-id-by-position objects position)] + (-> state + (assoc-in [:workspace-drawing :object :frame-id] frame-id)))))) + +(defn handle-new-shape-result [shape-id] + (ptk/reify ::handle-new-shape-result + ptk/UpdateEvent + (update [_ state] + (let [content (get-in state [:workspace-drawing :object :content] [])] + (us/verify ::spec/content content) + (if (> (count content) 1) + (assoc-in state [:workspace-drawing :object :initialized?] true) + state))) + + ptk/WatchEvent + (watch [_ state stream] + (->> (rx/of (setup-frame-path) + dwdc/handle-finish-drawing + (dwc/start-edition-mode shape-id) + (change-edit-mode :draw)))))) + +(defn handle-new-shape + "Creates a new path shape" + [] + (ptk/reify ::handle-new-shape + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state)] + (-> state + (assoc-in [:workspace-local :edit-path id :snap-toggled] true)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [shape-id (get-in state [:workspace-drawing :object :id])] + (rx/concat + (rx/of (handle-drawing-path shape-id)) + (->> stream + (rx/filter (ptk/type? ::common/finish-path)) + (rx/take 1) + (rx/observe-on :async) + (rx/map #(handle-new-shape-result shape-id)))))))) + +(declare check-changed-content) + +(defn start-draw-mode [] + (ptk/reify ::start-draw-mode + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition]) + page-id (:current-page-id state) + old-content (get-in state [:workspace-data :pages-index page-id :objects id :content])] + (-> state + (assoc-in [:workspace-local :edit-path id :old-content] old-content)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [id (get-in state [:workspace-local :edition]) + edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])] + (if (= :draw edit-mode) + (rx/concat + (rx/of (handle-drawing-path id)) + (->> stream + (rx/filter (ptk/type? ::common/finish-path)) + (rx/take 1) + (rx/merge-map #(rx/of (check-changed-content))))) + (rx/empty)))))) + +(defn check-changed-content [] + (ptk/reify ::check-changed-content + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state) + content (get-in state (st/get-path state :content)) + old-content (get-in state [:workspace-local :edit-path id :old-content]) + mode (get-in state [:workspace-local :edit-path id :edit-mode])] + + (cond + (not= content old-content) (rx/of (changes/save-path-content) + (start-draw-mode)) + (= mode :draw) (rx/of :interrupt) + :else (rx/of (common/finish-path "changed-content"))))))) + +(defn change-edit-mode [mode] + (ptk/reify ::change-edit-mode + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition])] + (cond-> state + id (assoc-in [:workspace-local :edit-path id :edit-mode] mode)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state)] + (cond + (and id (= :move mode)) (rx/of (common/finish-path "change-edit-mode")) + (and id (= :draw mode)) (rx/of (start-draw-mode)) + :else (rx/empty)))))) diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs new file mode 100644 index 0000000000..0d07756ba2 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -0,0 +1,236 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.edition + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.math :as mth] + [app.main.data.workspace.common :as dwc] + [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.selection :as selection] + [app.main.data.workspace.path.state :as st] + [app.main.data.workspace.path.streams :as streams] + [app.main.data.workspace.path.drawing :as drawing] + [app.main.streams :as ms] + [app.util.geom.path :as ugp] + [beicon.core :as rx] + [potok.core :as ptk])) + +(defn modify-point [index prefix dx dy] + (ptk/reify ::modify-point + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition]) + [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])] + (-> state + (update-in [:workspace-local :edit-path id :content-modifiers (inc index)] assoc + :c1x dx :c1y dy) + (update-in [:workspace-local :edit-path id :content-modifiers index] assoc + :x dx :y dy :c2x dx :c2y dy)))))) + +(defn modify-handler [id index prefix dx dy match-opposite?] + (ptk/reify ::modify-handler + ptk/UpdateEvent + (update [_ state] + (let [content (get-in state (st/get-path state :content)) + [cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) + [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) + point (gpt/point (+ (get-in content [index :params cx]) dx) + (+ (get-in content [index :params cy]) dy)) + opposite-index (ugp/opposite-index content index prefix)] + (cond-> state + :always + (-> (update-in [:workspace-local :edit-path id :content-modifiers index] assoc + cx dx cy dy) + (assoc-in [:workspace-local :edit-path id :moving-handler] point)) + + (and match-opposite? opposite-index) + (update-in [:workspace-local :edit-path id :content-modifiers opposite-index] assoc + ocx (- dx) ocy (- dy))))))) + +(defn apply-content-modifiers [] + (ptk/reify ::apply-content-modifiers + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state) + page-id (:current-page-id state) + shape (get-in state (st/get-path state)) + content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) + + content (:content shape) + new-content (ugp/apply-content-modifiers content content-modifiers) + + old-points (->> content ugp/content->points) + new-points (->> new-content ugp/content->points) + point-change (->> (map hash-map old-points new-points) (reduce merge)) + + [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)] + + (rx/of (dwc/commit-changes rch uch {:commit-local? true}) + (selection/update-selection point-change) + (fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers :moving-nodes :moving-handler))))))) + +(defn move-selected-path-point [from-point to-point] + (letfn [(modify-content-point [content {dx :x dy :y} modifiers point] + (let [point-indices (ugp/point-indices content point) ;; [indices] + handler-indices (ugp/handler-indices content point) ;; [[index prefix]] + + modify-point + (fn [modifiers index] + (-> modifiers + (update index assoc :x dx :y dy))) + + modify-handler + (fn [modifiers [index prefix]] + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (-> modifiers + (update index assoc cx dx cy dy))))] + + (as-> modifiers $ + (reduce modify-point $ point-indices) + (reduce modify-handler $ handler-indices))))] + + (ptk/reify ::move-point + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state) + content (get-in state (st/get-path state :content)) + delta (gpt/subtract to-point from-point) + + modifiers-reducer (partial modify-content-point content delta) + + points (get-in state [:workspace-local :edit-path id :selected-points] #{}) + + modifiers (get-in state [:workspace-local :edit-path id :content-modifiers] {}) + modifiers (->> points + (reduce modifiers-reducer {}))] + + (-> state + (assoc-in [:workspace-local :edit-path id :moving-nodes] true) + (assoc-in [:workspace-local :edit-path id :content-modifiers] modifiers))))))) + +(declare drag-selected-points) + +(defn start-move-path-point + [position shift?] + (ptk/reify ::start-move-path-point + ptk/WatchEvent + (watch [_ state stream] + (let [id (get-in state [:workspace-local :edition]) + selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) + selected? (contains? selected-points position)] + (streams/drag-stream + (rx/of + (when-not selected? (selection/select-node position shift? "drag")) + (drag-selected-points @ms/mouse-position)) + (rx/of (selection/select-node position shift? "click"))))))) + +(defn drag-selected-points + [start-position] + (ptk/reify ::drag-selected-points + ptk/WatchEvent + (watch [_ state stream] + (let [stopper (->> stream (rx/filter ms/mouse-up?)) + zoom (get-in state [:workspace-local :zoom]) + id (get-in state [:workspace-local :edition]) + snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) + + selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) + + content (get-in state (st/get-path state :content)) + points (ugp/content->points content)] + + (rx/concat + ;; This stream checks the consecutive mouse positions to do the draging + (->> points + (streams/move-points-stream snap-toggled start-position selected-points) + (rx/take-until stopper) + (rx/map #(move-selected-path-point start-position %))) + (rx/of (apply-content-modifiers))))))) + +(defn start-move-handler + [index prefix] + (ptk/reify ::start-move-handler + ptk/WatchEvent + (watch [_ state stream] + (let [id (get-in state [:workspace-local :edition]) + cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y) + start-point @ms/mouse-position + modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) + start-delta-x (get-in modifiers [index cx] 0) + start-delta-y (get-in modifiers [index cy] 0) + + content (get-in state (st/get-path state :content)) + points (ugp/content->points content) + + opposite-index (ugp/opposite-index content index prefix) + opposite-prefix (if (= prefix :c1) :c2 :c1) + opposite-handler (-> content (get opposite-index) (ugp/get-handler opposite-prefix)) + + point (-> content (get (if (= prefix :c1) (dec index) index)) (ugp/command->point)) + handler (-> content (get index) (ugp/get-handler prefix)) + + current-distance (when opposite-handler (gpt/distance (ugp/opposite-handler point handler) opposite-handler)) + match-opposite? (and opposite-handler (mth/almost-zero? current-distance)) + snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])] + + (streams/drag-stream + (rx/concat + (->> (streams/move-handler-stream snap-toggled start-point handler points) + (rx/take-until (->> stream (rx/filter ms/mouse-up?))) + (rx/map + (fn [{:keys [x y alt? shift?]}] + (let [pos (cond-> (gpt/point x y) + shift? (helpers/position-fixed-angle point))] + (modify-handler + id + index + prefix + (+ start-delta-x (- (:x pos) (:x start-point))) + (+ start-delta-y (- (:y pos) (:y start-point))) + (and (not alt?) match-opposite?)))))) + (rx/concat (rx/of (apply-content-modifiers))))))))) + +(declare stop-path-edit) + +(defn start-path-edit + [id] + (ptk/reify ::start-path-edit + ptk/UpdateEvent + (update [_ state] + (let [edit-path (get-in state [:workspace-local :edit-path id])] + + (cond-> state + (or (not edit-path) (= :draw (:edit-mode edit-path))) + (assoc-in [:workspace-local :edit-path id] {:edit-mode :move + :selected #{} + :snap-toggled true}) + + (and (some? edit-path) (= :move (:edit-mode edit-path))) + (assoc-in [:workspace-local :edit-path id :edit-mode] :draw)))) + + ptk/WatchEvent + (watch [_ state stream] + (let [mode (get-in state [:workspace-local :edit-path id :edit-mode])] + (rx/concat + (rx/of (drawing/change-edit-mode mode)) + (->> stream + (rx/take-until (->> stream (rx/filter (ptk/type? ::start-path-edit)))) + (rx/filter #(= % :interrupt)) + (rx/take 1) + (rx/map #(stop-path-edit)))))))) + +(defn stop-path-edit [] + (ptk/reify ::stop-path-edit + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition])] + (update state :workspace-local dissoc :edit-path id))))) diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs new file mode 100644 index 0000000000..0fe040d426 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/helpers.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) UXBOX Labs SL + +(ns app.main.data.workspace.path.helpers + (:require + [app.common.data :as d] + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.shapes :as gsh] + [app.common.math :as mth] + [app.main.data.workspace.path.state :refer [get-path]] + [app.main.data.workspace.path.common :as common] + [app.main.streams :as ms] + [app.util.geom.path :as ugp] + [potok.core :as ptk])) + +;; CONSTANTS +(defonce enter-keycode 13) + +(defn end-path-event? [{:keys [type shift] :as event}] + (or (= (ptk/type event) ::common/finish-path) + (= (ptk/type event) :esc-pressed) + (= event :interrupt) ;; ESC + (and (ms/mouse-double-click? event)))) + +(defn content->points+selrect + "Given the content of a shape, calculate its points and selrect" + [shape content] + (let [transform (:transform shape (gmt/matrix)) + transform-inverse (:transform-inverse shape (gmt/matrix)) + center (gsh/center-shape shape) + base-content (gsh/transform-content + content + (gmt/transform-in center transform-inverse)) + + ;; Calculates the new selrect with points given the old center + points (-> (gsh/content->selrect base-content) + (gsh/rect->points) + (gsh/transform-points center (:transform shape (gmt/matrix)))) + + points-center (gsh/center-points points) + + ;; Points is now the selrect but the center is different so we can create the selrect + ;; through points + selrect (-> points + (gsh/transform-points points-center (:transform-inverse shape (gmt/matrix))) + (gsh/points->selrect))] + [points selrect])) + +(defn update-selrect + "Updates the selrect and points for a path" + [shape] + (if (= (:rotation shape 0) 0) + (let [content (:content shape) + selrect (gsh/content->selrect content) + points (gsh/rect->points selrect)] + (assoc shape :points points :selrect selrect)) + + (let [content (:content shape) + [points selrect] (content->points+selrect shape content)] + (assoc shape :points points :selrect selrect)))) + + +(defn closest-angle + [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)) + +(defn position-fixed-angle [point from-point] + (if (and from-point point) + (let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360) + to-angle (closest-angle angle) + distance (gpt/distance point from-point)] + (gpt/angle->point from-point (mth/radians to-angle) distance)) + point)) + +(defn next-node + "Calculates the next-node to be inserted." + [shape position prev-point prev-handler] + (let [last-command (-> shape :content last :command) + add-line? (and prev-point (not prev-handler) (not= last-command :close-path)) + add-curve? (and prev-point prev-handler (not= last-command :close-path))] + (cond + add-line? {:command :line-to + :params position} + add-curve? {:command :curve-to + :params (ugp/make-curve-params position prev-handler)} + :else {:command :move-to + :params position}))) + +(defn append-node + "Creates a new node in the path. Usualy used when drawing." + [shape position prev-point prev-handler] + (let [command (next-node shape position prev-point prev-handler)] + (-> shape + (update :content (fnil conj []) command) + (update-selrect)))) + +(defn move-handler-modifiers + [content index prefix match-opposite? dx dy] + (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) + [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) + opposite-index (ugp/opposite-index content index prefix)] + + (cond-> {} + :always + (update index assoc cx dx cy dy) + + (and match-opposite? opposite-index) + (update opposite-index assoc ocx (- dx) ocy (- dy))))) diff --git a/frontend/src/app/main/data/workspace/path/selection.cljs b/frontend/src/app/main/data/workspace/path/selection.cljs new file mode 100644 index 0000000000..903954da38 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/selection.cljs @@ -0,0 +1,167 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.selection + (:require + [app.common.geom.point :as gpt] + [app.common.geom.shapes :as gsh] + [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.path.state :as st] + [app.main.streams :as ms] + [beicon.core :as rx] + [potok.core :as ptk])) + +(defn path-pointer-enter [position] + (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))))) + +(defn path-pointer-leave [position] + (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))))) + +(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]))))) + +(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]))))) + +(defn select-node-area [shift?] + (ptk/reify ::select-node-area + ptk/UpdateEvent + (update [_ state] + (let [selrect (get-in state [:workspace-local :selrect]) + id (get-in state [:workspace-local :edition]) + content (get-in state (st/get-path state :content)) + selected-point? #(gsh/has-point-rect? selrect %) + + selected-points (get-in state [:workspace-local :edit-path id :selected-points]) + + positions (into (if shift? selected-points #{}) + (comp (map (comp gpt/point :params)) + (filter selected-point?)) + content)] + (cond-> state + (some? id) + (assoc-in [:workspace-local :edit-path id :selected-points] positions)))))) + +(defn select-node [position shift? kk] + (ptk/reify ::select-node + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition]) + selected-points (or (get-in state [:workspace-local :edit-path id :selected-points]) #{}) + selected-points (cond + (and shift? (contains? selected-points position)) + (disj selected-points position) + + shift? + (conj selected-points position) + + :else + #{position})] + (cond-> state + (some? id) + (assoc-in [:workspace-local :edit-path id :selected-points] selected-points)))))) + +(defn deselect-node [position shift?] + (ptk/reify ::deselect-node + ptk/UpdateEvent + (update [_ state] + (let [id (get-in state [:workspace-local :edition])] + (-> state + (update-in [:workspace-local :edit-path id :selected-points] (fnil disj #{}) position)))))) + +(defn add-to-selection-handler [index type] + (ptk/reify ::add-to-selection-handler + ptk/UpdateEvent + (update [_ state] + state))) + +(defn add-to-selection-node [index] + (ptk/reify ::add-to-selection-node + ptk/UpdateEvent + (update [_ state] + state))) + +(defn remove-from-selection-handler [index] + (ptk/reify ::remove-from-selection-handler + ptk/UpdateEvent + (update [_ state] + state))) + +(defn remove-from-selection-node [index] + (ptk/reify ::remove-from-selection-handler + ptk/UpdateEvent + (update [_ state] + state))) + +(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] #{})))))) + +(defn update-area-selection + [rect] + (ptk/reify ::update-area-selection + ptk/UpdateEvent + (update [_ state] + (assoc-in state [:workspace-local :selrect] rect)))) + +(defn clear-area-selection + [] + (ptk/reify ::clear-area-selection + ptk/UpdateEvent + (update [_ state] + (update state :workspace-local dissoc :selrect)))) + +(defn handle-selection + [shift?] + (letfn [(valid-rect? [{width :width height :height}] + (or (> width 10) (> height 10)))] + + (ptk/reify ::handle-selection + ptk/WatchEvent + (watch [_ state stream] + (let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event))) + stoper (->> stream (rx/filter stop?)) + from-p @ms/mouse-position] + (rx/concat + (->> ms/mouse-position + (rx/take-until stoper) + (rx/map #(gsh/points->rect [from-p %])) + (rx/filter valid-rect?) + (rx/map update-area-selection)) + + (rx/of (select-node-area shift?) + (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 (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/spec.cljs b/frontend/src/app/main/data/workspace/path/spec.cljs new file mode 100644 index 0000000000..96ad24fa0a --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/spec.cljs @@ -0,0 +1,49 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.spec + (:require + [clojure.spec.alpha :as s])) + +;; SCHEMAS + +(s/def ::command #{:move-to + :line-to + :line-to-horizontal + :line-to-vertical + :curve-to + :smooth-curve-to + :quadratic-bezier-curve-to + :smooth-quadratic-bezier-curve-to + :elliptical-arc + :close-path}) + +(s/def :paths.params/x number?) +(s/def :paths.params/y number?) +(s/def :paths.params/c1x number?) +(s/def :paths.params/c1y number?) +(s/def :paths.params/c2x number?) +(s/def :paths.params/c2y number?) + +(s/def ::relative? boolean?) + +(s/def ::params + (s/keys :req-un [:path.params/x + :path.params/y] + :opt-un [:path.params/c1x + :path.params/c1y + :path.params/c2x + :path.params/c2y])) + +(s/def ::content-entry + (s/keys :req-un [::command] + :req-opt [::params + ::relative?])) +(s/def ::content + (s/coll-of ::content-entry :kind vector?)) + + + diff --git a/frontend/src/app/main/data/workspace/path/state.cljs b/frontend/src/app/main/data/workspace/path/state.cljs new file mode 100644 index 0000000000..6bb59c4c64 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/state.cljs @@ -0,0 +1,29 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.state + (:require + [app.common.data :as d])) + +(defn get-path-id + "Retrieves the currently editing path id" + [state] + (or (get-in state [:workspace-local :edition]) + (get-in state [:workspace-drawing :object :id]))) + +(defn get-path + "Retrieves the location of the path object and additionaly can pass + the arguments. This location can be used in get-in, assoc-in... functions" + [state & path] + (let [edit-id (get-in state [:workspace-local :edition]) + page-id (:current-page-id state)] + (d/concat + (if edit-id + [:workspace-data :pages-index page-id :objects edit-id] + [:workspace-drawing :object]) + path))) + + diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs new file mode 100644 index 0000000000..f7c7a83c22 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/streams.cljs @@ -0,0 +1,118 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.streams + (:require + [app.main.data.workspace.path.helpers :as helpers] + [app.main.data.workspace.path.state :as state] + [app.common.geom.point :as gpt] + [app.main.store :as st] + [app.main.streams :as ms] + [beicon.core :as rx] + [potok.core :as ptk] + [app.common.math :as mth] + [app.main.snap :as snap] + [okulary.core :as l] + [app.util.geom.path :as ugp])) + +(defonce drag-threshold 5) + +(defn dragging? [start zoom] + (fn [current] + (>= (gpt/distance start current) (/ drag-threshold zoom)))) + +(defn drag-stream + ([to-stream] + (drag-stream to-stream (rx/empty))) + + ([to-stream not-drag-stream] + (let [start @ms/mouse-position + zoom (get-in @st/state [:workspace-local :zoom] 1) + mouse-up (->> st/stream (rx/filter #(ms/mouse-up? %))) + + position-stream + (->> ms/mouse-position + (rx/take-until mouse-up) + (rx/filter (dragging? start zoom)) + (rx/take 1))] + + (rx/merge + (->> position-stream + (rx/if-empty ::empty) + (rx/merge-map (fn [value] + (if (= value ::empty) + not-drag-stream + (rx/empty))))) + + (->> position-stream + (rx/merge-map (fn [] to-stream))))))) + +(defn to-dec [num] + (let [k 50] + (* (mth/floor (/ num k)) k))) + +(defn move-points-stream + [snap-toggled start-point selected-points points] + + (let [zoom (get-in @st/state [:workspace-local :zoom] 1) + ranges (snap/create-ranges points selected-points) + d-pos (/ snap/snap-path-accuracy zoom) + + check-path-snap + (fn [position] + (if snap-toggled + (let [delta (gpt/subtract position start-point) + moved-points (->> selected-points (mapv #(gpt/add % delta))) + snap (snap/get-snap-delta moved-points ranges d-pos)] + (gpt/add position snap)) + position))] + (->> ms/mouse-position + (rx/map check-path-snap)))) + +(defn move-handler-stream + [snap-toggled start-point handler points] + + (let [zoom (get-in @st/state [:workspace-local :zoom] 1) + ranges (snap/create-ranges points) + d-pos (/ snap/snap-path-accuracy zoom) + + check-path-snap + (fn [position] + (if snap-toggled + (let [delta (gpt/subtract position start-point) + handler-position (gpt/add handler delta) + snap (snap/get-snap-delta [handler-position] ranges d-pos)] + (gpt/add position snap)) + position))] + (->> ms/mouse-position + (rx/map check-path-snap)))) + +(defn position-stream + [snap-toggled points] + (let [zoom (get-in @st/state [:workspace-local :zoom] 1) + ;; ranges (snap/create-ranges points) + d-pos (/ snap/snap-path-accuracy zoom) + get-content (fn [state] (get-in state (state/get-path state :content))) + + content-stream + (-> (l/derived get-content st/state) + (rx/from-atom {:emit-current-value? true})) + + ranges-stream + (->> content-stream + (rx/map ugp/content->points) + (rx/map snap/create-ranges))] + + (->> ms/mouse-position + (rx/with-latest vector ranges-stream) + (rx/map (fn [[position ranges]] + (if snap-toggled + (let [snap (snap/get-snap-delta [position] ranges d-pos)] + (gpt/add position snap)) + position))) + + (rx/with-latest merge (->> ms/mouse-position-shift (rx/map #(hash-map :shift? %)))) + (rx/with-latest merge (->> ms/mouse-position-alt (rx/map #(hash-map :alt? %))))))) diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs new file mode 100644 index 0000000000..90ea6a1913 --- /dev/null +++ b/frontend/src/app/main/data/workspace/path/tools.cljs @@ -0,0 +1,62 @@ +;; 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) UXBOX Labs SL + +(ns app.main.data.workspace.path.tools + (:require + [app.main.data.workspace.common :as dwc] + [app.main.data.workspace.path.changes :as changes] + [app.main.data.workspace.path.common :as common] + [app.main.data.workspace.path.state :as st] + [app.util.geom.path :as ugp] + [app.common.geom.point :as gpt] + [beicon.core :as rx] + [potok.core :as ptk])) + +(defn process-path-tool + "Generic function that executes path transformations with the content and selected nodes" + [tool-fn] + (ptk/reify ::process-path-tool + ptk/WatchEvent + (watch [_ state stream] + (let [id (st/get-path-id state) + page-id (:current-page-id state) + shape (get-in state (st/get-path state)) + selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) + new-content (tool-fn (:content shape) selected-points) + [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)] + (rx/of (dwc/commit-changes rch uch {:commit-local? true})))))) + +(defn make-corner [] + (process-path-tool + (fn [content points] + (reduce ugp/make-corner-point content points)))) + +(defn make-curve [] + (process-path-tool + (fn [content points] + (reduce ugp/make-curve-point content points)))) + +(defn add-node [] + (process-path-tool (fn [content points] (ugp/split-segments content points 0.5)))) + +(defn remove-node [] + (process-path-tool ugp/remove-nodes)) + +(defn merge-nodes [] + (process-path-tool ugp/merge-nodes)) + +(defn join-nodes [] + (process-path-tool ugp/join-nodes)) + +(defn separate-nodes [] + (process-path-tool ugp/separate-nodes)) + +(defn toggle-snap [] + (ptk/reify ::toggle-snap + ptk/UpdateEvent + (update [_ state] + (let [id (st/get-path-id state)] + (update-in state [:workspace-local :edit-path id :snap-toggled] not))))) diff --git a/frontend/src/app/main/data/workspace/selection.cljs b/frontend/src/app/main/data/workspace/selection.cljs index 8761f0a673..6812a5a9fa 100644 --- a/frontend/src/app/main/data/workspace/selection.cljs +++ b/frontend/src/app/main/data/workspace/selection.cljs @@ -60,9 +60,8 @@ (ptk/reify ::handle-selection ptk/WatchEvent (watch [_ state stream] - (let [stoper (rx/filter #(or (dwc/interrupt? %) - (ms/mouse-up? %)) - stream)] + (let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event))) + stoper (->> stream (rx/filter stop?))] (rx/concat (when-not preserve? (rx/of (deselect-all))) diff --git a/frontend/src/app/main/snap.cljs b/frontend/src/app/main/snap.cljs index e82c67f000..3e7ebd8709 100644 --- a/frontend/src/app/main/snap.cljs +++ b/frontend/src/app/main/snap.cljs @@ -15,10 +15,12 @@ [app.main.refs :as refs] [app.main.worker :as uw] [app.util.geom.snap-points :as sp] + [app.util.range-tree :as rt] [beicon.core :as rx] [clojure.set :as set])) (defonce ^:private snap-accuracy 5) +(defonce ^:private snap-path-accuracy 10) (defonce ^:private snap-distance-accuracy 10) (defn- remove-from-snap-points @@ -240,3 +242,92 @@ (rx/reduce gpt/min) (rx/map #(or % (gpt/point 0 0)))))) + +;;; PATH SNAP + +(defn create-ranges + ([points] + (create-ranges points #{})) + + ([points selected-points] + (let [selected-points (or selected-points #{}) + + into-tree + (fn [coord] + (fn [tree point] + (rt/insert tree (get point coord) point))) + + make-ranges + (fn [coord] + (->> points + (filter (comp not selected-points)) + (reduce (into-tree coord) (rt/make-tree))))] + + {:x (make-ranges :x) + :y (make-ranges :y)}))) + +(defn query-delta-point [ranges point precision] + (let [query-coord + (fn [point coord] + (let [pval (get point coord)] + (->> (rt/range-query (get ranges coord) (- pval precision) (+ pval precision)) + ;; We save the distance to the point and add the matching point to the points + (mapv (fn [[value points]] + [(- value pval) + (->> points (mapv #(vector point %)))])))))] + {:x (query-coord point :x) + :y (query-coord point :y)})) + +(defn merge-matches + ([] {:x nil :y nil}) + ([matches other] + (let [merge-coord + (fn [matches other] + + (let [matches (into {} matches) + other (into {} other) + keys (set/union (keys matches) (keys other))] + (into {} + (map (fn [key] + [key + (d/concat [] (get matches key []) (get other key []))])) + keys)))] + + (-> matches + (update :x merge-coord (:x other)) + (update :y merge-coord (:y other)))))) + +(defn min-match + [default matches] + (let [get-min + (fn [[cur-val :as current] [other-val :as other]] + (if (< (mth/abs cur-val) (mth/abs other-val)) + current + other)) + + min-match-coord + (fn [matches] + (if (and (seq matches) (not (empty? matches))) + (->> matches (reduce get-min)) + default))] + + (-> matches + (update :x min-match-coord) + (update :y min-match-coord)))) + +(defn get-snap-delta-match + [points ranges accuracy] + (assert vector? points) + + (->> points + (mapv #(query-delta-point ranges % accuracy)) + (reduce merge-matches) + (min-match [0 nil]))) + +(defn get-snap-delta + [points ranges accuracy] + (-> (get-snap-delta-match points ranges accuracy) + (update :x first) + (update :y first) + (gpt/point))) + diff --git a/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs b/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs deleted file mode 100644 index 94b98119cf..0000000000 --- a/frontend/src/app/main/ui/workspace/shapes/path/actions.cljs +++ /dev/null @@ -1,44 +0,0 @@ -;; 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) UXBOX Labs SL - -(ns app.main.ui.workspace.shapes.path.actions - (:require - [app.main.data.workspace.drawing.path :as drp] - [app.main.refs :as refs] - [app.main.store :as st] - [app.main.ui.icons :as i] - [app.main.ui.workspace.shapes.path.common :as pc] - [rumext.alpha :as mf])) - -(mf/defc path-actions [{:keys [shape]}] - (let [id (mf/deref refs/selected-edition) - {:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref)] - [:div.path-actions - [:div.viewport-actions-group - [:div.viewport-actions-entry {:class (when (= edit-mode :draw) "is-toggled") - :on-click #(st/emit! (drp/change-edit-mode :draw))} i/pen] - [:div.viewport-actions-entry {:class (when (= edit-mode :move) "is-toggled") - :on-click #(st/emit! (drp/change-edit-mode :move))} i/pointer-inner]] - - #_[:div.viewport-actions-group - [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-add] - [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-remove]] - - #_[:div.viewport-actions-group - [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-merge] - [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-join] - [:div.viewport-actions-entry {:class "is-disabled"} i/nodes-separate]] - - [:div.viewport-actions-group - [:div.viewport-actions-entry {:class (when (empty? selected-points) "is-disabled") - :on-click #(when-not (empty? selected-points) - (st/emit! (drp/make-corner)))} i/nodes-corner] - [:div.viewport-actions-entry {:class (when (empty? selected-points) "is-disabled") - :on-click #(when-not (empty? selected-points) - (st/emit! (drp/make-curve)))} i/nodes-curve]] - - #_[:div.viewport-actions-group - [:div.viewport-actions-entry {:class (when snap-toggled "is-toggled")} i/nodes-snap]]])) 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 494761da8c..150e66b312 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs @@ -8,12 +8,18 @@ (:require [app.common.data :as d] [app.common.geom.point :as gpt] - [app.main.data.workspace.drawing.path :as drp] + [app.common.geom.shapes.path :as gshp] + [app.main.data.workspace.path :as drp] + [app.main.snap :as snap] [app.main.store :as st] + [app.main.streams :as ms] [app.main.ui.cursors :as cur] + [app.main.ui.hooks :as hooks] [app.main.ui.workspace.shapes.path.common :as pc] [app.util.dom :as dom] [app.util.geom.path :as ugp] + [app.util.keyboard :as kbd] + [clojure.set :refer [map-invert]] [goog.events :as events] [rumext.alpha :as mf]) (:import goog.events.EventType)) @@ -29,29 +35,16 @@ (fn [event] (st/emit! (drp/path-pointer-leave position))) - on-click - (fn [event] - (when-not last-p? - (dom/stop-propagation event) - (dom/prevent-default event) - - (cond - (and (= edit-mode :move) (not selected?)) - (st/emit! (drp/select-node position)) - - (and (= edit-mode :move) selected?) - (st/emit! (drp/deselect-node position))))) - - on-mouse-down (fn [event] - (when-not last-p? - (dom/stop-propagation event) - (dom/prevent-default event) + (dom/stop-propagation event) + (dom/prevent-default event) + (let [shift? (kbd/shift? event)] (cond (= edit-mode :move) - (st/emit! (drp/start-move-path-point position)) + ;; If we're dragging a selected item we don't change the selection + (st/emit! (drp/start-move-path-point position shift?)) (and (= edit-mode :draw) start-path?) (st/emit! (drp/start-path-from-point position)) @@ -73,12 +66,12 @@ [:circle {:cx x :cy y :r (/ 10 zoom) - :on-click on-click :on-mouse-down on-mouse-down :on-mouse-enter on-enter :on-mouse-leave on-leave - :style {:cursor (cond - (and (not last-p?) (= edit-mode :draw)) cur/pen-node + :style {:pointer-events (when last-p? "none") + :cursor (cond + (= edit-mode :draw) cur/pen-node (= edit-mode :move) cur/pointer-node) :fill "transparent"}}]])) @@ -93,14 +86,6 @@ (fn [event] (st/emit! (drp/path-handler-leave index prefix))) - on-click - (fn [event] - (dom/stop-propagation event) - (dom/prevent-default event) - (cond - (= edit-mode :move) - (drp/select-handler index prefix))) - on-mouse-down (fn [event] (dom/stop-propagation event) @@ -132,7 +117,6 @@ [:circle {:cx x :cy y :r (/ 10 zoom) - :on-click on-click :on-mouse-down on-mouse-down :on-mouse-enter on-enter :on-mouse-leave on-leave @@ -143,8 +127,9 @@ [:g.preview {:style {:pointer-events "none"}} (when (not= :move-to (:command command)) [:path {:style {:fill "transparent" - :stroke pc/secondary-color - :stroke-width (/ 1 zoom)} + :stroke pc/black-color + :stroke-width (/ 1 zoom) + :stroke-dasharray (/ 4 zoom)} :d (ugp/content->path [{:command :move-to :params {:x (:x from) :y (:y from)}} @@ -153,37 +138,68 @@ :preview? true :zoom zoom}]]) +(mf/defc path-snap [{:keys [selected points zoom]}] + (let [ranges (mf/use-memo (mf/deps selected points) #(snap/create-ranges points selected)) + snap-matches (snap/get-snap-delta-match selected ranges (/ 1 zoom)) + matches (d/concat [] (second (:x snap-matches)) (second (:y snap-matches)))] + + [:g.snap-paths + (for [[from to] matches] + [:line {:x1 (:x from) + :y1 (:y from) + :x2 (:x to) + :y2 (:y to) + :style {:stroke pc/secondary-color + :stroke-width (/ 1 zoom)}}])])) + (mf/defc path-editor [{:keys [shape zoom]}] (let [editor-ref (mf/use-ref nil) edit-path-ref (pc/make-edit-path-ref (:id shape)) + hover-point (mf/use-state nil) + {:keys [edit-mode drag-handler prev-handler preview content-modifiers last-point - selected-handlers selected-points + moving-nodes + moving-handler hover-handlers - hover-points] + hover-points + snap-toggled] :as edit-path} (mf/deref edit-path-ref) - {:keys [content]} shape - content (ugp/apply-content-modifiers content content-modifiers) - points (->> content ugp/content->points (into #{})) + selected-points (or selected-points #{}) + + base-content (:content shape) + base-points (mf/use-memo (mf/deps base-content) #(->> base-content ugp/content->points)) + + content (ugp/apply-content-modifiers base-content content-modifiers) + content-points (mf/use-memo (mf/deps content) #(->> content ugp/content->points)) + + point->base (->> (map hash-map content-points base-points) (reduce merge)) + base->point (map-invert point->base) + + points (into #{} content-points) + last-command (last content) last-p (->> content last ugp/command->point) handlers (ugp/content->handlers content) - handle-click-outside - (fn [event] - (let [current (dom/get-target event) - editor-dom (mf/ref-val editor-ref)] - (when-not (or (.contains editor-dom current) - (dom/class? current "viewport-actions-entry")) - (st/emit! (drp/deselect-all))))) + [snap-selected snap-points] + (cond + (some? drag-handler) [#{drag-handler} points] + (some? preview) [#{(ugp/command->point preview)} points] + (some? moving-handler) [#{moving-handler} points] + :else + [(->> selected-points (map base->point) (into #{})) + (->> points (remove selected-points) (into #{}))]) + + show-snap? (and snap-toggled (or (some? drag-handler) (some? preview) (some? moving-handler) moving-nodes)) handle-double-click-outside (fn [event] @@ -193,8 +209,7 @@ (mf/use-layout-effect (mf/deps edit-mode) (fn [] - (let [keys [(events/listen (dom/get-root) EventType.CLICK handle-click-outside) - (events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]] + (let [keys [(events/listen (dom/get-root) EventType.DBLCLICK handle-double-click-outside)]] #(doseq [key keys] (events/unlistenByKey key))))) @@ -204,30 +219,46 @@ :from last-p :zoom zoom}]) + (when drag-handler + [:g.drag-handler {:pointer-events "none"} + [:& path-handler {:point last-p + :handler drag-handler + :zoom zoom}]]) + + (when @hover-point + [:g.hover-point + [:& path-point {:position @hover-point + :zoom zoom}]]) + (for [position points] - [:g.path-node - [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")} - (for [[index prefix] (get handlers position)] - (let [command (get content index) - x (get-in command [:params (d/prefix-keyword prefix :x)]) - y (get-in command [:params (d/prefix-keyword prefix :y)]) - handler-position (gpt/point x y)] - (when (not= position handler-position) - [:& path-handler {:point position - :handler handler-position - :index index - :prefix prefix - :zoom zoom - :selected? (contains? selected-handlers [index prefix]) - :hover? (contains? hover-handlers [index prefix]) - :edit-mode edit-mode}])))] - [:& path-point {:position position - :zoom zoom - :edit-mode edit-mode - :selected? (contains? selected-points position) - :hover? (contains? hover-points position) - :last-p? (= last-point position) - :start-path? (nil? last-point)}]]) + (let [point-selected? (contains? selected-points (get point->base position)) + point-hover? (contains? hover-points (get point->base position)) + last-p? (= last-point (get point->base position)) + start-p? (not (some? last-point))] + + [:g.path-node + [:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")} + (for [[index prefix] (get handlers position)] + (let [command (get content index) + x (get-in command [:params (d/prefix-keyword prefix :x)]) + y (get-in command [:params (d/prefix-keyword prefix :y)]) + handler-position (gpt/point x y) + handler-hover? (contains? hover-handlers [index prefix])] + (when (not= position handler-position) + [:& path-handler {:point position + :handler handler-position + :index index + :prefix prefix + :zoom zoom + :hover? handler-hover? + :edit-mode edit-mode}])))] + [:& path-point {:position position + :zoom zoom + :edit-mode edit-mode + :selected? point-selected? + :hover? point-hover? + :last-p? last-p? + :start-path? start-p?}]])) (when prev-handler [:g.prev-handler {:pointer-events "none"} @@ -235,9 +266,9 @@ :handler prev-handler :zoom zoom}]]) - (when drag-handler - [:g.drag-handler {:pointer-events "none"} - [:& path-handler {:point last-p - :handler drag-handler - :zoom zoom}]])])) + (when show-snap? + [:g.path-snap {:pointer-events "none"} + [:& path-snap {:selected snap-selected + :points snap-points + :zoom zoom}]])])) diff --git a/frontend/src/app/main/ui/workspace/viewport.cljs b/frontend/src/app/main/ui/workspace/viewport.cljs index cff98f5880..3a0c422806 100644 --- a/frontend/src/app/main/ui/workspace/viewport.cljs +++ b/frontend/src/app/main/ui/workspace/viewport.cljs @@ -101,7 +101,7 @@ on-click (actions/on-click hover selected edition drawing-path? drawing-tool) on-context-menu (actions/on-context-menu hover) - on-double-click (actions/on-double-click hover hover-ids drawing-path? objects) + on-double-click (actions/on-double-click hover hover-ids drawing-path? objects edition) on-drag-enter (actions/on-drag-enter) on-drag-over (actions/on-drag-over) on-drop (actions/on-drop file viewport-ref zoom) @@ -170,7 +170,8 @@ :width (:width vport 0) :height (:height vport 0) :view-box (utils/format-viewbox vbox) - :style {:background-color (get options :background "#E8E9EA")}} + :style {:background-color (get options :background "#E8E9EA") + :pointer-events "none"}} [:& (mf/provider muc/embed-ctx) {:value true} ;; Render root shape @@ -287,7 +288,6 @@ {:zoom zoom :tooltip tooltip}]) - (when show-presence? [:& presence/active-cursors {:page-id page-id}]) diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index 1d94d938d7..6b886dbe99 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -15,6 +15,7 @@ [app.main.store :as st] [app.main.streams :as ms] [app.main.ui.workspace.viewport.utils :as utils] + [app.main.data.workspace.path :as dwdp] [app.util.dom :as dom] [app.util.dom.dnd :as dnd] [app.util.keyboard :as kbd] @@ -44,7 +45,9 @@ middle-click? (= 2 (.-which event)) frame? (= :frame type) - selected? (contains? selected id)] + selected? (contains? selected id) + + drawing-path? (= :draw (get-in edit-path [edition :edit-mode]))] (when middle-click? (dom/prevent-default bevent) @@ -56,14 +59,18 @@ (when (and (not= edition id) text-editing?) (st/emit! dw/clear-edition-mode)) - (when (and (or (not edition) (not= edition id)) (not blocked) (not hidden) (not (#{:comments :path} drawing-tool))) + (when (and (not text-editing?) + (not blocked) + (not hidden) + (not (#{:comments :path} drawing-tool)) + (not drawing-path?)) (cond drawing-tool (st/emit! (dd/start-drawing drawing-tool)) (and edit-path (contains? edit-path edition)) - ;; Handle node select-drawing. NOP at the moment - nil + ;; Handle path node area selection + (st/emit! (dwdp/handle-selection shift?)) (or (not id) (and frame? (not selected?))) (st/emit! (dw/handle-selection shift?)) @@ -142,9 +149,9 @@ (st/emit! (dw/select-shape (:id @hover))))))))) (defn on-double-click - [hover hover-ids drawing-path? objects] + [hover hover-ids drawing-path? objects edition] (mf/use-callback - (mf/deps @hover @hover-ids drawing-path?) + (mf/deps @hover @hover-ids drawing-path? edition) (fn [event] (dom/stop-propagation event) (let [ctrl? (kbd/ctrl? event) @@ -170,7 +177,7 @@ (reset! hover-ids (into [] (rest @hover-ids))) (st/emit! (dw/select-shape (:id selected)))) - (or text? path?) + (and (not= id edition) (or text? path?)) (st/emit! (dw/select-shape id) (dw/start-editing-selected)) diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs new file mode 100644 index 0000000000..85e4ff2200 --- /dev/null +++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs @@ -0,0 +1,171 @@ +;; 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) UXBOX Labs SL + +(ns app.main.ui.workspace.viewport.path-actions + (:require + [app.main.data.workspace.path :as drp] + [app.main.data.workspace.path.helpers :as wph] + [app.main.refs :as refs] + [app.main.store :as st] + [app.main.ui.icons :as i] + [app.main.ui.workspace.shapes.path.common :as pc] + [app.util.geom.path :as ugp] + [rumext.alpha :as mf])) + +(defn check-enabled [content selected-points] + (let [segments (ugp/get-segments content selected-points) + + points-selected? (not (empty? selected-points)) + segments-selected? (not (empty? segments))] + {:make-corner points-selected? + :make-curve points-selected? + :add-node segments-selected? + :remove-node points-selected? + :merge-nodes segments-selected? + :join-nodes points-selected? + :separate-nodes segments-selected?})) + +(mf/defc path-actions [{:keys [shape]}] + (let [id (mf/deref refs/selected-edition) + {:keys [edit-mode selected-points snap-toggled] :as all} (mf/deref pc/current-edit-path-ref) + content (:content shape) + + enabled-buttons + (mf/use-memo + (mf/deps content selected-points) + #(check-enabled content selected-points)) + + on-select-draw-mode + (mf/use-callback + (fn [event] + (st/emit! (drp/change-edit-mode :draw)))) + + on-select-edit-mode + (mf/use-callback + (fn [event] + (st/emit! (drp/change-edit-mode :move)))) + + on-add-node + (mf/use-callback + (mf/deps (:add-node enabled-buttons)) + (fn [event] + (when (:add-node enabled-buttons) + (st/emit! (drp/add-node))))) + + on-remove-node + (mf/use-callback + (mf/deps (:remove-node enabled-buttons)) + (fn [event] + (when (:remove-node enabled-buttons) + (st/emit! (drp/remove-node))))) + + on-merge-nodes + (mf/use-callback + (mf/deps (:merge-nodes enabled-buttons)) + (fn [event] + (when (:merge-nodes enabled-buttons) + (st/emit! (drp/merge-nodes))))) + + on-join-nodes + (mf/use-callback + (mf/deps (:join-nodes enabled-buttons)) + (fn [event] + (when (:join-nodes enabled-buttons) + (st/emit! (drp/join-nodes))))) + + on-separate-nodes + (mf/use-callback + (mf/deps (:separate-nodes enabled-buttons)) + (fn [event] + (when (:separate-nodes enabled-buttons) + (st/emit! (drp/separate-nodes))))) + + on-make-corner + (mf/use-callback + (mf/deps (:make-corner enabled-buttons)) + (fn [event] + (when (:make-corner enabled-buttons) + (st/emit! (drp/make-corner))))) + + on-make-curve + (mf/use-callback + (mf/deps (:make-curve enabled-buttons)) + (fn [event] + (when (:make-curve enabled-buttons) + (st/emit! (drp/make-curve))))) + + on-toggle-snap + (mf/use-callback + (fn [event] + (st/emit! (drp/toggle-snap)))) + + ] + [:div.path-actions + [:div.viewport-actions-group + + ;; Draw Mode + [:div.viewport-actions-entry + {:class (when (= edit-mode :draw) "is-toggled") + :on-click on-select-draw-mode} + i/pen] + + ;; Edit mode + [:div.viewport-actions-entry + {:class (when (= edit-mode :move) "is-toggled") + :on-click on-select-edit-mode} + i/pointer-inner]] + + [:div.viewport-actions-group + ;; Add Node + [:div.viewport-actions-entry + {:class (when-not (:add-node enabled-buttons) "is-disabled") + :on-click on-add-node} + i/nodes-add] + + ;; Remove node + [:div.viewport-actions-entry + {:class (when-not (:remove-node enabled-buttons) "is-disabled") + :on-click on-remove-node} + i/nodes-remove]] + + [:div.viewport-actions-group + ;; Merge Nodes + [:div.viewport-actions-entry + {:class (when-not (:merge-nodes enabled-buttons) "is-disabled") + :on-click on-merge-nodes} + i/nodes-merge] + + ;; Join Nodes + [:div.viewport-actions-entry + {:class (when-not (:join-nodes enabled-buttons) "is-disabled") + :on-click on-join-nodes} + i/nodes-join] + + ;; Separate Nodes + [:div.viewport-actions-entry + {:class (when-not (:separate-nodes enabled-buttons) "is-disabled") + :on-click on-separate-nodes} + i/nodes-separate]] + + ;; Make Corner + [:div.viewport-actions-group + [:div.viewport-actions-entry + {:class (when-not (:make-corner enabled-buttons) "is-disabled") + :on-click on-make-corner} + i/nodes-corner] + + ;; Make Curve + [:div.viewport-actions-entry + {:class (when-not (:make-curve enabled-buttons) "is-disabled") + :on-click on-make-curve} + i/nodes-curve]] + + ;; Toggle snap + [:div.viewport-actions-group + [:div.viewport-actions-entry + {:class (when snap-toggled "is-toggled") + :on-click on-toggle-snap} + i/nodes-snap]]])) diff --git a/frontend/src/app/main/ui/workspace/viewport/widgets.cljs b/frontend/src/app/main/ui/workspace/viewport/widgets.cljs index d810b8a062..6bd73feb84 100644 --- a/frontend/src/app/main/ui/workspace/viewport/widgets.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/widgets.cljs @@ -14,7 +14,7 @@ [app.main.store :as st] [app.main.streams :as ms] [app.main.ui.hooks :as hooks] - [app.main.ui.workspace.shapes.path.actions :refer [path-actions]] + [app.main.ui.workspace.viewport.path-actions :refer [path-actions]] [app.util.dom :as dom] [app.util.object :as obj] [rumext.alpha :as mf])) diff --git a/frontend/src/app/util/geom/path.cljs b/frontend/src/app/util/geom/path.cljs index 454b2da203..c4a9a7249a 100644 --- a/frontend/src/app/util/geom/path.cljs +++ b/frontend/src/app/util/geom/path.cljs @@ -8,10 +8,13 @@ (:require [app.common.data :as d] [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] [app.util.a2c :refer [a2c]] [app.util.geom.path-impl-simplify :as impl-simplify] [app.util.svg :as usvg] - [cuerdas.core :as str])) + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth])) (defn calculate-opposite-handler "Given a point and its handler, gives the symetric handler" @@ -64,6 +67,11 @@ (cond-> result (not (empty? current)) (conj current)))))) +(defn command->point [command] + (when-not (nil? command) + (let [{{:keys [x y]} :params} command] + (gpt/point x y)))) + (defn command->param-list [command] (let [params (:params command)] (case (:command command) @@ -387,6 +395,18 @@ (mapv command->string) (str/join ""))) +(defn make-move-to [to] + {:command :move-to + :relative false + :params {:x (:x to) + :y (:y to)}}) + +(defn make-line-to [to] + {:command :line-to + :relative false + :params {:x (:x to) + :y (:y to)}}) + (defn make-curve-params ([point] (make-curve-params point point point)) @@ -401,6 +421,26 @@ :c2x (:x h2) :c2y (:y h2)})) +(defn make-curve-to [to h1 h2] + {:command :curve-to + :relative false + :params (make-curve-params to h1 h2)}) + +(defn split-line-to [from-p cmd val] + (let [to-p (command->point cmd) + sp (gpt/line-val from-p to-p val)] + [(make-line-to sp) cmd])) + +(defn split-curve-to [from-p cmd val] + (let [params (:params cmd) + end (gpt/point (:x params) (:y params)) + h1 (gpt/point (:c1x params) (:c1y params)) + h2 (gpt/point (:c2x params) (:c2y params)) + [[_ to1 h11 h21] + [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)] + [(make-curve-to to1 h11 h21) + (make-curve-to to2 h12 h22)])) + (defn opposite-handler "Calculates the coordinates of the opposite handler" [point handler] @@ -441,11 +481,6 @@ (let [content (if (vector? content) content (into [] content))] (reduce apply-to-index content modifiers)))) -(defn command->point [command] - (when-not (nil? command) - (let [{{:keys [x y]} :params} command] - (gpt/point x y)))) - (defn content->points [content] (->> content (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y)))) @@ -468,7 +503,6 @@ [content] (->> (d/with-prev content) (d/enumerate) - (mapcat (fn [[index [cur-cmd pre-cmd]]] (if (and pre-cmd (= :curve-to (:command cur-cmd))) (let [cur-pos (command->point cur-cmd) @@ -480,6 +514,25 @@ (group-by first) (d/mapm #(mapv second %2)))) +(defn point-indices + [content point] + (->> (d/enumerate content) + (filter (fn [[_ cmd]] (= point (command->point cmd)))) + (mapv (fn [[index _]] index)))) + +(defn handler-indices + [content point] + (->> (d/with-prev content) + (d/enumerate) + (mapcat (fn [[index [cur-cmd pre-cmd]]] + (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd))) + (let [cur-pos (command->point cur-cmd) + pre-pos (command->point pre-cmd)] + (cond-> [] + (= pre-pos point) (conj [index :c1]) + (= cur-pos point) (conj [index :c2]))) + []))))) + (defn opposite-index "Calculate sthe opposite index given a prefix and an index" [content index prefix] @@ -586,3 +639,279 @@ (as-> content $ (reduce redfn $ content-next) (remove-line-curves $)))) + +(defn get-segments + "Given a content and a set of points return all the segments in the path + that uses the points" + [content points] + (let [point-set (set points)] + + (loop [segments [] + prev-point nil + start-point nil + cur-cmd (first content) + content (rest content)] + + (let [;; Close-path makes a segment from the last point to the initial path point + cur-point (if (= :close-path (:command cur-cmd)) + start-point + (command->point cur-cmd)) + + ;; If there is a move-to we don't have a segment + prev-point (if (= :move-to (:command cur-cmd)) + nil + prev-point) + + ;; We update the start point + start-point (if (= :move-to (:command cur-cmd)) + cur-point + start-point) + + is-segment? (and (some? prev-point) + (contains? point-set prev-point) + (contains? point-set cur-point)) + + segments (cond-> segments + is-segment? + (conj [prev-point cur-point cur-cmd]))] + + (if (some? cur-cmd) + (recur segments + cur-point + start-point + (first content) + (rest content)) + + segments))))) + +(defn split-segments + "Given a content creates splits commands between points with new segments" + [content points value] + (let [split-command + (fn [[start end cmd]] + (case (:command cmd) + :line-to [cmd (split-line-to start cmd value)] + :curve-to [cmd (split-curve-to start cmd value)] + :close-path [cmd [(make-line-to (gpt/line-val start end value)) cmd]] + nil)) + + cmd-changes + (->> (get-segments content points) + (into {} (comp (map split-command) + (filter (comp not nil?))))) + + process-segments + (fn [command] + (if (contains? cmd-changes command) + (get cmd-changes command) + [command]))] + + (into [] (mapcat process-segments) content))) + +(defn remove-nodes + "Removes from content the points given. Will try to reconstruct the paths + to keep everything consistent" + [content points] + + (let [content (d/with-prev content)] + + (loop [result [] + last-handler nil + [cur-cmd prev-cmd] (first content) + content (rest content)] + + (if (nil? cur-cmd) + ;; 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-cmd)) + curve? (= :curve-to (:command cur-cmd)) + + ;; When the old command was a move we start a subpath + result (if move? (conj result []) result) + + subpath (peek result) + + point (command->point cur-cmd) + + old-prev-point (command->point prev-cmd) + new-prev-point (command->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-cmd) [:c1x :c1y]) + + (not remove?) + nil + + :else + last-handler) + + cur-cmd (cond-> cur-cmd + ;; 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-cmd) [: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? (not (empty? 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-cmd))] + (recur result + cur-handler + (first content) + (rest content))))))) + +(defn join-nodes + "Creates new segments between points that weren't previously" + [content points] + + (let [segments-set (into #{} + (map (fn [[p1 p2 _]] [p1 p2])) + (get-segments content points)) + + create-line-command (fn [point other] + [(make-move-to point) + (make-line-to other)]) + + not-segment? (fn [point other] (and (not (contains? segments-set [point other])) + (not (contains? segments-set [other point])))) + + new-content (->> (d/map-perm create-line-command not-segment? points) + (flatten) + (into []))] + + (d/concat content new-content))) + + +(defn separate-nodes + "Removes the segments between the points given" + [content points] + + (let [content (d/with-prev content)] + (loop [result [] + [cur-cmd prev-cmd] (first content) + content (rest content)] + + (if (nil? cur-cmd) + (->> result + (filter #(> (count %) 1)) + (flatten) + (into [])) + + (let [prev-point (command->point prev-cmd) + cur-point (command->point cur-cmd) + + cur-cmd (cond-> cur-cmd + (and (contains? points prev-point) + (contains? points cur-point)) + + (assoc :command :move-to + :params (select-keys (:params cur-cmd) [:x :y]))) + + move? (= :move-to (:command cur-cmd)) + + result (if move? (conj result []) result) + head-idx (dec (count result)) + + result (-> result + (update head-idx conj cur-cmd))] + (recur result + (first content) + (rest content))))))) + + +(defn- add-to-set + "Given a list of sets adds the value to the target set" + [set-list target value] + (->> set-list + (mapv (fn [it] + (cond-> it + (= it target) (conj value)))))) + +(defn- join-sets + "Given a list of sets join two sets in the list into a new one" + [set-list target other] + (conj (->> set-list + (filterv #(and (not= % target) + (not= % other)))) + (set/union target other))) + +(defn group-segments [segments] + (loop [result [] + [point-a point-b :as segment] (first segments) + segments (rest segments)] + + (if (nil? segment) + result + + (let [set-a (d/seek #(contains? % point-a) result) + set-b (d/seek #(contains? % point-b) result) + + result (cond-> result + (and (nil? set-a) (nil? set-b)) + (conj #{point-a point-b}) + + (and (some? set-a) (nil? set-b)) + (add-to-set set-a point-b) + + (and (nil? set-a) (some? set-b)) + (add-to-set set-b point-a) + + (and (some? set-a) (some? set-b) (not= set-a set-b)) + (join-sets set-a set-b))] + (recur result + (first segments) + (rest segments)))))) + +(defn calculate-merge-points [group-segments points] + (let [index-merge-point (fn [group] (vector group (-> (gpt/center-points group) + (update :x mth/round) + (update :y mth/round)))) + index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments))) + + group->merge-point (into {} (map index-merge-point) group-segments) + point->group (into {} (map index-group) points)] + (d/mapm #(group->merge-point %2) point->group))) + +;; TODO: Improve the replace for curves +(defn replace-points + "Replaces the points in a path for its merge-point" + [content point->merge-point] + (let [replace-command + (fn [cmd] + (let [point (command->point cmd)] + (if (contains? point->merge-point point) + (let [merge-point (get point->merge-point point)] + (-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point)))) + cmd)))] + (->> content + (mapv replace-command)))) + +(defn merge-nodes + "Reduces the continguous segments in points to a single point" + [content points] + (let [point->merge-point (-> content + (get-segments points) + (group-segments) + (calculate-merge-points points))] + (-> content + (separate-nodes points) + (replace-points point->merge-point)))) +