mirror of
https://github.com/penpot/penpot.git
synced 2025-05-15 19:26:38 +02:00
✨ Union,intersection,difference
This commit is contained in:
alonso.torres
parent
df60ee06a1
commit
1db2895606
12 changed files with 488 additions and 272 deletions
|
|
@ -168,26 +168,6 @@
|
|||
(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]
|
||||
|
|
|
|||
|
|
@ -7,10 +7,28 @@
|
|||
(ns app.common.geom.shapes.path
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.rect :as gpr]
|
||||
[app.common.math :as mth]))
|
||||
|
||||
(def ^:const curve-curve-precision 0.1)
|
||||
|
||||
(defn line-values
|
||||
[[from-p to-p] t]
|
||||
(let [move-v (-> (gpt/to-vec from-p to-p)
|
||||
(gpt/scale t))]
|
||||
(gpt/add from-p move-v)))
|
||||
|
||||
(defn line-windup
|
||||
[[_ to-p :as l] t]
|
||||
(let [p (line-values l t)
|
||||
v (gpt/to-vec p to-p)]
|
||||
(cond
|
||||
(> (:y v) 0) 1
|
||||
(< (:y v) 0) -1
|
||||
:else 0)))
|
||||
|
||||
;; https://medium.com/@Acegikmo/the-ever-so-lovely-b%C3%A9zier-curve-eb27514da3bf
|
||||
;; https://en.wikipedia.org/wiki/Bernstein_polynomial
|
||||
(defn curve-values
|
||||
|
|
@ -37,6 +55,39 @@
|
|||
|
||||
(gpt/point (coord-v :x) (coord-v :y)))))
|
||||
|
||||
(defn curve-tangent
|
||||
"Retrieve the tangent vector to the curve in the point `t`"
|
||||
[[start end h1 h2] t]
|
||||
|
||||
(let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
|
||||
[(:y start) (:y h1) (:y h2) (:y end)]]
|
||||
|
||||
solve-derivative
|
||||
(fn [[c0 c1 c2 c3]]
|
||||
;; Solve B'(t) given t to retrieve the value for the
|
||||
;; first derivative
|
||||
(let [t2 (* t t)]
|
||||
(+ (* c0 (+ (* -3 t2) (* 6 t) -3))
|
||||
(* c1 (+ (* 9 t2) (* -12 t) 3))
|
||||
(* c2 (+ (* -9 t2) (* 6 t)))
|
||||
(* c3 (* 3 t2)))))
|
||||
|
||||
[x y] (->> coords (mapv solve-derivative))
|
||||
|
||||
;; normalize value
|
||||
d (mth/sqrt (+ (* x x) (* y y)))]
|
||||
|
||||
(gpt/point (/ x d) (/ y d))))
|
||||
|
||||
(defn curve-windup
|
||||
[curve t]
|
||||
|
||||
(let [tangent (curve-tangent curve t)]
|
||||
(cond
|
||||
(> (:y tangent) 0) 1
|
||||
(< (:y tangent) 0) -1
|
||||
:else 0)))
|
||||
|
||||
(defn curve-split
|
||||
"Splits a curve into two at the given parametric value `t`.
|
||||
Calculates the Casteljau's algorithm intermediate points"
|
||||
|
|
@ -184,7 +235,8 @@
|
|||
(mapcat coord->tvalue)
|
||||
|
||||
;; Only values in the range [0, 1] are valid
|
||||
(filterv #(and (> % 0.01) (< % 0.99)))))))
|
||||
#_(filterv #(and (> % 0.01) (< % 0.99)))
|
||||
(filterv #(and (>= % 0) (<= % 1)))))))
|
||||
|
||||
(defn command->point
|
||||
([command] (command->point command nil))
|
||||
|
|
@ -196,6 +248,21 @@
|
|||
y (get params ykey)]
|
||||
(gpt/point x y))))
|
||||
|
||||
(defn command->line
|
||||
([cmd]
|
||||
(command->line cmd (:prev cmd)))
|
||||
([cmd prev]
|
||||
[prev (command->point cmd)]))
|
||||
|
||||
(defn command->bezier
|
||||
([cmd]
|
||||
(command->bezier cmd (:prev cmd)))
|
||||
([cmd prev]
|
||||
[prev
|
||||
(command->point cmd)
|
||||
(gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y))
|
||||
(gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))]))
|
||||
|
||||
(defn content->selrect [content]
|
||||
(let [calc-extremities
|
||||
(fn [command prev]
|
||||
|
|
@ -422,3 +489,184 @@
|
|||
(reduce find-min-point)
|
||||
(first))))
|
||||
|
||||
(defn- get-line-tval
|
||||
[[{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- curve-range->rect
|
||||
[curve from-t to-t]
|
||||
|
||||
(let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
|
||||
extremes (->> (curve-extremities curve)
|
||||
(mapv #(curve-values curve %)))]
|
||||
(gpr/points->rect (into [from-p to-p] extremes))))
|
||||
|
||||
|
||||
(defn line-line-crossing
|
||||
[[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]]
|
||||
|
||||
(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)
|
||||
;; Coordinates in the line. We calculate the tvalue that will
|
||||
;; return 0-1 as a percentage in the segment
|
||||
(let [cross-p (gpt/point (/ nx d) (/ ny d))
|
||||
t1 (get-line-tval l1 cross-p)
|
||||
t2 (get-line-tval l2 cross-p)]
|
||||
[t1 t2]))))
|
||||
|
||||
(defn line-curve-crossing
|
||||
[[from-p1 to-p1]
|
||||
[from-p2 to-p2 h1-p2 h2-p2]]
|
||||
|
||||
(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-roots c2' :y)))
|
||||
|
||||
(defn ray-line-intersect
|
||||
[point line]
|
||||
|
||||
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
|
||||
[ray-t line-t] (line-line-crossing ray-line line)]
|
||||
|
||||
(when (and (some? line-t) (> ray-t 0) (>= line-t 0) (< line-t 1))
|
||||
[[(line-values line line-t)
|
||||
(line-windup line line-t)]])))
|
||||
|
||||
(defn line-line-intersect
|
||||
[l1 l2]
|
||||
|
||||
(let [[l1-t l2-t] (line-line-crossing l1 l2)]
|
||||
(when (and (some? l1-t) (some? l2-t)
|
||||
(> l1-t 0.01) (< l1-t 0.99)
|
||||
(> l2-t 0.01) (< l2-t 0.99))
|
||||
[[l1-t] [l2-t]])))
|
||||
|
||||
(defn ray-curve-intersect
|
||||
[ray-line c2]
|
||||
|
||||
(let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))]
|
||||
curve-ts (->> (line-curve-crossing ray-line c2)
|
||||
(filterv #(let [curve-v (curve-values c2 %)
|
||||
curve-tg (curve-tangent c2 %)
|
||||
curve-tg-angle (gpt/angle curve-tg)
|
||||
ray-t (get-line-tval ray-line curve-v)]
|
||||
(and (> ray-t 0)
|
||||
(> (mth/abs (- curve-tg-angle 180)) 0.01)
|
||||
(> (mth/abs (- curve-tg-angle 0)) 0.01)) )))]
|
||||
(->> curve-ts
|
||||
(mapv #(vector (curve-values c2 %)
|
||||
(curve-windup c2 %))))))
|
||||
|
||||
(defn line-curve-intersect
|
||||
[l1 c2]
|
||||
(let [curve-ts (->> (line-curve-crossing l1 c2)
|
||||
(filterv #(let [curve-v (curve-values c2 %)
|
||||
line-t (get-line-tval l1 curve-v)]
|
||||
(and (> line-t 0.001) (< line-t 0.999)))))
|
||||
;; Intersection line-curve points
|
||||
intersect-ps (->> curve-ts
|
||||
(mapv #(curve-values c2 %)))
|
||||
|
||||
line-ts (->> intersect-ps
|
||||
(mapv #(get-line-tval 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 (gpr/overlaps-rects? r1 r2)
|
||||
(if (< (gpt/distance (curve-values c1 c1-from)
|
||||
(curve-values c2 c2-from))
|
||||
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 curve->rect
|
||||
[[from-p to-p :as curve]]
|
||||
(let [extremes (->> (curve-extremities curve)
|
||||
(mapv #(curve-values curve %)))]
|
||||
(gpr/points->rect (into [from-p to-p] extremes))))
|
||||
|
||||
|
||||
(defn is-point-in-content?
|
||||
[point content]
|
||||
|
||||
(letfn [(cast-ray [[cmd prev]]
|
||||
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]]
|
||||
(case (:command cmd)
|
||||
:line-to (ray-line-intersect point (command->line cmd (command->point prev)))
|
||||
:curve-to (ray-curve-intersect ray-line (command->bezier cmd (command->point prev)))
|
||||
#_:else [])))]
|
||||
|
||||
;; non-zero windup rule
|
||||
(->> (d/with-prev content)
|
||||
(mapcat cast-ray)
|
||||
(map second)
|
||||
(reduce +)
|
||||
(not= 0))))
|
||||
|
|
|
|||
|
|
@ -70,3 +70,23 @@
|
|||
:y (- (:y center) (/ height 2))
|
||||
:width width
|
||||
:height height})
|
||||
|
||||
(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))))
|
||||
|
|
|
|||
|
|
@ -262,19 +262,19 @@
|
|||
:fn #(st/emit! (dw/toggle-distances-display false))}
|
||||
|
||||
:boolean-union {:tooltip (ds/alt "U")
|
||||
:command ["alt" "u"]
|
||||
:command "alt+u"
|
||||
:fn #(st/emit! (dw/create-bool :union))}
|
||||
|
||||
:boolean-difference {:tooltip (ds/alt "D")
|
||||
:command ["alt" "d"]
|
||||
:command "alt+d"
|
||||
:fn #(st/emit! (dw/create-bool :difference))}
|
||||
|
||||
:boolean-intersection {:tooltip (ds/alt "I")
|
||||
:command ["alt" "i"]
|
||||
:command "alt+i"
|
||||
:fn #(st/emit! (dw/create-bool :intersection))}
|
||||
|
||||
:boolean-exclude {:tooltip (ds/alt "E")
|
||||
:command ["alt" "e"]
|
||||
:command "alt+e"
|
||||
:fn #(st/emit! (dw/create-bool :exclude))}
|
||||
|
||||
})
|
||||
|
|
|
|||
|
|
@ -122,6 +122,10 @@
|
|||
:show-distances?])
|
||||
workspace-local =))
|
||||
|
||||
(def local-displacement
|
||||
(l/derived #(select-keys % [:modifiers :selected])
|
||||
workspace-local =))
|
||||
|
||||
(def selected-zoom
|
||||
(l/derived :zoom workspace-local))
|
||||
|
||||
|
|
|
|||
|
|
@ -26,18 +26,26 @@
|
|||
(let [shape-1 (stp/convert-to-path (nth childs 0))
|
||||
shape-2 (stp/convert-to-path (nth childs 1))
|
||||
|
||||
content-1 (use-equal-memo (-> shape-1 :content gsh/transform-shape))
|
||||
content-2 (use-equal-memo (-> shape-2 :content gsh/transform-shape))
|
||||
content-1 (use-equal-memo (-> shape-1 gsh/transform-shape :content))
|
||||
content-2 (use-equal-memo (-> shape-2 gsh/transform-shape :content))
|
||||
|
||||
content
|
||||
(mf/use-memo
|
||||
(mf/deps content-1 content-2)
|
||||
#(pb/content-bool (:bool-type shape) content-1 content-2))]
|
||||
|
||||
[:*
|
||||
[:& shape-wrapper {:shape (-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content))
|
||||
:frame frame}])))))
|
||||
:frame frame}]
|
||||
|
||||
#_[:g
|
||||
(for [point (app.util.path.geom/content->points content)]
|
||||
[:circle {:cx (:x point)
|
||||
:cy (:y point)
|
||||
:r 1
|
||||
:style {:fill "blue"}}])]])))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,16 @@
|
|||
frame (unchecked-get props "frame")
|
||||
|
||||
childs-ref (mf/use-memo (mf/deps shape) #(refs/objects-by-id (:shapes shape) {:with-modifiers? true}))
|
||||
childs (mf/deref childs-ref)]
|
||||
{:keys [selected modifiers]} (mf/deref refs/local-displacement)
|
||||
|
||||
add-modifiers
|
||||
(fn [{:keys [id] :as shape}]
|
||||
(cond-> shape
|
||||
(contains? selected id)
|
||||
(update :modifiers merge modifiers)))
|
||||
|
||||
childs (->> (mf/deref childs-ref)
|
||||
(mapv add-modifiers))]
|
||||
|
||||
[:> shape-container {:shape shape}
|
||||
[:& shape-component
|
||||
|
|
|
|||
|
|
@ -159,8 +159,13 @@
|
|||
(hooks/setup-shortcuts node-editing? drawing-path?)
|
||||
(hooks/setup-active-frames objects vbox hover active-frames)
|
||||
|
||||
|
||||
|
||||
[:div.viewport
|
||||
[:div.viewport-overlays
|
||||
|
||||
|
||||
|
||||
[:& wtr/frame-renderer {:objects objects
|
||||
:background background}]
|
||||
|
||||
|
|
@ -229,7 +234,6 @@
|
|||
:on-pointer-up on-pointer-up}
|
||||
|
||||
[:g {:style {:pointer-events (if disable-events? "none" "auto")}}
|
||||
|
||||
(when show-outlines?
|
||||
[:& outline/shape-outlines
|
||||
{:objects objects
|
||||
|
|
|
|||
|
|
@ -7,165 +7,12 @@
|
|||
(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.common.geom.shapes.path :as gsp]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.path.subpaths :as ups]))
|
||||
|
||||
(def ^:const curve-curve-precision 0.1)
|
||||
|
||||
(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 (< (gpt/distance (gpp/curve-values c1 c1-from)
|
||||
(gpp/curve-values c2 c2-from))
|
||||
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)
|
||||
|
|
@ -178,22 +25,22 @@
|
|||
(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))
|
||||
(gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->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))
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->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))]
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->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))
|
||||
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []])]
|
||||
|
|
@ -212,14 +59,12 @@
|
|||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gpp/command->point prev))))))))
|
||||
(assoc :prev (gsp/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]
|
||||
|
||||
|
|
@ -266,40 +111,110 @@
|
|||
(recur (first new-pending)
|
||||
(rest new-pending)
|
||||
new-content-b
|
||||
(conj new-content-a new-current))))))))
|
||||
(conj new-content-a new-current)))))))
|
||||
|
||||
(defn is-segment?
|
||||
[cmd]
|
||||
(and (contains? cmd :prev)
|
||||
(contains? #{:line-to :curve-to} (:command cmd))))
|
||||
|
||||
(defn create-union [content-a content-b]
|
||||
(defn contains-segment?
|
||||
[segment content]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
(gsp/is-point-in-content? point content)))
|
||||
|
||||
(defn create-union [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content-b that are not inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
content-a
|
||||
(ups/reverse-content content-b)))
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b))))
|
||||
(->> content-b-split (filter #(not (contains-segment? % content-a))))))
|
||||
|
||||
(defn create-difference [content-a content-b]
|
||||
(defn create-difference [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
content-a
|
||||
(ups/reverse-content content-b)))
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b))))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a)))))
|
||||
|
||||
(defn create-intersection [content-a content-b]
|
||||
(defn create-intersection [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are inside content-b
|
||||
;; Pick all segments in content-b that are inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
content-a
|
||||
(ups/reverse-content content-b)))
|
||||
(->> content-a-split (filter #(contains-segment? % content-b)))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a)))))
|
||||
|
||||
(defn reverse-command
|
||||
"Reverses a single command"
|
||||
[command]
|
||||
|
||||
(let [{old-x :x old-y :y} (:params command)
|
||||
{:keys [x y]} (:prev command)
|
||||
{:keys [c1x c1y c2x c2y]} (:params command)]
|
||||
|
||||
(-> command
|
||||
(assoc :prev (gpt/point old-x old-y))
|
||||
(update :params assoc :x x :y y)
|
||||
|
||||
(cond-> (= :curve-to (:command command))
|
||||
(update :params assoc
|
||||
:c1x c2x :c1y c2y
|
||||
:c2x c1x :c2y c1y)))))
|
||||
|
||||
(defn create-exclusion [content-a content-b]
|
||||
(d/concat
|
||||
[]
|
||||
content-a
|
||||
(ups/reverse-content content-b)))
|
||||
;; Pick all segments but reverse content-b (so it makes an exclusion)
|
||||
(let [content-b' (->> (reverse content-b)
|
||||
(mapv reverse-command))]
|
||||
(d/concat [] content-a content-b')))
|
||||
|
||||
|
||||
(defn fix-move-to
|
||||
[content]
|
||||
;; Remove the field `:prev` and makes the necesaries `move-to`
|
||||
;; then clean the subpaths
|
||||
|
||||
(loop [current (first content)
|
||||
content (rest content)
|
||||
prev nil
|
||||
result []]
|
||||
|
||||
(if (nil? current)
|
||||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (upc/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(gsp/command->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(defn content-bool
|
||||
[bool-type content-a content-b]
|
||||
|
||||
(let [[content-a' content-b'] (content-intersect-split content-a content-b)]
|
||||
(let [content-a (add-previous content-a)
|
||||
content-b (add-previous content-b)
|
||||
|
||||
;; Split content in new segments in the intersection with the other path
|
||||
[content-a-split content-b-split] (content-intersect-split content-a content-b)
|
||||
content-a-split (->> content-a-split add-previous (filter is-segment?))
|
||||
content-b-split (->> content-b-split add-previous (filter is-segment?))
|
||||
|
||||
bool-content
|
||||
(case bool-type
|
||||
:union (create-union content-a' content-b')
|
||||
:difference (create-difference content-a' content-b')
|
||||
:intersection (create-intersection content-a' content-b')
|
||||
:exclusion (create-exclusion content-a' content-b'))))
|
||||
:union (create-union content-a content-a-split content-b content-b-split)
|
||||
:difference (create-difference content-a content-a-split content-b content-b-split)
|
||||
:intersection (create-intersection content-a content-a-split content-b content-b-split)
|
||||
:exclude (create-exclusion content-a-split content-b-split))]
|
||||
|
||||
(->> (fix-move-to bool-content)
|
||||
(ups/close-subpaths))))
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
(ns app.util.path.format
|
||||
(:require
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.subpaths :refer [pt=]]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn command->param-list [command]
|
||||
|
|
@ -62,6 +63,12 @@
|
|||
(str command-str param-list)))
|
||||
|
||||
|
||||
(defn set-point
|
||||
[command point]
|
||||
(-> command
|
||||
(assoc-in [:params :x] (:x point))
|
||||
(assoc-in [:params :y] (:y point))))
|
||||
|
||||
(defn format-path [content]
|
||||
(with-out-str
|
||||
(loop [last-move nil
|
||||
|
|
@ -72,9 +79,12 @@
|
|||
(let [point (upc/command->point current)
|
||||
current-move? (= :move-to (:command current))
|
||||
last-move (if current-move? point last-move)]
|
||||
(print (command->string current))
|
||||
|
||||
(when (and (not current-move?) (= last-move point))
|
||||
(if (and (not current-move?) (pt= last-move point))
|
||||
(println (command->string (set-point current last-move)))
|
||||
(println (command->string current)))
|
||||
|
||||
(when (and (not current-move?) (pt= last-move point))
|
||||
(print "Z"))
|
||||
|
||||
(recur last-move
|
||||
|
|
|
|||
|
|
@ -46,24 +46,29 @@
|
|||
(let [to-p (upc/command->point cmd)]
|
||||
(->> (conj values 1)
|
||||
(mapv (fn [val]
|
||||
(upc/make-line-to (gpt/lerp from-p to-p val)))))))
|
||||
(-> (gpt/lerp from-p to-p val)
|
||||
#_(gpt/round 2)
|
||||
(upc/make-line-to)))))))
|
||||
|
||||
(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]
|
||||
(if (empty? values)
|
||||
[cmd]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
params (:params cmd)
|
||||
h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))]
|
||||
h2 (gpt/point (:c2x params) (:c2y params))
|
||||
|
||||
(->> (d/with-prev (conj values 1))
|
||||
values-set (->> (conj values 1) (into (sorted-set)))]
|
||||
(->> (d/with-prev values-set)
|
||||
(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')))))))
|
||||
(upc/make-curve-to (-> to-p #_(gpt/round 2)) h1' h2'))))))))
|
||||
|
||||
(defn opposite-handler
|
||||
"Calculates the coordinates of the opposite handler"
|
||||
|
|
|
|||
|
|
@ -7,8 +7,14 @@
|
|||
(ns app.util.path.subpaths
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.util.path.commands :as upc]))
|
||||
|
||||
(defn pt=
|
||||
"Check if two points are close"
|
||||
[p1 p2]
|
||||
(< (gpt/distance p1 p2) 0.1))
|
||||
|
||||
(defn make-subpath
|
||||
"Creates a subpath either from a single command or with all the data"
|
||||
([command]
|
||||
|
|
@ -76,7 +82,7 @@
|
|||
(defn subpaths-join
|
||||
"Join two subpaths together when the first finish where the second starts"
|
||||
[subpath other]
|
||||
(assert (= (:to subpath) (:from other)))
|
||||
(assert (pt= (:to subpath) (:from other)))
|
||||
(-> subpath
|
||||
(update :data d/concat (rest (:data other)))
|
||||
(assoc :to (:to other))))
|
||||
|
|
@ -88,15 +94,22 @@
|
|||
(let [merge-with-candidate
|
||||
(fn [[candidate result] current]
|
||||
(cond
|
||||
(= (:to current) (:from current))
|
||||
(pt= (:to current) (:from current))
|
||||
;; Subpath is already a closed path
|
||||
[candidate (conj result current)]
|
||||
|
||||
(= (:to candidate) (:from current))
|
||||
(pt= (:to candidate) (:from current))
|
||||
[(subpaths-join candidate current) result]
|
||||
|
||||
(= (:to candidate) (:to current))
|
||||
(pt= (:from candidate) (:to current))
|
||||
[(subpaths-join current candidate) result]
|
||||
|
||||
(pt= (:to candidate) (:to current))
|
||||
[(subpaths-join candidate (reverse-subpath current)) result]
|
||||
|
||||
(pt= (:from candidate) (:from current))
|
||||
[(subpaths-join (reverse-subpath current) candidate) result]
|
||||
|
||||
:else
|
||||
[candidate (conj result current)]))]
|
||||
|
||||
|
|
@ -114,7 +127,7 @@
|
|||
|
||||
(if (some? current)
|
||||
(let [[new-current new-subpaths]
|
||||
(if (= (:from current) (:to current))
|
||||
(if (pt= (:from current) (:to current))
|
||||
[current subpaths]
|
||||
(merge-paths current subpaths))]
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue