[racket] Drawing a gradient on text

Merry Christmas, Racketeers!

Is there an easy way to draw text to a bitmap% with a gradient?

I briefly looked into adding linear-gradient% and
radial-gradient% support to slideshow/pict but unfortunately we
can't draw text using an arbitrary brush% as the draw-text method
of dc% ignores that.

My current trick is to draw the gradient to one bitmap, draw the
text to another bitmap, and then draw the first bitmap to a third
bitmap while copying the mask of the second. Is there a better
way?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang racket
(require slideshow/pict
         racket/draw)

(define (compose-picts base alpha)
  ;; Return a bitmap% with the colors of base but the alpha of alpha.
  (define-values (w h)
    (values (inexact->exact (ceiling (pict-width base)))
            (inexact->exact (ceiling (pict-height base)))))
  (define-values (base-bitmap alpha-bitmap final-bitmap)
    (values (make-bitmap w h)
            (make-bitmap w h)
            (make-bitmap w h)))
  (define-values (base-dc alpha-dc final-dc)
    (apply values (map (λ(bm) (new bitmap-dc% [bitmap bm]))
                       (list base-bitmap alpha-bitmap final-bitmap))))
  (send base-dc set-smoothing 'aligned)
  (draw-pict base base-dc 0 0)
  (send alpha-dc set-smoothing 'aligned)
  (draw-pict alpha alpha-dc 0 0)
  (send final-dc draw-bitmap base-bitmap 0 0 'solid #f alpha-bitmap)
  final-bitmap)

;; The text to render
(define my-text
  (scale (text "Hello World") 4))

;; The linear-gradient% to render
(define gradient
  (new linear-gradient% [x0 0] [y0 0] [x1 0] [y1 (pict-height my-text)]
       [stops (list (list 0.0 (make-object color% 0 0 0))
                    (list 1.0 (make-object color% 255 0 0)))]))

;; A box containing the gradient
(define gradient-box
  (dc
   (λ(dc w h)
     (send dc set-pen (make-object pen% "white" 1 'transparent))
     (send dc set-brush (new brush% [gradient gradient]))
     (send dc draw-rectangle
           0 0 (pict-width my-text) (pict-height my-text)))
   (pict-width my-text) (pict-height my-text)))

;; The final result: Gradient-filled text!
(bitmap (compose-picts gradient-box my-text))

-- 
Heave ho,
    _mike