[racket] Fwd: Transformations and hc-append

Is the problem that you need to use (more) absolute coordinates in the
coordinate arguments to linear-gradient% (either that or set the origin of
the dc, in the case that you wanted to create the brush only once)?

Robby



On Tue, Feb 11, 2014 at 10:49 AM, Jens Axel Søgaard
<jensaxel at soegaard.net>wrote:

> The intent of hc-append is that (hc-append p1 p2) draws p1 and p2
> beside each other.
>
> The question is whether (hc-append p p) should draw to identical picts?
>
> When I use a non-solid brush I get the two ps are drawn differently.
> In (hc-append p1 p2) I was expecting a transformation (translation) on
> the brush.
>
> As a demonstration I offer the following program (a bit long, but
> hopefully clear.
>
> See a syntax-highligthed version here: http://pasterack.org/pastes/7953
> The DrRacket output is here: http://imgur.com/5BRiY0Z
>
> /Jens Axel
>
>
> #lang racket
> (require pict)
>
> ; debug : value pict -> pict
> ;  return a pict, that when drawn prints the
> ;  brush and drawing context transformation
> (define (debug who pict)
>   (dc (lambda (dc x y)
>         (define b   (send dc get-brush))
>         (define bt  (send b  get-transformation))
>         (define dct (send dc get-transformation))
>         (displayln (list who 'x x 'y y 'brush: bt 'dc: dct))
>         (draw-pict pict dc x y))
>       (pict-width pict) (pict-height pict)))
>
> (define r 20) ; use same box side for the entire example
>
> ; a black filled rectangle
> (define (rect) (filled-rectangle r r))
>
> ;;; Examine whether hc-append does any transformation.
> "Expected Image:          Two squares a black and a red"
> "Expected Transformation: Same for A and B. Some difference for C."
> (debug 'A
>        (hc-append (debug 'B (rect))
>                   (debug 'C (colorize (rect) "red" ))))
>
> ;;; --------------------------------------------------------------
> (require racket/draw)
>
> ; colors
> (define (color: name) (send the-color-database find-color name))
> (define red   (color: "red"))
> (define green (color: "green"))
> (define blue  (color: "blue"))
>
> ; square-path : real real real real -> path%
> ;     make square with side r and upper left corner (x,y)
> (define (square-path x y w h)
>   (define p (new dc-path%))
>   (send p move-to    x      y)
>   (send p line-to    x   (+ y h))
>   (send p line-to (+ x w)(+ y h))
>   (send p line-to (+ x w)(+ y 0))
>   (send p line-to (+ x 0)(+ y 0))
>   p)
>
> ; fill : pict -> pict
> ;   draw a path around pict using current pen and brush
> (define (fill pict)
>   (define w (pict-width pict))
>   (define h (pict-height pict))
>   (dc (lambda (dc x y)
>         (draw-pict pict dc x y)
>         (send dc draw-path (square-path x y w h)))
>       w h))
>
> ; shady : pict -> pict
> ;   Draws pict with a brush given by a linear, horizontal
> ;   gradient from (0,0) to (0,2r). The colors are red->green->blue.
> (define (shady pict)
>   (dc (lambda (dc x y)
>         ; get old brush
>         (define b (send dc get-brush))
>         ; make new brush, only change gradient
>         (define new-brush
>           (new brush%
>                [color          (send b get-color)]
>                [style          (send b get-style)]
>                [stipple        (send b get-stipple)]
>                [gradient       (new linear-gradient%
>                                 [x0 0] [y0 0] [x1 (* 2 r)] [y1 0] ;
> horizontal gradient
>                                 [stops (list (list 0   red)   ; (0,0)
> to ( r,0) red->green
>                                              (list 1/2 green) ; (r,0)
> to (2r,0) green->blue
>                                              (list 1   blue))])]
>                [transformation (send b get-transformation)]))
>         ; use new brush to draw the pict
>         (send dc set-brush new-brush)
>         (draw-pict pict dc x y)
>         ; restore old brush
>         (send dc set-brush b))
>       (pict-width pict) (pict-height pict)))
>
> (define-syntax (echo stx) (syntax-case stx () [(_ expr) #'(values 'expr
> expr)]))
>
> (newline) (newline)
> "Expected: A (black) rectangle"
> (echo (rect))
> "Expected: A rectangle filled with nothing (default brush is empty)"
> (echo (fill (rect)))
> "Expected: A rectangle filled with linear gradient (red to green)"
> (echo (shady (fill (rect))))
> "Expected: Two red-to-green rectangles"
> (echo (hc-append (shady (fill (rect))) (shady (fill (rect)))))
> "Expected: Two red-to-green rectangles"
> (echo (let () (define p (shady (fill (rect)))) (hc-append p p)))
>
>
>
> --
> Jens Axel Søgaard
>
> ____________________
>   Racket Users list:
>   http://lists.racket-lang.org/users
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20140211/20d883fe/attachment-0001.html>