🐛 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-handlers content)
(get point)) (get point))
change-content
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,16 +357,23 @@
(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
;; PathData type before converting it to plain vector.
indices
(point-indices content point)
vectors
(map (fn [index]
(let [segment (nth content index) (let [segment (nth content index)
prev-i (dec index) prev-i (dec index)
prev (when (not (= :move-to (:command segment))) prev (when (not (= :move-to (:command segment)))
@ -375,40 +393,61 @@
:segment segment})) :segment segment}))
indices) indices)
points (into #{} xf:mapcat-points vectors)] points
(into #{} xf:mapcat-points vectors)
;; We transform content to a plain format for execute the
;; algorithm because right now is the only way to execute it
content
(vec content)
content
(if (= (count points) 2) (if (= (count points) 2)
(let [v1 (gpt/to-vec (first points) point) (let [[fpoint spoint] (vec points)
v2 (gpt/to-vec (first points) (second points)) v1 (gpt/to-vec fpoint point)
v2 (gpt/to-vec fpoint spoint)
vp (gpt/project v1 v2) vp (gpt/project v1 v2)
vh (gpt/subtract v1 vp) vh (gpt/subtract v1 vp)
add-curve add-curve
(fn [content {:keys [index prev-p next-p next-i]}] (fn [content {:keys [index prev-p next-p next-i]}]
(let [cur-segment (get content index) (let [curr-segment (get content index)
curr-command (get curr-segment :command)
next-segment (get content next-i) next-segment (get content next-i)
next-command (get next-segment :command)
;; New handlers for prev-point and next-point ;; New handlers for prev-point and next-point
prev-h (when (some? prev-p) (gpt/add prev-p vh)) prev-h
next-h (when (some? next-p) (gpt/add next-p vh)) (when (some? prev-p) (gpt/add prev-p vh))
next-h
(when (some? next-p) (gpt/add next-p vh))
;; Correct 1/3 to the point improves the curve ;; Correct 1/3 to the point improves the curve
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3))) prev-correction
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3))) (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
next-correction
(when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
prev-h
(when (some? prev-h) (gpt/add prev-h prev-correction))
next-h
(when (some? next-h) (gpt/add next-h next-correction))]
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
next-h (when (some? next-h) (gpt/add next-h next-correction))]
(cond-> content (cond-> content
(and (= :line-to (:command cur-segment)) (some? prev-p)) (and (= :line-to curr-command) (some? prev-p))
(update index helpers/update-curve-to prev-p prev-h) (update index helpers/update-curve-to prev-p prev-h)
(and (= :line-to (:command next-segment)) (some? next-p)) (and (= :line-to next-command) (some? next-p))
(update next-i helpers/update-curve-to next-h next-p) (update next-i helpers/update-curve-to next-h next-p)
(and (= :curve-to (:command cur-segment)) (some? prev-p)) (and (= :curve-to curr-command) (some? prev-p))
(update index update-handler :c2 prev-h) (update index update-handler :c2 prev-h)
(and (= :curve-to (:command next-segment)) (some? next-p)) (and (= :curve-to next-command) (some? next-p))
(update next-i update-handler :c1 next-h))))] (update next-i update-handler :c1 next-h))))]
(reduce add-curve content vectors)) (reduce add-curve content vectors))
@ -427,7 +466,9 @@
(= :curve-to (:command next-c)) (= :curve-to (:command next-c))
(update next-i #(line->curve point %))))] (update next-i #(line->curve point %))))]
(reduce add-curve content vectors))))) (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