mirror of
https://github.com/penpot/penpot.git
synced 2025-03-15 17:21:17 -05:00
✨ Add utilities to calculate boolean shapes
This commit is contained in:
alonso.torres
parent
57245dd77e
commit
5031700af6
8 changed files with 532 additions and 103 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
270
frontend/src/app/util/path/bool.cljs
Normal file
270
frontend/src/app/util/path/bool.cljs
Normal file
|
|
@ -0,0 +1,270 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.util.path.bool
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.intersect :as gsi]
|
||||
[app.common.geom.shapes.path :as gpp]
|
||||
[app.common.geom.shapes.rect :as gpr]
|
||||
[app.common.math :as mth]
|
||||
[app.util.path.geom :as upg]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def ^:const curve-curve-precision 0.001)
|
||||
|
||||
(defn curve->rect
|
||||
[[from-p to-p :as curve]]
|
||||
(let [extremes (->> (gpp/curve-extremities curve)
|
||||
(mapv #(gpp/curve-values curve %)))]
|
||||
(gpr/points->rect (into [from-p to-p] extremes))))
|
||||
|
||||
(defn curve-range->rect
|
||||
[curve from-t to-t]
|
||||
|
||||
(let [[from-p to-p :as curve] (gpp/subcurve-range curve from-t to-t)
|
||||
extremes (->> (gpp/curve-extremities curve)
|
||||
(mapv #(gpp/curve-values curve %)))]
|
||||
(gpr/points->rect (into [from-p to-p] extremes))))
|
||||
|
||||
(defn line+point->tvalue
|
||||
[[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [x y]}]
|
||||
(if (mth/almost-zero? (- x2 x1))
|
||||
(/ (- y y1) (- y2 y1))
|
||||
(/ (- x x1) (- x2 x1))))
|
||||
|
||||
(defn line-line-intersect
|
||||
[[from-p1 to-p1] [from-p2 to-p2]]
|
||||
|
||||
(let [{x1 :x y1 :y} from-p1
|
||||
{x2 :x y2 :y} to-p1
|
||||
|
||||
{x3 :x y3 :y} from-p2
|
||||
{x4 :x y4 :y} to-p2
|
||||
|
||||
nx (- (* (- x3 x4) (- (* x1 y2) (* y1 x2)))
|
||||
(* (- x1 x2) (- (* x3 y4) (* y3 x4))))
|
||||
|
||||
ny (- (* (- y3 y4) (- (* x1 y2) (* y1 x2)))
|
||||
(* (- y1 y2) (- (* x3 y4) (* y3 x4))))
|
||||
|
||||
d (- (* (- x1 x2) (- y3 y4))
|
||||
(* (- y1 y2) (- x3 x4)))]
|
||||
|
||||
(when-not (mth/almost-zero? d)
|
||||
;; ix,iy are the coordinates in the line. We calculate the
|
||||
;; tvalue that will return 0-1 as a percentage in the segment
|
||||
|
||||
(let [ix (/ nx d)
|
||||
iy (/ ny d)
|
||||
t1 (if (mth/almost-zero? (- x2 x1))
|
||||
(/ (- iy y1) (- y2 y1))
|
||||
(/ (- ix x1) (- x2 x1)))
|
||||
t2 (if (mth/almost-zero? (- x4 x3))
|
||||
(/ (- iy y3) (- y4 y3))
|
||||
(/ (- ix x3) (- x4 x3)))]
|
||||
|
||||
(when (and (> t1 0) (< t1 1)
|
||||
(> t2 0) (< t2 1))
|
||||
[[t1] [t2]])))))
|
||||
|
||||
(defn line-curve-intersect
|
||||
[[from-p1 to-p1 :as l1]
|
||||
[from-p2 to-p2 h1-p2 h2-p2 :as c2]]
|
||||
|
||||
|
||||
(let [theta (-> (mth/atan2 (- (:y to-p1) (:y from-p1))
|
||||
(- (:x to-p1) (:x from-p1)))
|
||||
(mth/degrees))
|
||||
|
||||
transform (-> (gmt/matrix)
|
||||
(gmt/rotate (- theta))
|
||||
(gmt/translate (gpt/negate from-p1)))
|
||||
|
||||
c2' [(gpt/transform from-p2 transform)
|
||||
(gpt/transform to-p2 transform)
|
||||
(gpt/transform h1-p2 transform)
|
||||
(gpt/transform h2-p2 transform)]
|
||||
|
||||
;; Curve intersections as t-values
|
||||
curve-ts (->> (gpp/curve-roots c2' :y)
|
||||
(filterv #(let [curve-v (gpp/curve-values c2 %)
|
||||
line-t (line+point->tvalue l1 curve-v)]
|
||||
(and (> line-t 0.001) (< line-t 0.999)))))
|
||||
|
||||
;; Intersection line-curve points
|
||||
intersect-ps (->> curve-ts
|
||||
(mapv #(gpp/curve-values c2 %)))
|
||||
|
||||
line-ts (->> intersect-ps
|
||||
(mapv #(line+point->tvalue l1 %)))]
|
||||
|
||||
[line-ts curve-ts]))
|
||||
|
||||
(defn curve-curve-intersect
|
||||
[c1 c2]
|
||||
|
||||
(letfn [(remove-close-ts [ts]
|
||||
(loop [current (first ts)
|
||||
pending (rest ts)
|
||||
acc nil
|
||||
result []]
|
||||
(if (nil? current)
|
||||
result
|
||||
(if (and (some? acc)
|
||||
(< (mth/abs (- current acc)) 0.01))
|
||||
(recur (first pending)
|
||||
(rest pending)
|
||||
acc
|
||||
result)
|
||||
|
||||
(recur (first pending)
|
||||
(rest pending)
|
||||
current
|
||||
(conj result current))))))
|
||||
|
||||
(check-range [c1-from c1-to c2-from c2-to]
|
||||
(let [r1 (curve-range->rect c1 c1-from c1-to)
|
||||
r2 (curve-range->rect c2 c2-from c2-to)]
|
||||
|
||||
(when (gsi/overlaps-rects? r1 r2)
|
||||
|
||||
(if (and (< (mth/abs (- c1-from c1-to)) curve-curve-precision)
|
||||
(< (mth/abs (- c2-from c2-to)) curve-curve-precision))
|
||||
|
||||
[(sorted-set (mth/precision c1-from 4))
|
||||
(sorted-set (mth/precision c2-from 4))]
|
||||
|
||||
(let [c1-half (+ c1-from (/ (- c1-to c1-from) 2))
|
||||
c2-half (+ c2-from (/ (- c2-to c2-from) 2))
|
||||
|
||||
[c1-ts-1 c2-ts-1] (check-range c1-from c1-half c2-from c2-half)
|
||||
[c1-ts-2 c2-ts-2] (check-range c1-from c1-half c2-half c2-to)
|
||||
[c1-ts-3 c2-ts-3] (check-range c1-half c1-to c2-from c2-half)
|
||||
[c1-ts-4 c2-ts-4] (check-range c1-half c1-to c2-half c2-to)]
|
||||
|
||||
[(into (sorted-set) (d/concat [] c1-ts-1 c1-ts-2 c1-ts-3 c1-ts-4))
|
||||
(into (sorted-set) (d/concat [] c2-ts-1 c2-ts-2 c2-ts-3 c2-ts-4))])))))]
|
||||
|
||||
(let [[c1-ts c2-ts] (check-range 0.005 0.995 0.005 0.995)
|
||||
c1-ts (remove-close-ts c1-ts)
|
||||
c2-ts (remove-close-ts c2-ts)]
|
||||
[c1-ts c2-ts])))
|
||||
|
||||
(defn- line-to->line
|
||||
[cmd]
|
||||
[(:prev cmd) (gpp/command->point cmd)])
|
||||
|
||||
(defn- curve-to->bezier
|
||||
[cmd]
|
||||
[(:prev cmd)
|
||||
(gpp/command->point cmd)
|
||||
(gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y))
|
||||
(gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))])
|
||||
|
||||
(defn- split-command
|
||||
[cmd values]
|
||||
(case (:command cmd)
|
||||
:line-to (upg/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (upg/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
[cmd]))
|
||||
|
||||
(defn split [seg-1 seg-2]
|
||||
(let [[ts-seg-1 ts-seg-2]
|
||||
(cond
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(line-line-intersect (line-to->line seg-1) (line-to->line seg-2))
|
||||
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(line-curve-intersect (line-to->line seg-1) (curve-to->bezier seg-2))
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(let [[seg-2' seg-1']
|
||||
(line-curve-intersect (line-to->line seg-2) (curve-to->bezier seg-1))]
|
||||
;; Need to reverse because we send the arguments reversed
|
||||
[seg-1' seg-2'])
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(curve-curve-intersect (curve-to->bezier seg-1) (curve-to->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []])]
|
||||
|
||||
[(split-command seg-1 ts-seg-1)
|
||||
(split-command seg-2 ts-seg-2)]))
|
||||
|
||||
(defn add-previous
|
||||
([content]
|
||||
(add-previous content nil))
|
||||
([content first]
|
||||
(->> (d/with-prev content)
|
||||
(mapv (fn [[cmd prev]]
|
||||
(cond-> cmd
|
||||
(and (nil? prev) (some? first))
|
||||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gpp/command->point prev))))))))
|
||||
|
||||
(defn content-intersect-split
|
||||
"Given two path contents will return the intersect between them"
|
||||
[content-a content-b]
|
||||
|
||||
(let [content-a (add-previous content-a)
|
||||
content-b (add-previous content-b)]
|
||||
(if (or (empty? content-a) (empty? content-b))
|
||||
[content-a content-b]
|
||||
|
||||
(loop [current (first content-a)
|
||||
pending (rest content-a)
|
||||
content-b content-b
|
||||
new-content-a []]
|
||||
|
||||
(if (not (some? current))
|
||||
[new-content-a content-b]
|
||||
|
||||
(let [[new-current new-pending new-content-b]
|
||||
|
||||
(loop [current current
|
||||
pending pending
|
||||
other (first content-b)
|
||||
head-content []
|
||||
tail-content (rest content-b)]
|
||||
|
||||
(if (not (some? other))
|
||||
;; Finished recorring second content
|
||||
[current pending head-content]
|
||||
|
||||
;; We split the current
|
||||
(let [[new-as new-bs] (split current other)
|
||||
new-as (add-previous new-as (:prev current))
|
||||
new-bs (add-previous new-bs (:prev other))]
|
||||
|
||||
(if (> (count new-as) 1)
|
||||
;; We add the new-a's to the stack and change the b then we iterate to the top
|
||||
(recur (first new-as)
|
||||
(d/concat [] (rest new-as) pending)
|
||||
(first tail-content)
|
||||
(d/concat [] head-content new-bs)
|
||||
(rest tail-content))
|
||||
|
||||
;; No current segment-segment split we continue searching
|
||||
(recur current
|
||||
pending
|
||||
(first tail-content)
|
||||
(conj head-content other)
|
||||
(rest tail-content))))))]
|
||||
|
||||
(recur (first new-pending)
|
||||
(rest new-pending)
|
||||
new-content-b
|
||||
(conj new-content-a new-current))))))))
|
||||
|
|
@ -6,6 +6,7 @@
|
|||
|
||||
(ns app.util.path.geom
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[app.util.path.commands :as upc]))
|
||||
|
|
@ -16,21 +17,54 @@
|
|||
(let [handler-vector (gpt/to-vec point handler)]
|
||||
(gpt/add point (gpt/negate handler-vector))))
|
||||
|
||||
(defn split-line-to [from-p cmd val]
|
||||
(defn split-line-to
|
||||
"Given a point and a line-to command will create a two new line-to commands
|
||||
that will split the original line into two given a value between 0-1"
|
||||
[from-p cmd t-val]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
sp (gpt/line-val from-p to-p val)]
|
||||
sp (gpt/lerp from-p to-p t-val)]
|
||||
[(upc/make-line-to sp) cmd]))
|
||||
|
||||
(defn split-curve-to [from-p cmd val]
|
||||
(defn split-curve-to
|
||||
"Given the point and a curve-to command will split the curve into two new
|
||||
curve-to commands given a value between 0-1"
|
||||
[from-p cmd t-val]
|
||||
(let [params (:params cmd)
|
||||
end (gpt/point (:x params) (:y params))
|
||||
h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))
|
||||
[[_ to1 h11 h21]
|
||||
[_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)]
|
||||
[_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 t-val)]
|
||||
[(upc/make-curve-to to1 h11 h21)
|
||||
(upc/make-curve-to to2 h12 h22)]))
|
||||
|
||||
(defn split-line-to-ranges
|
||||
"Splits a line into several lines given the points in `values`
|
||||
for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split
|
||||
the line into 4 lines"
|
||||
[from-p cmd values]
|
||||
(let [to-p (upc/command->point cmd)]
|
||||
(->> (conj values 1)
|
||||
(mapv (fn [val]
|
||||
(upc/make-line-to (gpt/lerp from-p to-p val)))))))
|
||||
|
||||
(defn split-curve-to-ranges
|
||||
"Splits a curve into several curves given the points in `values`
|
||||
for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split
|
||||
the curve into 4 curves that draw the same curve"
|
||||
[from-p cmd values]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
params (:params cmd)
|
||||
h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))]
|
||||
|
||||
(->> (d/with-prev (conj values 1))
|
||||
(mapv
|
||||
(fn [[t1 t0]]
|
||||
(let [t0 (if (nil? t0) 0 t0)
|
||||
[_ to-p h1' h2'] (gshp/subcurve-range from-p to-p h1 h2 t0 t1)]
|
||||
(upc/make-curve-to to-p h1' h2')))))))
|
||||
|
||||
(defn opposite-handler
|
||||
"Calculates the coordinates of the opposite handler"
|
||||
[point handler]
|
||||
|
|
@ -47,9 +81,12 @@
|
|||
(gpt/point old-distance))]
|
||||
(gpt/add point phv2)))
|
||||
|
||||
(defn content->points [content]
|
||||
(defn content->points
|
||||
"Returns the points in the given content"
|
||||
[content]
|
||||
(->> content
|
||||
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
|
||||
(map #(when (-> % :params :x)
|
||||
(gpt/point (-> % :params :x) (-> % :params :y))))
|
||||
(remove nil?)
|
||||
(into [])))
|
||||
|
||||
|
|
|
|||
|
|
@ -210,7 +210,7 @@
|
|||
(case (:command cmd)
|
||||
:line-to [index (upg/split-line-to start cmd value)]
|
||||
:curve-to [index (upg/split-curve-to start cmd value)]
|
||||
:close-path [index [(upc/make-line-to (gpt/line-val start end value)) cmd]]
|
||||
:close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]]
|
||||
nil))
|
||||
|
||||
cmd-changes
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue