Skip to content

Commit b2bc970

Browse files
vipenzoclaude
vipenzo
and
claude
committed
Rewrite capped shape-fn: correct fillet profile, auto-fraction, safe inset
- Replace clipper offset + resample with centroid scaling, preserving shape proportions (fillet radii, arcs) during cap transitions - Fix fillet easing: use quarter-circle profile √(2τ-τ²) instead of sin(τ·π/2) which produced a nearly-flat/concave profile - Auto-calculate transition fraction from path length via dynamic var *path-length*, bound by loft at runtime (fraction = radius/pathLength) - Clamp inset to shape inradius to prevent degenerate geometry - Add shape-inradius and inset-vertices utilities in transform.cljs - Remove clipper dependency from shape_fn.cljs Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1 parent c514208 commit b2bc970

File tree

3 files changed

+125
-34
lines changed

3 files changed

+125
-34
lines changed

‎src/ridley/editor/operations.cljs‎

Lines changed: 16 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -279,18 +279,28 @@
279279
Bridges shape-fn API to existing loft pipeline."
280280
([shape-fn-val path] (pure-loft-shape-fn shape-fn-val path 16))
281281
([shape-fn-val path steps]
282-
(let [base-shape (shape-fn-val 0)
283-
transform-fn (fn [_shape t] (shape-fn-val t))]
284-
(pure-loft-path base-shape transform-fn path steps))))
282+
(let [path-length (reduce + 0 (keep (fn [cmd]
283+
(when (= :f (:cmd cmd))
284+
(first (:args cmd))))
285+
(:commands path)))]
286+
(binding [sfn/*path-length* path-length]
287+
(let [base-shape (shape-fn-val 0)
288+
transform-fn (fn [_shape t] (shape-fn-val t))]
289+
(pure-loft-path base-shape transform-fn path steps))))))
285290

286291
(defn ^:export pure-bloft-shape-fn
287292
"Bezier-safe loft with a shape-fn. Handles self-intersecting paths."
288293
([shape-fn-val path] (pure-bloft-shape-fn shape-fn-val path nil 0.1))
289294
([shape-fn-val path steps] (pure-bloft-shape-fn shape-fn-val path steps 0.1))
290295
([shape-fn-val path steps threshold]
291-
(let [base-shape (shape-fn-val 0)
292-
transform-fn (fn [_shape t] (shape-fn-val t))]
293-
(pure-bloft base-shape transform-fn path steps threshold))))
296+
(let [path-length (reduce + 0 (keep (fn [cmd]
297+
(when (= :f (:cmd cmd))
298+
(first (:args cmd))))
299+
(:commands path)))]
300+
(binding [sfn/*path-length* path-length]
301+
(let [base-shape (shape-fn-val 0)
302+
transform-fn (fn [_shape t] (shape-fn-val t))]
303+
(pure-bloft base-shape transform-fn path steps threshold))))))
294304

295305
(defn- clip-shape-for-revolve
296306
"Clip a shape to x >= 0 for revolve. Vertices with x < 0 would cross

‎src/ridley/turtle/shape_fn.cljs‎

Lines changed: 43 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,16 @@
1212
(loft (tapered (circle 20) :to 0) (f 30))"
1313
(:require [ridley.turtle.transform :as xform]
1414
[ridley.turtle.shape :as shape]
15-
[ridley.clipper.core :as clipper]))
15+
))
16+
17+
;; ============================================================
18+
;; Path-length context (set by loft at runtime)
19+
;; ============================================================
20+
21+
(def ^:dynamic *path-length*
22+
"Total path length in world units, bound by loft during shape-fn evaluation.
23+
Used by capped to auto-calculate transition fraction."
24+
nil)
1625

1726
;; ============================================================
1827
;; 2D vector math (private)
@@ -934,16 +943,25 @@
934943
With shapes that have holes, :preserve-holes true (default) keeps holes unchanged
935944
so only the outer boundary is affected."
936945
[shape-or-fn radius & {:keys [mode start end fraction end-radius preserve-holes]
937-
:or {mode :fillet start true end true fraction 0.08
946+
:or {mode :fillet start true end true
938947
preserve-holes true}}]
939948
(let [ease-fn (case mode
940-
:fillet (fn [u] (Math/sin (* u (/ Math/PI 2))))
949+
:fillet (fn [u] (Math/sqrt (- (* 2 u) (* u u))))
941950
:chamfer (fn [u] u))
942951
start-radius radius
943-
end-radius (or end-radius radius)]
952+
end-radius (or end-radius radius)
953+
explicit-fraction fraction]
944954
(shape-fn shape-or-fn
945955
(fn [s t]
946-
(let [[in-transition? u active-radius]
956+
;; Auto-calculate fraction from path length when not explicitly set
957+
(let [fraction (or explicit-fraction
958+
(when *path-length*
959+
(let [max-r (max (Math/abs start-radius) (Math/abs (or end-radius start-radius)))
960+
ideal (/ max-r *path-length*)]
961+
;; Cap at 0.45 to leave room for the middle section
962+
(min 0.45 ideal)))
963+
0.08)
964+
[in-transition? u active-radius]
947965
(cond
948966
(and start (< t fraction))
949967
[true (ease-fn (/ t fraction)) start-radius]
@@ -954,26 +972,23 @@
954972
:else [false 1.0 0])]
955973
(if (or (not in-transition?) (>= u 0.999))
956974
s
957-
(let [inset-amount (* (- active-radius) (- 1 u))
958-
inset-shape (clipper/shape-offset s inset-amount)]
959-
(if inset-shape
960-
(let [resampled (xform/resample-matched s inset-shape)
961-
orig-holes (:holes s)]
962-
(if orig-holes
963-
(if preserve-holes
964-
;; Keep original holes unchanged — only outer boundary changes
965-
(assoc resampled :holes orig-holes)
966-
;; Resample new holes to match original point counts
967-
(let [new-holes (or (:holes resampled) (:holes inset-shape))
968-
matched-holes
969-
(when (and new-holes (= (count new-holes) (count orig-holes)))
970-
(mapv (fn [orig-hole new-hole]
971-
(let [n-h (count orig-hole)]
972-
(:points (xform/resample
973-
(shape/make-shape new-hole {:centered? true})
974-
n-h))))
975-
orig-holes new-holes))]
976-
(cond-> resampled
977-
matched-holes (assoc :holes matched-holes))))
978-
resampled))
979-
s))))))))
975+
;; Scale shape toward centroid — preserves proportions (fillet radii etc.)
976+
;; The radius parameter controls how much the nearest edge moves inward.
977+
(let [inset-amount (* (Math/abs active-radius) (- 1 u))
978+
inradius (xform/shape-inradius s)
979+
scale (if (> inradius 0.001)
980+
(max 0.001 (/ (- inradius inset-amount) inradius))
981+
1.0)
982+
pts (:points s)
983+
n (count pts)
984+
cx (/ (reduce + (map first pts)) n)
985+
cy (/ (reduce + (map second pts)) n)
986+
scale-pt (fn [[x y]]
987+
[(+ cx (* scale (- x cx)))
988+
(+ cy (* scale (- y cy)))])
989+
scaled-points (mapv scale-pt pts)
990+
orig-holes (:holes s)]
991+
(cond-> (assoc s :points scaled-points)
992+
(and orig-holes (not preserve-holes))
993+
(assoc :holes (mapv (fn [hole] (mapv scale-pt hole))
994+
orig-holes))))))))))

‎src/ridley/turtle/transform.cljs‎

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,72 @@
105105
[(+ x1 (* t (- x2 x1)))
106106
(+ y1 (* t (- y2 y1)))])
107107

108+
(defn shape-inradius
109+
"Approximate inradius: minimum distance from centroid to any edge.
110+
This is the maximum safe inset before the shape degenerates."
111+
[shape]
112+
(let [points (:points shape)
113+
n (count points)
114+
cx (/ (reduce + (map first points)) n)
115+
cy (/ (reduce + (map second points)) n)]
116+
(reduce
117+
(fn [min-d i]
118+
(let [[ax ay] (nth points i)
119+
[bx by] (nth points (mod (inc i) n))
120+
;; Distance from centroid to edge segment (a→b)
121+
dx (- bx ax) dy (- by ay)
122+
len-sq (+ (* dx dx) (* dy dy))
123+
d (if (< len-sq 0.0001)
124+
(Math/sqrt (+ (* (- cx ax) (- cx ax)) (* (- cy ay) (- cy ay))))
125+
(let [t (/ (+ (* (- cx ax) dx) (* (- cy ay) dy)) len-sq)
126+
t (max 0 (min 1 t))
127+
px (+ ax (* t dx)) py (+ ay (* t dy))]
128+
(Math/sqrt (+ (* (- cx px) (- cx px)) (* (- cy py) (- cy py))))))]
129+
(min min-d d)))
130+
js/Infinity
131+
(range n))))
132+
133+
(defn inset-vertices
134+
"Move each vertex inward along its local normal by `amount`.
135+
Positive amount shrinks the shape, negative expands it.
136+
Preserves exact vertex count and correspondence."
137+
[points amount]
138+
(let [n (count points)]
139+
(mapv (fn [i]
140+
(let [[px py] (nth points i)
141+
[ax ay] (nth points (mod (dec (+ i n)) n))
142+
[bx by] (nth points (mod (inc i) n))
143+
;; Edge normals (pointing inward for CCW winding)
144+
e1x (- px ax) e1y (- py ay)
145+
e2x (- bx px) e2y (- by py)
146+
;; Perpendicular inward normals (CW winding)
147+
n1x (- e1y) n1y e1x
148+
n2x (- e2y) n2y e2x
149+
;; Normalize
150+
len1 (Math/sqrt (+ (* n1x n1x) (* n1y n1y)))
151+
len2 (Math/sqrt (+ (* n2x n2x) (* n2y n2y)))
152+
n1x (if (> len1 0) (/ n1x len1) 0)
153+
n1y (if (> len1 0) (/ n1y len1) 0)
154+
n2x (if (> len2 0) (/ n2x len2) 0)
155+
n2y (if (> len2 0) (/ n2y len2) 0)
156+
;; Bisector
157+
bx (+ n1x n2x) by (+ n1y n2y)
158+
blen (Math/sqrt (+ (* bx bx) (* by by)))]
159+
(if (< blen 0.0001)
160+
;; Degenerate (collinear edges) — use either normal
161+
[(- px (* amount n1x))
162+
(- py (* amount n1y))]
163+
;; Scale bisector so the perpendicular distance to each edge = amount
164+
(let [bx (/ bx blen) by (/ by blen)
165+
;; cos of half-angle between the two edge normals
166+
cos-half (+ (* bx n1x) (* by n1y))
167+
scale (if (> (Math/abs cos-half) 0.01)
168+
(/ amount cos-half)
169+
amount)]
170+
[(- px (* scale bx))
171+
(- py (* scale by))]))))
172+
(range n))))
173+
108174
(defn- sample-at-perimeter-fractions
109175
"Walk a closed contour and sample points at given perimeter fractions (0-1).
110176
Returns a vector of [x y] points, one per fraction."

0 commit comments

Comments
 (0)