Alternately: how can I convert points that I liked with draw-spline
to points consistent with curve-to
?
I'm working on drawing some fire with racket/draw
+ pict
(using the dc
constructor for pict
s). Once I get the right outline, I can fill/scale/stack to get a layered effect.
I started with dc<%>
's draw-spline
to draw (what I thought were) Bézier curves with a single control point (aka quadratic Bézier curves). When I realized I couldn't fill the resulting shape easily this way, I switched to dc-path%
's curve-to
, which uses cubic Bézier curves (i.e., 2 control points). Fortunately, any quadratic Bézier can be converted to a cubic (algorithm - Convert a quadratic bezier to a cubic one - Stack Overflow).
But when I run this transformation on my initial code, I get slightly different curves, so I suspect draw-spline
was never a quadratic Bézier!
You can see the discrepancies.
- First row:
draw-spline
thencurve-to
shapes - Second row:
curve-to
on top ofdraw-spline
, then vice-versa.
(The following code was a live experiment; please excuse the abuse of list
where structs might be better.)
#lang racket
(require racket/draw
pict
)
;; list of point and control points defining a path of quadratic bézier curves
;; (list pt cp)
;; (list p2 __)
;; ------------
;; Draw from point pt through control-point cp to point p2.
;; The last pair's control-point is ignored.
(define q-points
(list
(list (list 25 45)
(list 18 42))
(list (list 15 30)
(list 16 23))
(list (list 18 19)
(list 22 12))
(list (list 20 7)
(list 29 11))
(list (list 35 27)
(list 37 28))
(list (list 40 25)
(list 41 21))
(list (list 39 18)
(list 46 27))
(list (list 43 35)
(list 39 43))
(list (list 25 45) ; must be same as (first (first (first points)))
#f)))
(define (fire-shape*)
(dc (lambda (dc dx dy)
(for ([pc1 q-points]
[pc2 (cdr q-points)])
(match-define (list (list p1x p1y) (list cx cy)) pc1)
(match-define (list (list p2x p2y) _) pc2)
(send dc draw-spline
p1x p1y
cx cy
p2x p2y)))
50 50))
;; convert a quadratic bézier curve to a cubic
;; https://stackoverflow.com/q/3162645/4400820
(define (quad->cubic p1 cp p2)
(define (ct pt cp)
(+ pt (* 2/3 (- cp pt))))
(values
p1
(map ct p1 cp)
(map ct p2 cp)
p2))
;; cubic bézier points
(define c-points
(append
(for/list ([pc1 (in-list q-points)]
[pc2 (in-list (cdr q-points))])
(match-define (list p1 cp) pc1)
(match-define (list p2 _) pc2)
(define-values (p1* cp1 cp2 p2*) (quad->cubic p1 cp p2))
(list p1* cp1 cp2))
(list (list (car (last q-points)) #f #f))))
(define path
(let ([p (new dc-path%)])
(match-define
(cons (cons (list x0 y0) _) _)
c-points)
(send p move-to x0 y0)
(for ([pcc1 (in-list c-points)]
[pcc2 (in-list (cdr c-points))])
(match-define (list _ (list c1x c1y) (list c2x c2y)) pcc1)
(match-define (list (list p2x p2y) _ _) pcc2)
(send p curve-to
c1x c1y
c2x c2y
p2x p2y))
p))
(define (fire-shape border-color fill-color)
(dc (lambda (dc dx dy)
(define old-brush (send dc get-brush))
(define old-pen (send dc get-pen))
(send* dc
(set-brush (new brush% [color fill-color]))
(set-pen (new pen% [color border-color]))
(draw-path path dx dy)
(set-brush old-brush)
(set-pen old-pen)))
50 50))
(hc-append
(fire-shape*)
(fire-shape "black" "red"))
(hc-append
(cc-superimpose
(fire-shape*)
(fire-shape "black" "red"))
(cc-superimpose
(fire-shape "black" "red")
(fire-shape*)))