🐛 Fix path node type change operation

This commit is contained in:
Andrey Antukh 2025-05-26 10:05:00 +02:00
parent b561ad033c
commit e698fd7d35

View file

@ -54,11 +54,12 @@
result))) result)))
{}))) {})))
;; FIXME: can be optimized with internal reduction
(defn point-indices (defn point-indices
[content point] [content point]
(->> (d/enumerate content) (->> (d/enumerate content)
(filter (fn [[_ segment]] (= point (helpers/segment->point segment)))) (filter (fn [[_ segment]] (= point (helpers/segment->point segment))))
(mapv (fn [[index _]] index)))) (map (fn [[index _]] index))))
(defn handler-indices (defn handler-indices
"Return an index where the key is the positions and the values the handlers" "Return an index where the key is the positions and the values the handlers"
@ -272,41 +273,51 @@
(defn- remove-line-curves (defn- remove-line-curves
"Remove all curves that have both handlers in the same position that the "Remove all curves that have both handlers in the same position that the
beginning and end points. This makes them really line-to commands" beginning and end points. This makes them really line-to commands.
[content]
(let [with-prev (d/enumerate (d/with-prev content))
process-command
(fn [content [index [command prev]]]
(let [cur-point (helpers/segment->point command) NOTE: works with plain format so it expects to receive a vector"
[content]
(assert (vector? content) "expected a plain format for `content`")
(let [with-prev (d/enumerate (d/with-prev content))
process-segment
(fn [content [index [segment prev]]]
(let [cur-point (helpers/segment->point segment)
pre-point (helpers/segment->point prev) pre-point (helpers/segment->point prev)
handler-c1 (get-handler command :c1) handler-c1 (get-handler segment :c1)
handler-c2 (get-handler command :c2)] handler-c2 (get-handler segment :c2)]
(if (and (= :curve-to (:command command)) (if (and (= :curve-to (:command segment))
(= cur-point handler-c2) (= cur-point handler-c2)
(= pre-point handler-c1)) (= pre-point handler-c1))
(assoc content index {:command :line-to (assoc content index {:command :line-to
:params (into {} cur-point)}) :params (into {} cur-point)})
content)))] content)))]
(reduce process-command content with-prev))) (reduce process-segment content with-prev)))
(defn make-corner-point (defn make-corner-point
"Changes the content to make a point a 'corner'" "Changes the content to make a point a 'corner'"
[content point] [content point]
(let [handlers (-> (get-handlers content) (let [handlers
(get point)) (-> (get-handlers content)
change-content (get point))
transform-content
(fn [content [index prefix]] (fn [content [index prefix]]
(let [cx (d/prefix-keyword prefix :x) (let [cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)] cy (d/prefix-keyword prefix :y)]
(-> content (-> content
(assoc-in [index :params cx] (:x point)) (assoc-in [index :params cx] (:x point))
(assoc-in [index :params cy] (:y point)))))] (assoc-in [index :params cy] (:y point)))))
(as-> content $
(reduce change-content $ handlers)
(remove-line-curves $))))
content
(reduce transform-content (vec content) handlers)
content
(remove-line-curves content)]
(impl/from-plain content)))
(defn- line->curve (defn- line->curve
[from-p segment] [from-p segment]
@ -346,88 +357,118 @@
(def ^:private xf:mapcat-points (def ^:private xf:mapcat-points
(comp (comp
(mapcat #(vector (:next-p %) (:prev-p %))) (mapcat #(list (:next-p %) (:prev-p %)))
(remove nil?))) (remove nil?)))
(defn make-curve-point (defn make-curve-point
"Changes the content to make the point a 'curve'. The handlers will be positioned "Changes the content to make the point a 'curve'. The handlers will be
in the same vector that results from the previous->next points but with fixed length." positioned in the same vector that results from the previous->next
points but with fixed length."
[content point] [content point]
(let [indices (point-indices content point) (let [;; We perform this operation before because it can be
vectors (map (fn [index] ;; optimized with internal reduction so is better to use the
(let [segment (nth content index) ;; PathData type before converting it to plain vector.
prev-i (dec index) indices
prev (when (not (= :move-to (:command segment))) (point-indices content point)
(get content prev-i))
next-i (inc index)
next (get content next-i)
next (when (not (= :move-to (:command next))) vectors
next)] (map (fn [index]
{:index index (let [segment (nth content index)
:prev-i (when (some? prev) prev-i) prev-i (dec index)
:prev-c prev prev (when (not (= :move-to (:command segment)))
:prev-p (helpers/segment->point prev) (get content prev-i))
:next-i (when (some? next) next-i) next-i (inc index)
:next-c next next (get content next-i)
:next-p (helpers/segment->point next)
:segment segment}))
indices)
points (into #{} xf:mapcat-points vectors)] next (when (not (= :move-to (:command next)))
next)]
{:index index
:prev-i (when (some? prev) prev-i)
:prev-c prev
:prev-p (helpers/segment->point prev)
:next-i (when (some? next) next-i)
:next-c next
:next-p (helpers/segment->point next)
:segment segment}))
indices)
(if (= (count points) 2) points
(let [v1 (gpt/to-vec (first points) point) (into #{} xf:mapcat-points vectors)
v2 (gpt/to-vec (first points) (second points))
vp (gpt/project v1 v2)
vh (gpt/subtract v1 vp)
add-curve ;; We transform content to a plain format for execute the
(fn [content {:keys [index prev-p next-p next-i]}] ;; algorithm because right now is the only way to execute it
(let [cur-segment (get content index) content
next-segment (get content next-i) (vec content)
;; New handlers for prev-point and next-point content
prev-h (when (some? prev-p) (gpt/add prev-p vh)) (if (= (count points) 2)
next-h (when (some? next-p) (gpt/add next-p vh)) (let [[fpoint spoint] (vec points)
v1 (gpt/to-vec fpoint point)
v2 (gpt/to-vec fpoint spoint)
vp (gpt/project v1 v2)
vh (gpt/subtract v1 vp)
;; Correct 1/3 to the point improves the curve add-curve
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3))) (fn [content {:keys [index prev-p next-p next-i]}]
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3))) (let [curr-segment (get content index)
curr-command (get curr-segment :command)
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction)) next-segment (get content next-i)
next-h (when (some? next-h) (gpt/add next-h next-correction))] next-command (get next-segment :command)
(cond-> content
(and (= :line-to (:command cur-segment)) (some? prev-p))
(update index helpers/update-curve-to prev-p prev-h)
(and (= :line-to (:command next-segment)) (some? next-p)) ;; New handlers for prev-point and next-point
(update next-i helpers/update-curve-to next-h next-p) prev-h
(when (some? prev-p) (gpt/add prev-p vh))
(and (= :curve-to (:command cur-segment)) (some? prev-p)) next-h
(update index update-handler :c2 prev-h) (when (some? next-p) (gpt/add next-p vh))
(and (= :curve-to (:command next-segment)) (some? next-p)) ;; Correct 1/3 to the point improves the curve
(update next-i update-handler :c1 next-h))))] prev-correction
(when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
(reduce add-curve content vectors)) next-correction
(when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
(let [add-curve prev-h
(fn [content {:keys [index segment prev-p next-c next-i]}] (when (some? prev-h) (gpt/add prev-h prev-correction))
(cond-> content
(= :line-to (:command segment))
(update index #(line->curve prev-p %))
(= :curve-to (:command segment)) next-h
(update index #(line->curve prev-p %)) (when (some? next-h) (gpt/add next-h next-correction))]
(= :line-to (:command next-c)) (cond-> content
(update next-i #(line->curve point %)) (and (= :line-to curr-command) (some? prev-p))
(update index helpers/update-curve-to prev-p prev-h)
(= :curve-to (:command next-c)) (and (= :line-to next-command) (some? next-p))
(update next-i #(line->curve point %))))] (update next-i helpers/update-curve-to next-h next-p)
(reduce add-curve content vectors)))))
(and (= :curve-to curr-command) (some? prev-p))
(update index update-handler :c2 prev-h)
(and (= :curve-to next-command) (some? next-p))
(update next-i update-handler :c1 next-h))))]
(reduce add-curve content vectors))
(let [add-curve
(fn [content {:keys [index segment prev-p next-c next-i]}]
(cond-> content
(= :line-to (:command segment))
(update index #(line->curve prev-p %))
(= :curve-to (:command segment))
(update index #(line->curve prev-p %))
(= :line-to (:command next-c))
(update next-i #(line->curve point %))
(= :curve-to (:command next-c))
(update next-i #(line->curve point %))))]
(reduce add-curve content vectors)))]
(impl/from-plain content)))
(defn get-segments-with-points (defn get-segments-with-points
"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