diff --git a/common/app/common/geom/point.cljc b/common/app/common/geom/point.cljc index 7a7dfeee6..6e656d888 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))) diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs index 8fc961b7a..850e925e2 100644 --- a/frontend/src/app/main/data/workspace/path/tools.cljs +++ b/frontend/src/app/main/data/workspace/path/tools.cljs @@ -18,65 +18,44 @@ [beicon.core :as rx] [potok.core :as ptk])) -(defn make-corner [] - (ptk/reify ::make-corner +(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 (reduce ugp/make-corner-point (:content shape) 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 [] - (ptk/reify ::make-curve - 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 (reduce ugp/make-curve-point (: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})))))) + (process-path-tool + (fn [content points] + (reduce ugp/make-curve-point content points)))) (defn add-node [] - (ptk/reify ::add-node - 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 (ugp/split-segments (:content shape) selected-points 0.5) - [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)] - (rx/of (dwc/commit-changes rch uch {:commit-local? true})))))) + (process-path-tool (fn [content points] (ugp/split-segments content points 0.5)))) (defn remove-node [] - (ptk/reify ::remove-node - 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] #{}) - content (:content shape) - new-content (ugp/remove-nodes content 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})))) - - )) + (process-path-tool ugp/remove-nodes)) (defn merge-nodes [] - (ptk/reify ::merge-nodes)) + (process-path-tool ugp/merge-nodes)) (defn join-nodes [] - (ptk/reify ::join-nodes)) + (process-path-tool ugp/join-nodes)) (defn separate-nodes [] - (ptk/reify ::separate-nodes)) + (process-path-tool ugp/separate-nodes)) (defn toggle-snap [] (ptk/reify ::toggle-snap diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs index cc0caf131..8eb346a93 100644 --- a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs @@ -28,7 +28,7 @@ :add-node segments-selected? :remove-node points-selected? :merge-nodes segments-selected? - :join-nodes segments-selected? + :join-nodes points-selected? :separate-nodes segments-selected?})) (mf/defc path-actions [{:keys [shape]}] diff --git a/frontend/src/app/util/geom/path.cljs b/frontend/src/app/util/geom/path.cljs index aa825e1a4..c4a9a7249 100644 --- a/frontend/src/app/util/geom/path.cljs +++ b/frontend/src/app/util/geom/path.cljs @@ -12,7 +12,9 @@ [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" @@ -393,6 +395,12 @@ (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 @@ -770,3 +778,140 @@ (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)))) +