[racket] Drawing a gradient on text

From: Matthew Flatt (mflatt at cs.utah.edu)
Date: Mon Dec 26 07:27:47 EST 2011

Thanks! (I should have thought to make sure my test case includes a
curve.)

At Mon, 26 Dec 2011 01:23:08 -0700, Michael W wrote:
> Ah, I found the issue.
> 
> The "curve" case in the case statement on lines 289-296 of
> dc-path.rkt should read:
> 
> (case (car a)
>   [(move) (move-to (cadr a) (caddr a))]
>   [(line) (line-to (cadr a) (caddr a))]
>   [(curve) (curve-to (cadr a) (caddr a)
>                       (list-ref a 3) (list-ref a 4)
>                       (list-ref a 5) (list-ref a 6))]
>   [(close) (close)])))
> 
> Note the changed list-ref numbers.
> 
> Or, here's the pull request: https://github.com/plt/racket/pull/68
> 
> 24 minutes ago, Michael W wrote:
> > Wow, that's really fast! Thanks for looking into this.
> > 
> > Unfortunately, text-outline seems to garble some glyphs. Am I
> > doing something wrong? As of commit e12bf33..., the attached code
> > produces this ... output, which looks more like an impersonation
> > of my handwriting than a text path:
> > 
> > http://img580.imageshack.us/img580/9038/garbled.jpg
> > 
> > This is on Arch Linux, cairo 1.10.2-2, pango 1.29.4-1.
> > 
> > Even constructing a path of just a single character (such as "r"
> > or "e" on my system) exhibits this behavior for me.
> > 
> > Let me know if there's anything I can do to help.
> > 
> > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> > 
> > (require slideshow/pict
> >          racket/draw)
> > 
> > (dc
> >  (λ (dc x y)
> >    (define r (new region%))
> >    (let ([p (new dc-path%)])
> >      (send p text-outline
> >            (make-object font% 35 'default)
> >            "Hello world"
> >            x y)
> >      (send r set-path p))
> >    (send dc set-clipping-region r)
> >    (send dc set-brush "black" 'solid)
> >    (send dc draw-rectangle 0 0 500 200))
> >  500 200)
> > 
> > 7 hours ago, Matthew Flatt wrote:
> > > I guess I've been waiting for a reason to sort out text paths. The
> > > `dc-path%' class now has a `text-outline' method (as of the latest in
> > > the git repo).
> > > 
> > > At Sun, 25 Dec 2011 00:00:44 -0700, Michael W wrote:
> > > > 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
> > 
> 
> -- 
> For the Future!
>     _mike



Posted on the users mailing list.