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

View file

@ -276,3 +276,30 @@
(t/is (= result1 expect)) (t/is (= result1 expect))
(t/is (= result2 expect)) (t/is (= result2 expect))
(t/is (= result3 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] (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-segments (count segments)
num-points (count selected-points) num-points (count selected-points)
points-selected? (seq selected-points) points-selected? (seq selected-points)