[racket] Fwd: Transformations and hc-append

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