CalvinBackup/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-03-28 06:10:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

✨ Add utilities to calculate boolean shapes

Browse Source
This commit is contained in:
alonso.torres
2021-09-09 14:42:05 +02:00
parent 57245dd77e
commit 5031700af6
8 changed files with 532 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
common/src/app/common/geom/point.cljc
View File

@@ -22,7 +22,8 @@
(defn ^boolean point?
"Return true if `v` is Point instance."
[v]
(instance? Point v))
(or (instance? Point v)
(and (map? v) (contains? v :x) (contains? v :y))))
(defn ^boolean point-like?
[{:keys [x y] :as v}]
@@ -257,15 +258,12 @@
(and (mth/almost-zero? x)
(mth/almost-zero? y)))
(defn line-val
"Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector
generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return
the point (0.25, 0.25)"
[p1 p2 v]
(let [v (-> (to-vec p1 p2)
(scale v))]
(add p1 v)))
(defn lerp
"Calculates a linear interpolation between two points given a tvalue"
[p1 p2 t]
(let [x (mth/lerp (:x p1) (:x p2) t)
y (mth/lerp (:y p1) (:y p2) t)]
(point x y)))
(defn rotate
"Rotates the point around center with an angle"

1
common/src/app/common/geom/shapes.cljc
View File

@@ -156,7 +156,6 @@
(d/export gtr/calc-child-modifiers)
;; PATHS
(d/export gsp/content->points)
(d/export gsp/content->selrect)
(d/export gsp/transform-content)

21
common/src/app/common/geom/shapes/intersect.cljc
View File

@@ -168,6 +168,26 @@
(is-point-inside-evenodd? (first points) rect-lines)
(intersects-lines? rect-lines points-lines))))
(defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top"
[rect-a rect-b]
(let [x1a (:x rect-a)
y1a (:y rect-a)
x2a (+ (:x rect-a) (:width rect-a))
y2a (+ (:y rect-a) (:height rect-a))
x1b (:x rect-b)
y1b (:y rect-b)
x2b (+ (:x rect-b) (:width rect-b))
y2b (+ (:y rect-b) (:height rect-b))]
(and (> x2a x1b)
(> x2b x1a)
(> y2a y1b)
(> y2b y1a))))
(defn overlaps-path?
"Checks if the given rect overlaps with the path in any point"
[shape rect]
@@ -308,3 +328,4 @@
(->> shape
:points
(every? (partial has-point-rect? rect))))

251
common/src/app/common/geom/shapes/path.cljc
View File

@@ -11,93 +11,180 @@
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]))
(defn content->points [content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))
;; https://medium.com/@Acegikmo/the-ever-so-lovely-b%C3%A9zier-curve-eb27514da3bf
;; https://en.wikipedia.org/wiki/Bernstein_polynomial
(defn curve-values
"Parametric equation for cubic beziers. Given a start and end and
two intermediate points returns points for values of t.
If you draw t on a plane you got the bezier cube"
[start end h1 h2 t]
([[start end h1 h2] t]
(curve-values start end h1 h2 t))
(let [t2 (* t t) ;; t square
t3 (* t2 t) ;; t cube
([start end h1 h2 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
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
coord-v (fn [coord]
(+ (* (coord start) start-v)
(* (coord h1) h1-v)
(* (coord h2) h2-v)
(* (coord end) end-v)))]
coord-v (fn [coord]
(+ (* (coord start) start-v)
(* (coord h1) h1-v)
(* (coord h2) h2-v)
(* (coord end) end-v)))]
(gpt/point (coord-v :x) (coord-v :y))))
(gpt/point (coord-v :x) (coord-v :y)))))
(defn curve-split
"Splits a curve into two at the given parametric value `t`.
Calculates the Casteljau's algorithm intermediate points"
[start end h1 h2 t]
([[start end h1 h2] t]
(curve-split start end h1 h2 t))
(let [p1 (gpt/line-val start h1 t)
p2 (gpt/line-val h1 h2 t)
p3 (gpt/line-val h2 end t)
p4 (gpt/line-val p1 p2 t)
p5 (gpt/line-val p2 p3 t)
sp (gpt/line-val p4 p5 t)]
[[start sp p1 p4]
[sp end p5 p3]]))
([start end h1 h2 t]
(let [p1 (gpt/lerp start h1 t)
p2 (gpt/lerp h1 h2 t)
p3 (gpt/lerp h2 end t)
p4 (gpt/lerp p1 p2 t)
p5 (gpt/lerp p2 p3 t)
sp (gpt/lerp p4 p5 t)]
[[start sp p1 p4]
[sp end p5 p3]])))
(defn subcurve-range
"Given a curve returns a new curve between the values t1-t2"
([[start end h1 h2] [t1 t2]]
(subcurve-range start end h1 h2 t1 t2))
([[start end h1 h2] t1 t2]
(subcurve-range start end h1 h2 t1 t2))
([start end h1 h2 t1 t2]
;; Make sure that t2 is greater than t1
(let [[t1 t2] (if (< t1 t2) [t1 t2] [t2 t1])
t2' (/ (- t2 t1) (- 1 t1))
[_ curve'] (curve-split start end h1 h2 t1)]
(first (curve-split curve' t2')))))
;; 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]
(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))
[]
;; Linear solution
(and (mth/almost-zero? d) (mth/almost-zero? a))
[(/ (- c) b)]
;; Cuadratic
(mth/almost-zero? d)
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
(/ (- (- b) sqrt-b2-4ac)
(* 2 a))]
;; Cubic
:else
(let [a (/ a d)
b (/ b d)
c (/ c d)
p (/ (- (* 3 b) (* a a)) 3)
q (/ (+ (* 2 a a a) (* -9 a b) (* 27 c)) 27)
p3 (/ p 3)
q2 (/ q 2)
discriminant (+ (* q2 q2) (* p3 p3 p3))]
(cond
(< discriminant 0)
(let [mp3 (/ (- p) 3)
mp33 (* mp3 mp3 mp3)
r (mth/sqrt mp33)
t (/ (- q) (* 2 r))
cosphi (cond (< t -1) -1
(> t 1) 1
:else t)
phi (mth/acos cosphi)
crtr (mth/cubicroot r)
t1 (* 2 crtr)
root1 (- (* t1 (mth/cos (/ phi 3))) (/ a 3))
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])
(= discriminant 0)
(let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2)))
root1 (- (* 2 u1) (/ a 3))
root2 (- (- u1) (/ a 3))]
[root1 root2])
:else
(let [sd (mth/sqrt discriminant)
u1 (mth/cubicroot (- sd q2))
v1 (mth/cubicroot (+ sd q2))
root (- u1 v1 (/ a 3))]
[root])))))))
;; https://pomax.github.io/bezierinfo/#extremities
(defn curve-extremities
"Given a cubic bezier cube finds its roots in t. This are the extremities
if we calculate its values for x, y we can find a bounding box for the curve."
[start end h1 h2]
"Calculates the extremities by solving the first derivative for a cubic
bezier and then solving the quadratic formula"
([[start end h1 h2]]
(curve-extremities start end h1 h2))
(let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
[(:y start) (:y h1) (:y h2) (:y end)]]
([start end h1 h2]
coord->tvalue
(fn [[c0 c1 c2 c3]]
(let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
[(:y start) (:y h1) (:y h2) (:y end)]]
(let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
b (+ (* 6 c0) (* -12 c1) (* 6 c2))
c (+ (* 3 c1) (* -3 c0))
coord->tvalue
(fn [[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))]
sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
(solve-roots a b c)))]
(->> coords
(mapcat coord->tvalue)
(cond
(and (mth/almost-zero? a)
(not (mth/almost-zero? b)))
;; When the term a is close to zero we have a linear equation
[(/ (- c) b)]
;; Only values in the range [0, 1] are valid
(filterv #(and (> % 0.01) (< % 0.99)))))))
;; If a is not close to zero return the two roots for a cuadratic
(not (mth/almost-zero? a))
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
(/ (- (- b) sqrt-b2-4ac)
(* 2 a))]
(defn curve-roots
"Uses cardano algorithm to find the roots for a cubic bezier"
([[start end h1 h2] coord]
(curve-roots start end h1 h2 coord))
;; If a and b close to zero we can't find a root for a constant term
:else
[])))]
(->> coords
(mapcat coord->tvalue)
([start end h1 h2 coord]
;; Only values in the range [0, 1] are valid
(filter #(and (>= % 0) (<= % 1)))
(let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]]
;; Pass t-values to actual points
(map #(curve-values start end h1 h2 %)))
))
coord->tvalue
(fn [[pa pb pc pd]]
(let [a (+ (* 3 pa) (* -6 pb) (* 3 pc))
b (+ (* -3 pa) (* 3 pb))
c pa
d (+ (- pa) (* 3 pb) (* -3 pc) pd)]
(solve-roots a b c d)))]
(->> coords
(mapcat coord->tvalue)
;; Only values in the range [0, 1] are valid
(filterv #(and (> % 0.01) (< % 0.99)))))))
(defn command->point
([command] (command->point command nil))
@@ -123,10 +210,12 @@
:curve-to (d/concat
[(command->point prev)
(command->point command)]
(curve-extremities (command->point prev)
(command->point command)
(command->point command :c1)
(command->point command :c2)))
(let [curve [(command->point prev)
(command->point command)
(command->point command :c1)
(command->point command :c2)]]
(->> (curve-extremities curve)
(mapv #(curve-values curve %)))))
[]))
extremities (mapcat calc-extremities
@@ -302,24 +391,25 @@
"Given a path and a position"
[shape position]
(let [point+distance (fn [[cur-cmd prev-cmd]]
(let [from-p (command->point prev-cmd)
to-p (command->point cur-cmd)
h1 (gpt/point (get-in cur-cmd [:params :c1x])
(get-in cur-cmd [:params :c1y]))
h2 (gpt/point (get-in cur-cmd [:params :c2x])
(get-in cur-cmd [:params :c2y]))
point
(case (:command cur-cmd)
:line-to
(line-closest-point position from-p to-p)
(let [point+distance
(fn [[cur-cmd prev-cmd]]
(let [from-p (command->point prev-cmd)
to-p (command->point cur-cmd)
h1 (gpt/point (get-in cur-cmd [:params :c1x])
(get-in cur-cmd [:params :c1y]))
h2 (gpt/point (get-in cur-cmd [:params :c2x])
(get-in cur-cmd [:params :c2y]))
point
(case (:command cur-cmd)
:line-to
(line-closest-point position from-p to-p)
:curve-to
(curve-closest-point position from-p to-p h1 h2)
:curve-to
(curve-closest-point position from-p to-p h1 h2)
nil)]
(when point
[point (gpt/distance point position)])))
nil)]
(when point
[point (gpt/distance point position)])))
find-min-point (fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
@@ -331,3 +421,4 @@
(map point+distance)
(reduce find-min-point)
(first))))

23
common/src/app/common/math.cljc
View File

@@ -72,17 +72,24 @@
[v]
(* v v))
(defn pow
"Returns the base to the exponent power."
[b e]
#?(:cljs (js/Math.pow b e)
:clj (Math/pow b e)))
(defn sqrt
"Returns the square root of a number."
[v]
#?(:cljs (js/Math.sqrt v)
:clj (Math/sqrt v)))
(defn pow
"Returns the base to the exponent power."
[b e]
#?(:cljs (js/Math.pow b e)
:clj (Math/pow b e)))
(defn cubicroot
"Returns the cubic root of a number"
[v]
(if (pos? v)
(pow v (/ 1 3))
(- (pow (- v) (/ 1 3)))))
(defn floor
"Returns the largest integer less than or
@@ -151,3 +158,9 @@
"Equality for float numbers. Check if the difference is within a range"
[num1 num2]
(<= (abs (- num1 num2)) float-equal-precision))
(defn lerp
"Calculates a the linear interpolation between two values and a given percent"
[v0 v1 t]
(+ (* (- 1 t) v0)
(* t v1)))