3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-08-06 11:28:28 +02:00
Code Issues Projects Releases Packages Wiki Activity

⚡ Optimize calculate-extremities path helper

Browse source 
Heavily used on path edition
This commit is contained in:
Andrey Antukh 2025-04-08 22:01:58 +02:00
parent b0cbe3cec8
commit 33bcbd89f1
3 changed files with 277 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

116
common/src/app/common/types/path/helpers.cljc
View file

@ -13,6 +13,7 @@
namespaces without incurrying on circular depedency cycles."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
@ -114,6 +115,18 @@
(when (and (some? x) (some? y))
(gpt/point x y)))))
(defn segment->point
([segment] (segment->point segment :x))
([segment coord]
(let [params (get segment :params)]
(case coord
:c1 (gpt/point (get params :c1x)
(get params :c1y))
:c2 (gpt/point (get params :c2x)
(get params :c2y))
(gpt/point (get params :x)
(get params :y))))))
(defn command->line
([cmd]
(command->line cmd (:prev cmd)))
@ -199,29 +212,34 @@
(gpt/point (coord-v :x) (coord-v :y)))))
;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm
(defn- solve-roots
"Solvers a quadratic or cubic equation given by the parameters a b c d"
([a b c]
(solve-roots a b c 0))
(defn solve-roots*
"Solvers a quadratic or cubic equation given by the parameters a b c d.
([a b c d]
Implemented as reduction algorithm (this helps implemement
derivative algorithms that does not require intermediate results
thanks to transducers."
[result conj a b c d]
(let [sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
(cond
;; No solutions
(and (mth/almost-zero? d) (mth/almost-zero? a) (mth/almost-zero? b))
[]
(and ^boolean (mth/almost-zero? d)
^boolean (mth/almost-zero? a)
^boolean (mth/almost-zero? b))
result
;; Linear solution
(and (mth/almost-zero? d) (mth/almost-zero? a))
[(/ (- c) b)]
(and ^boolean (mth/almost-zero? d)
^boolean (mth/almost-zero? a))
(conj result (/ (- c) b))
;; Quadratic
^boolean
(mth/almost-zero? d)
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
(/ (- (- b) sqrt-b2-4ac)
(* 2 a))]
(-> result
(conj (/ (+ (- b) sqrt-b2-4ac)
(* 2 a)))
(conj (/ (- (- b) sqrt-b2-4ac)
(* 2 a))))
;; Cubic
:else
@ -252,20 +270,36 @@
root2 (- (* t1 (mth/cos (/ (+ phi (* 2 mth/PI)) 3))) (/ a 3))
root3 (- (* t1 (mth/cos (/ (+ phi (* 4 mth/PI)) 3))) (/ a 3))]
[root1 root2 root3])
(-> result
(conj root1)
(conj root2)
(conj root3)))
^boolean
(mth/almost-zero? discriminant)
(let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2)))
root1 (- (* 2 u1) (/ a 3))
root2 (- (- u1) (/ a 3))]
[root1 root2])
(-> result
(conj root1)
(conj root2)))
:else
(let [sd (mth/sqrt discriminant)
u1 (mth/cubicroot (- sd q2))
v1 (mth/cubicroot (+ sd q2))
root (- u1 v1 (/ a 3))]
[root])))))))
(conj result root)))))))
;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm
(defn- solve-roots
"Solvers a quadratic or cubic equation given by the parameters a b c d"
([a b c] (solve-roots a b c 0))
([a b c d] (solve-roots* [] conj a b c d)))
;; https://pomax.github.io/bezierinfo/#extremities
(defn curve-extremities
@ -292,6 +326,54 @@
;; Only values in the range [0, 1] are valid
(filterv #(and (> % 0.01) (< % 0.99)))))))
(defn calculate-curve-extremities
"Calculates the extremities by solving the first derivative for a
cubic bezier and then solving the quadratic formula"
[start end h1 h2]
(let [start-x (dm/get-prop start :x)
h1-x (dm/get-prop h1 :x)
h2-x (dm/get-prop h2 :x)
end-x (dm/get-prop end :x)
start-y (dm/get-prop start :y)
h1-y (dm/get-prop h1 :y)
h2-y (dm/get-prop h2 :y)
end-y (dm/get-prop end :y)
xform
(comp
(filter #(and (> % 0.01) (< % 0.99)))
(map (fn [t]
(let [t2 (* t t) ;; t square
t3 (* t2 t) ;; t cube
start-v (+ (- t3) (* 3 t2) (* -3 t) 1)
h1-v (+ (* 3 t3) (* -6 t2) (* 3 t))
h2-v (+ (* -3 t3) (* 3 t2))
end-v t3]
(gpt/point
(+ (* start-x start-v)
(* h1-x h1-v)
(* h2-x h2-v)
(* end-x end-v))
(+ (* start-y start-v)
(* h1-y h1-v)
(* h2-y h2-v)
(* end-y end-v)))))))
conj*
(xform conj!)
process-curve
(fn [result c0 c1 c2 c3]
(let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
b (+ (* 6 c0) (* -12 c1) (* 6 c2))
c (+ (* 3 c1) (* -3 c0))]
(solve-roots* result conj* a b c 0)))]
(-> (transient [])
(process-curve start-x h1-x h2-x end-x)
(process-curve start-y h1-y h2-y end-y)
(persistent!))))
(defn curve-tangent
"Retrieve the tangent vector to the curve in the point `t`"
[[start end h1 h2] t]

86
common/src/app/common/types/path/segment.cljc
View file

@ -838,40 +838,62 @@
(let [transform (gmt/translate-matrix move-vec)]
(transform-content content transform)))
;; FIXME: add optimizations
(defn calculate-extremities
"Calculate extremities for the provided content"
[content]
(loop [points (transient #{})
content (not-empty (vec content))
from-p nil
move-p nil]
(if content
(let [last-p (peek content)
content (if (= :move-to (:command last-p))
(pop content)
content)
segment (get content 0)
to-p (helpers/segment->point segment)]
(if segment
(case (:command segment)
:move-to
(recur (conj! points to-p)
(not-empty (subvec content 1))
to-p
to-p)
:close-path
(recur (conj! points move-p)
(not-empty (subvec content 1))
move-p
move-p)
:line-to
(recur (cond-> points
(and from-p to-p)
(-> (conj! move-p)
(conj! to-p)))
(not-empty (subvec content 1))
to-p
move-p)
:curve-to
(let [c1 (helpers/segment->point segment :c1)
c2 (helpers/segment->point segment :c2)]
(recur (if (and from-p to-p c1 c2)
(reduce conj!
(-> points (conj! from-p) (conj! to-p))
(helpers/calculate-curve-extremities from-p to-p c1 c2))
points)
(not-empty (subvec content 1))
to-p
move-p)))
(persistent! points)))
(persistent! points))))
(defn content->selrect
[content]
(let [extremities
(loop [points #{}
from-p nil
move-p nil
content (seq content)]
(if content
(let [last-p (last content)
content (if (= :move-to (:command last-p))
(butlast content)
content)
command (first content)
to-p (helpers/command->point command)
[from-p move-p command-pts]
(case (:command command)
:move-to [to-p to-p (when to-p [to-p])]
:close-path [move-p move-p (when move-p [move-p])]
:line-to [to-p move-p (when (and from-p to-p) [from-p to-p])]
:curve-to [to-p move-p
(let [c1 (helpers/command->point command :c1)
c2 (helpers/command->point command :c2)
curve [from-p to-p c1 c2]]
(when (and from-p to-p c1 c2)
(into [from-p to-p]
(->> (helpers/curve-extremities curve)
(map #(helpers/curve-values curve %))))))]
[to-p move-p []])]
(recur (apply conj points command-pts) from-p move-p (next content)))
points))
(let [extremities (calculate-extremities content)
;; We haven't found any extremes so we turn the commands to points
extremities
(if (empty? extremities)

77
common/test/common_tests/types/path_data_test.cljc
View file

@ -14,6 +14,8 @@
[app.common.pprint :as pp]
[app.common.transit :as trans]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.impl :as path.impl]
[app.common.types.path.segment :as path.segment]
[clojure.test :as t]))
@ -199,3 +201,78 @@
(t/is (= result1 result2))
(t/is (= result2 result3))))
(defn calculate-extremities
"Calculate extremities for the provided content.
A legacy implementation used mainly as reference for testing"
[content]
(loop [points #{}
from-p nil
move-p nil
content (seq content)]
(if content
(let [last-p (last content)
content (if (= :move-to (:command last-p))
(butlast content)
content)
command (first content)
to-p (path.helpers/command->point command)
[from-p move-p command-pts]
(case (:command command)
:move-to [to-p to-p (when to-p [to-p])]
:close-path [move-p move-p (when move-p [move-p])]
:line-to [to-p move-p (when (and from-p to-p) [from-p to-p])]
:curve-to [to-p move-p
(let [c1 (path.helpers/command->point command :c1)
c2 (path.helpers/command->point command :c2)
curve [from-p to-p c1 c2]]
(when (and from-p to-p c1 c2)
(into [from-p to-p]
(->> (path.helpers/curve-extremities curve)
(map #(path.helpers/curve-values curve %))))))]
[to-p move-p []])]
(recur (apply conj points command-pts) from-p move-p (next content)))
points)))
(t/deftest extremities-1
(let [pdata (path/content sample-content)
result1 (calculate-extremities sample-content)
result2 (calculate-extremities pdata)
result3 (path.segment/calculate-extremities sample-content)
result4 (path.segment/calculate-extremities pdata)
expect #{(gpt/point 480.0 839.0)
(gpt/point 439.0 802.0)
(gpt/point 264.0 634.0)}
n-iter 100000]
(t/is (= result1 result3))
(t/is (= result1 expect))
(t/is (= result2 expect))
(t/is (= result3 expect))
(t/is (= result4 expect))))
(def sample-content-2
[{:command :move-to, :params {:x 480.0, :y 839.0}}
{:command :line-to, :params {:x 439.0, :y 802.0}}
{:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 4.0, :y 4.0}}
{:command :curve-to, :params {:c1x 3.0, :c1y 7.0, :c2x 30.0, :c2y -68.0, :x 20.0, :y 20.0}}
{:command :close-path :params {}}])
(t/deftest extremities-2
(let [result1 (path.segment/calculate-extremities sample-content-2)
result2 (calculate-extremities sample-content-2)]
(t/is (= result1 result2))))
(t/deftest extremities-3
(let [segments [{:command :move-to, :params {:x -310.5355224609375, :y 452.62115478515625}}]
content (path/content segments)
result1 (calculate-extremities segments)
result2 (path.segment/calculate-extremities segments)
result3 (path.segment/calculate-extremities content)
expect #{}]
(t/is (= result1 expect))
(t/is (= result1 expect))
(t/is (= result2 expect))
(t/is (= result3 expect))))