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 <[email protected]>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 >
____________________ Racket Users list: http://lists.racket-lang.org/users
