0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-16 01:31:22 -05:00

Adds join, merge, separate nodes

This commit is contained in:
alonso.torres 2021-04-07 19:00:29 +02:00 committed by Andrés Moya
parent bc3640893c
commit fc383664c7
4 changed files with 168 additions and 42 deletions

View file

@ -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)))

View file

@ -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

View file

@ -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]}]

View file

@ -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))))