mirror of
https://github.com/penpot/penpot.git
synced 2025-05-26 06:56:13 +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
|
|
@ -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}])))))
|
||||
[:*
|
||||
[:& shape-wrapper {:shape (-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content))
|
||||
: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,26 +25,26 @@
|
|||
(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
|
||||
[[] []])]
|
||||
|
||||
|
||||
[(split-command seg-1 ts-seg-1)
|
||||
(split-command seg-2 ts-seg-2)]))
|
||||
|
||||
|
|
@ -212,94 +59,162 @@
|
|||
(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]
|
||||
(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 []]
|
||||
(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]
|
||||
(if (not (some? current))
|
||||
[new-content-a content-b]
|
||||
|
||||
(let [[new-current new-pending new-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)]
|
||||
(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]
|
||||
(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))
|
||||
;; 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))]
|
||||
|
||||
;; No current segment-segment split we continue searching
|
||||
(recur current
|
||||
pending
|
||||
(first tail-content)
|
||||
(conj head-content other)
|
||||
(rest tail-content))))))]
|
||||
(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))
|
||||
|
||||
(recur (first new-pending)
|
||||
(rest new-pending)
|
||||
new-content-b
|
||||
(conj new-content-a new-current))))))))
|
||||
;; 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)))))))
|
||||
|
||||
(defn create-union [content-a content-b]
|
||||
(defn is-segment?
|
||||
[cmd]
|
||||
(and (contains? cmd :prev)
|
||||
(contains? #{:line-to :curve-to} (:command cmd))))
|
||||
|
||||
(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)]
|
||||
(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'))))
|
||||
(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-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]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
params (:params cmd)
|
||||
h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))]
|
||||
(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))
|
||||
|
||||
(->> (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')))))))
|
||||
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 #_(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