Add minor improvements to get-segments-with-points

And rename it from `get-segments`
This commit is contained in:
Andrey Antukh 2025-04-09 09:37:45 +02:00
parent 3a22545158
commit 60f754f172
3 changed files with 62 additions and 45 deletions

View file

@ -507,28 +507,23 @@
(update next-i #(line->curve point %))))]
(reduce add-curve content vectors)))))
;; FIXME: revisit the impl of this function
(defn get-segments
(defn get-segments-with-points
"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 []
(loop [result (transient [])
prev-point nil
start-point nil
index 0
cur-segment (first content)
content (rest content)]
(let [command (:command cur-segment)
close-path? (= command :close-path)
content (seq content)]
(if-let [{:keys [command] :as segment} (first content)]
(let [close-path? (= command :close-path)
move-to? (= command :move-to)
;; Close-path makes a segment from the last point to the initial path point
cur-point (if close-path?
start-point
(helpers/segment->point cur-segment))
(helpers/segment->point segment))
;; If there is a move-to we don't have a segment
prev-point (if move-to?
@ -540,43 +535,38 @@
cur-point
start-point)
is-segment? (and (some? prev-point)
result (cond-> result
(and (some? prev-point)
(contains? point-set prev-point)
(contains? point-set cur-point))
segments (cond-> segments
is-segment?
(conj {:start prev-point
:end cur-point
:segment cur-segment
:index index}))]
(if (some? cur-segment)
(recur segments
(conj! (-> segment
(assoc :start prev-point)
(assoc :end cur-point)
(assoc :index index))))]
(recur result
cur-point
start-point
(inc index)
(first content)
(rest content))
(rest content)))
segments)))))
(persistent! result)))))
(defn split-segments
"Given a content creates splits commands between points with new segments"
[content points value]
(let [split-command
(fn [{:keys [start end segment index]}]
(case (:command segment)
(fn [{:keys [command start end index] :as segment}]
(case command
:line-to [index (helpers/split-line-to start segment value)]
:curve-to [index (helpers/split-curve-to start segment value)]
:close-path [index [(helpers/make-line-to (gpt/lerp start end value)) segment]]
nil))
segment-changes
(->> (get-segments content points)
(into {} (comp (map split-command)
(filter (comp not nil?)))))
(->> (get-segments-with-points content points)
(into {} (keep split-command)))
process-segments
(fn [[index command]]
@ -680,7 +670,7 @@
(let [segments-set (into #{}
(map (juxt :start :end))
(get-segments content points))
(get-segments-with-points content points))
create-line-command (fn [point other]
[(helpers/make-move-to point)
@ -802,7 +792,7 @@
(defn merge-nodes
"Reduces the contiguous segments in points to a single point"
[content points]
(let [segments (get-segments content points)]
(let [segments (get-segments-with-points content points)]
(if (seq segments)
(let [point->merge-point (-> segments
(group-segments)

View file

@ -276,3 +276,30 @@
(t/is (= result1 expect))
(t/is (= result2 expect))
(t/is (= result3 expect))))
(def sample-content-square
[{:command :move-to, :params {:x 0, :y 0}}
{:command :line-to, :params {:x 10, :y 0}}
{:command :line-to, :params {:x 10, :y 10}}
{:command :line-to, :params {:x 10, :y 0}}
{:command :line-to, :params {:x 0, :y 10}}
{:command :line-to, :params {:x 0, :y 0}}
{:command :close-path :params {}}])
(t/deftest get-segments
(let [content (path/content sample-content-square)
points #{(gpt/point 10.0 0.0)
(gpt/point 0.0 0.0)}
result (path.segment/get-segments-with-points content points)
expect [{:command :line-to,
:params {:x 10.0, :y 0.0},
:start (gpt/point 0.0 0.0)
:end (gpt/point 10.0 0.0)
:index 1}
{:command :close-path,
:params {},
:start (gpt/point 0.0 0.0)
:end (gpt/point 0.0 0.0)
:index 6}]]
(t/is (= result expect))))

View file

@ -48,7 +48,7 @@
(defn check-enabled [content selected-points]
(let [segments (path.segm/get-segments content selected-points)
(let [segments (path.segm/get-segments-with-points content selected-points)
num-segments (count segments)
num-points (count selected-points)
points-selected? (seq selected-points)