add gradient transformation to `brush%'

collects/racket/draw/private/brush.rkt

@@ -5,7 +5,9 @@
          "syntax.rkt"
          "local.rkt"
          "bitmap.rkt"
-         "gradient.rkt")
+         "gradient.rkt"
+         "transform.rkt"
+         "dc-intf.rkt")
 
 (provide brush%
          brush-list% the-brush-list
@@ -33,7 +35,8 @@
   (init [(_color color) black]
         [(_style style) 'solid]
         [(_stipple stipple) #f]
-        [(_gradient gradient) #f])
+        [(_gradient gradient) #f]
+        [(_transformation transformation) #f])
 
   (set! color
         (cond
@@ -56,12 +59,13 @@
   (define lock-count 0)
   (define stipple #f)
   (define gradient #f)
+  (define transformation #f)
 
   (when _gradient
     (unless (or (_gradient . is-a? . linear-gradient%)
                 (_gradient . is-a? . radial-gradient%))
       (raise-type-error (init-name 'brush%)
-                        "linear-gradient%, radial-gradient%, or #f"
+                        "linear-gradient% object, radial-gradient% object, or #f"
                         _gradient))
     (set! gradient _gradient))
 
@@ -72,6 +76,15 @@
                         _stipple))
     (set-stipple _stipple))
 
+  (when _transformation
+    (unless (transformation-vector? _transformation)
+      (raise-type-error (init-name 'brush%)
+                        "transformation-vector"
+                        _transformation))
+    (when _gradient
+      (set! transformation (transformation-vector->immutable
+                            _transformation))))
+
   (super-new)
 
   (define/public (set-immutable) (set! immutable? #t))
@@ -99,6 +112,7 @@
 
   (define/public (get-color) color)
   (define/public (get-gradient) gradient)
+  (define/public (get-transformation) transformation)
 
   (def/public (get-stipple) stipple)
   (def/public (set-stipple [(make-or-false bitmap%) s]) 

collects/racket/draw/private/dc-path.rkt

@@ -6,13 +6,13 @@
          "../unsafe/cairo.rkt"
          "fmod.rkt"
          "point.rkt"
+         "transform.rkt"
          (only-in scheme/base 
                   [append s:append]
                   [reverse s:reverse]))
 
 (provide dc-path%
-         do-path
+         do-path)
-         matrix-vector?)
 
 (define-local-member-name
   get-closed-points
@@ -22,12 +22,6 @@
 (define 2pi (* 2.0 pi))
 (define pi/2 (/ pi 2.0))
 
-(define (matrix-vector? m)
-  (and (vector? m)
-       (= 6 (vector-length m))
-       (for/and ([e (in-vector m)])
-         (real? e))))
-
 (define dc-path%
   (class object%
     ;; A path is a list of pairs and vectors:

collects/racket/draw/private/dc.rkt

@@ -21,6 +21,7 @@
          "dc-intf.rkt"
          "dc-path.rkt"
          "point.rkt"
+         "transform.rkt"
          "local.rkt"
          "../unsafe/bstr.rkt")
 
@@ -48,16 +49,6 @@
 (define -bitmap-dc% #f)
 (define (install-bitmap-dc-class! v) (set! -bitmap-dc% v))
 
-(define (transformation-vector? v)
-  (and (vector? v)
-       (= 6 (vector-length v))
-       (matrix-vector? (vector-ref v 0))
-       (real? (vector-ref v 1))
-       (real? (vector-ref v 2))
-       (real? (vector-ref v 3))
-       (real? (vector-ref v 4))
-       (real? (vector-ref v 5))))
-
 ;; dc-backend : interface
 ;;
 ;; This is the interface that the backend specific code must implement
@@ -461,13 +452,16 @@
         (reset-effective!)
         (reset-matrix)))
 
-    (def/public (set-initial-matrix [matrix-vector? m])
+    (define/private (vector->matrix m)
-      (set! matrix (make-cairo_matrix_t (vector-ref m 0)
+      (make-cairo_matrix_t (vector-ref m 0)
                            (vector-ref m 1)
                            (vector-ref m 2)
                            (vector-ref m 3)
                            (vector-ref m 4)
                            (vector-ref m 5)))
+
+    (def/public (set-initial-matrix [matrix-vector? m])
+      (set! matrix (vector->matrix m))
       (reset-effective!)
       (reset-align!)
       (reset-matrix))
@@ -682,7 +676,7 @@
                (lambda (x) (align-x x)) (lambda (y) (align-y y))
                #:init-matrix (lambda (cr) (init-cr-matrix cr))))))
 
-    (define/public (get-clipping-matrix)
+    (define/private (get-current-matrix)
       (let* ([cm (make-cairo_matrix_t (cairo_matrix_t-xx matrix)
                                       (cairo_matrix_t-yx matrix)
                                       (cairo_matrix_t-xy matrix)
@@ -692,6 +686,10 @@
         (cairo_matrix_translate cm origin-x origin-y)
         (cairo_matrix_scale cm scale-x scale-y)
         (cairo_matrix_rotate cm (- rotation))
+        cm))
+    
+    (define/public (get-clipping-matrix)
+      (let* ([cm (get-current-matrix)])
         (vector (cairo_matrix_t-xx cm)
                 (cairo_matrix_t-yx cm)
                 (cairo_matrix_t-xy cm)
@@ -761,7 +759,7 @@
           (cairo_set_source cr p)
           (cairo_pattern_destroy p))))
 
-    (define/private (make-gradient-pattern cr gradient)
+    (define/private (make-gradient-pattern cr gradient transformation)
       (define p 
         (if (is-a? gradient linear-gradient%)
             (call-with-values (lambda () (send gradient get-line)) cairo_pattern_create_linear)
@@ -775,7 +773,17 @@
                  [b (norm (color-blue c))]
                  [a (color-alpha c)])
             (cairo_pattern_add_color_stop_rgba p offset r g b a)))
+      (when transformation
+        (cairo_identity_matrix cr)
+        (init-cr-matrix cr)
+        (cairo_translate cr scroll-dx scroll-dy)        
+        (cairo_transform cr (vector->matrix (vector-ref transformation 0)))
+        (cairo_translate cr (vector-ref transformation 1) (vector-ref transformation 2))
+        (cairo_scale cr (vector-ref transformation 3) (vector-ref transformation 4))
+        (cairo_rotate cr (- (vector-ref transformation 5))))
       (cairo_set_source cr p)
+      (when transformation
+        (do-reset-matrix cr))
       (cairo_pattern_destroy p))
 
     ;; Stroke, fill, and flush the current path
@@ -821,7 +829,7 @@
                   [gradient (send brush get-gradient)])
               (if (and gradient
                        (not (collapse-bitmap-b&w?)))
-                  (make-gradient-pattern cr gradient)
+                  (make-gradient-pattern cr gradient (send brush get-transformation))
                   (if st
                       (install-stipple st col s 
                                        (lambda () brush-stipple-s)

collects/racket/draw/private/transform.rkt

@@ -0,0 +1,33 @@
+#lang racket/base
+
+(provide matrix-vector?
+         transformation-vector?
+         transformation-vector->immutable)
+
+(define (matrix-vector? m)
+  (and (vector? m)
+       (= 6 (vector-length m))
+       (for/and ([e (in-vector m)])
+         (real? e))))
+
+(define (transformation-vector? v)
+  (and (vector? v)
+       (= 6 (vector-length v))
+       (matrix-vector? (vector-ref v 0))
+       (real? (vector-ref v 1))
+       (real? (vector-ref v 2))
+       (real? (vector-ref v 3))
+       (real? (vector-ref v 4))
+       (real? (vector-ref v 5))))
+
+(define (transformation-vector->immutable v)
+  (if (and (immutable? v)
+           (immutable? (vector-ref v 0)))
+      v
+      (vector-immutable
+       (vector->immutable-vector (vector-ref v 0))
+       (vector-ref v 1)
+       (vector-ref v 2)
+       (vector-ref v 3)
+       (vector-ref v 4)
+       (vector-ref v 5))))

collects/scribblings/draw/brush-class.scrbl

@@ -9,13 +9,13 @@ A brush is a drawing tool with a color and a style that is used for
  filling in areas, such as the interior of a rectangle or ellipse.  In
  a monochrome destination, all non-white brushes are drawn as black.
 
-In addition to its color and style, a brush can have a stipple bitmap.
+In addition to its color and style, a brush can have a @deftech{brush stipple} bitmap.
  Painting with a
  stipple brush is similar to calling @method[dc<%> draw-bitmap] with
  the stipple bitmap in the filled region.
 
 As an alternative to a color, style, and stipple, a brush can have a
- gradient that is a @racket[linear-gradient%] or
+ @deftech{gradient} that is a @racket[linear-gradient%] or
  @racket[radial-gradient%]. When a brush has a gradient and the target
  for drawing is not monochrome, then other brush settings are
  ignored. With a gradient, for each point in a drawing destination,
@@ -23,9 +23,14 @@ As an alternative to a color, style, and stipple, a brush can have a
  ending colors and starting and ending lines (for a linear gradient)
  or circles (for a radial gradient); a gradient-assigned color is
  applied for each point that is touched when drawing with the brush.
+ By default, coordinates in the gradient are transformed by the
+ drawing context's transformation when the brush is used, but a brush
+ can have its own @deftech{gradient transformation} that is used, instead.
+ A gradient transformation has the same representation and meaning as for
+ @xmethod[dc<%> get-transformation].
 
-A brush's style is one of the following (but is ignored if the brush
+A @deftech{brush style} is one of the following (but is ignored if the brush
- has a gradient and the target is not monochrome):
+ has a @tech{gradient} and the target is not monochrome):
 
 @itemize[
 
@@ -33,13 +38,13 @@ A brush's style is one of the following (but is ignored if the brush
        interior of the drawn shape).}
 
  @item{@indexed-racket['solid] --- Draws using the brush's color. If a
-        monochrome stipple is installed into the brush, black pixels
+        monochrome @tech{brush stipple} is installed into the brush, black pixels
         from the stipple are transferred to the destination using the
         brush's color, and white pixels from the stipple are not
         transferred.}
 
  @item{@indexed-racket['opaque] --- The same as @racket['solid] for a color
-        stipple. For a monochrome stipple, white pixels from 
+        @tech{brush stipple}. For a monochrome stipple, white pixels from 
         the stipple are
         transferred to the destination using the destination's
         background color.}
@@ -52,7 +57,7 @@ A brush's style is one of the following (but is ignored if the brush
  @item{@indexed-racket['panel] --- The same as @racket['solid], accepted 
         only for partial backward compatibility.}
 
- @item{The following modes correspond to built-in stipples drawn in
+ @item{The following modes correspond to built-in @tech{brush stipples} drawn in
        @racket['solid] mode:
 
   @itemize[
@@ -64,7 +69,7 @@ A brush's style is one of the following (but is ignored if the brush
   @item{@indexed-racket['vertical-hatch] --- vertical lines}
   ]
 
-        However, when a specific stipple is installed into the brush,
+        However, when a specific @tech{brush stipple} is installed into the brush,
         the above modes are ignored and @racket['solid] is
         used, instead.}
 
@@ -92,14 +97,16 @@ To avoid creating multiple brushes with the same characteristics, use
                  [gradient (or/c #f 
                                  (is-a?/c linear-gradient%)
                                  (is-a?/c radial-gradient%))
-                           #f])]{
+                           #f]
+                 [transformation (or/c #f (vector/c (vector/c real? real? real? 
+                                                              real? real? real?)
+                                                     real? real? real? real? real?))])]{
 
-Creates a brush with the given color, style, stipple, and gradient. For
+Creates a brush with the given color, @tech{brush style}, @tech{brush stipple}, @tech{gradient}, and
- the case that the color is specified using a name, see
+ @tech{gradient transformation}. For the case that the color is specified
- @racket[color-database<%>] for information about color names; if the
+ using a name, see @racket[color-database<%>] for information about
- name is not known, the brush's color is black.
+ color names; if the name is not known, the brush's color is black.}
 
-}
 
 @defmethod[(get-color)
            (is-a?/c color%)]{
@@ -111,18 +118,15 @@ Returns the brush's color.
 @defmethod[(get-stipple)
            (or/c (is-a?/c bitmap%) #f)]{
 
-Gets the stipple bitmap, or @racket[#f] if the brush has no stipple.
+Gets the @tech{brush stipple} bitmap, or @racket[#f] if the brush has no stipple.}
 
-}
 
 @defmethod[(get-gradient)
            (or/c (is-a?/c linear-gradient%)
                  (is-a?/c radial-gradient%)
                  #f)]{
 
-Gets the gradient, or @racket[#f] if the brush has no gradient.
+Gets the @tech{gradient}, or @racket[#f] if the brush has no gradient.}
-
-}
 
 
 @defmethod[(get-style)
@@ -132,10 +136,20 @@ Gets the gradient, or @racket[#f] if the brush has no gradient.
                      'fdiagonal-hatch 'cross-hatch 
                      'horizontal-hatch 'vertical-hatch)]{
 
-Returns the brush's style. See @racket[brush%] for information about
+Returns the @tech{brush style}. See @racket[brush%] for information about
-brush styles.
+brush styles.}
+
+
+@defmethod[(get-transformation) (or/c #f (vector/c (vector/c real? real? real? real? real? real?)
+                                                   real? real? real? real? real?))]{
+
+Returns the brush's @tech{gradient transformation}, if any.
+
+If a brush with a gradient also has a transformation, then the
+transformation applies to the gradient's coordinates instead of the
+target drawing context's transformation; otherwise, the target drawing
+context's transformation applies to gradient coordinates.}
 
-}
 
 @defmethod*[([(set-color [color (is-a?/c color%)])
               void?]
@@ -158,7 +172,7 @@ For the case that the color is specified using a string, see
 @defmethod[(set-stipple [bitmap (or/c (is-a?/c bitmap%) #f)])
            void?]{
 
-Sets or removes the stipple bitmap, where @racket[#f] removes the
+Sets or removes the @tech{brush stipple} bitmap, where @racket[#f] removes the
  stipple. See @racket[brush%] for information about drawing with
  stipples.
 
@@ -176,7 +190,7 @@ If @racket[bitmap] is modified while is associated with a brush, the
                                        'horizontal-hatch 'vertical-hatch)])
            void?]{
 
-Sets the brush's style. See
+Sets the @tech{brush style}. See
 @racket[brush%] for information about the possible styles.
 
 A brush cannot be modified if it was obtained from a

collects/scribblings/draw/pen-class.scrbl

@@ -13,12 +13,12 @@ A pen is a drawing tool with a color, width, and style. A pen draws
  lines and outlines, such as the outline of a rectangle. In a
  monochrome destination, all non-white pens are drawn as black.
 
-In addition to its color, width, and style, a pen can have a stipple
+In addition to its color, width, and style, a pen can have a @deftech{pen stipple}
- bitmap. Painting with a stipple pen is similar to
+ bitmap. Drawing with a stipple pen is similar to
  calling @method[dc<%> draw-bitmap] with the stipple bitmap in region
  painted by the pen.
 
-A pen's style is one of the following:
+A @deftech{pen style} is one of the following:
 
 @itemize[
 
@@ -26,7 +26,7 @@ A pen's style is one of the following:
        outline of the drawn shape).}
 
  @item{@indexed-racket['solid] --- Draws using the pen's color. If a
-        (monochrome) stipple is installed into the pen, black pixels
+        (monochrome) @tech{pen stipple} is installed into the pen, black pixels
         from the stipple are transferred to the destination using the
         brush's color, and white pixels from the stipple are not
         transferred.}
@@ -37,7 +37,7 @@ A pen's style is one of the following:
  @item{@indexed-racket['hilite] --- Draws with black and a @racket[0.3] alpha.}
 
  @item{The following special pen modes use the pen's color, and they only
-       apply when a stipple is not used:
+       apply when a @tech{pen stipple} is not used:
     @itemize[
   @item{@indexed-racket['dot]}
   @item{@indexed-racket['long-dash]}
@@ -80,9 +80,8 @@ When drawing in @racket['smoothed] or @racket['aligned] mode, a pen's
                  [stipple (or/c #f (is-a?/c bitmap%)) 
                           #f])]{
 
-Creates a pen with the given color, width, style, cap style (see
+Creates a pen with the given color, width, @tech{pen style}, @tech{cap style}, @tech{join style}, and
- @method[pen% get-cap]), join style (see @method[pen% get-join]), and
+ @tech{pen stipple} bitmap.  For the case that the color is specified using a name, see
- stipple.  For the case that the color is specified using a name, see
  @racket[color-database<%>] for information about color names; if the
  name is not known, the pen's color is black.
 
@@ -91,7 +90,7 @@ Creates a pen with the given color, width, style, cap style (see
 @defmethod[(get-cap)
            (one-of/c 'round 'projecting 'butt)]{
 
-Returns the pen cap style, which determines the shape of a line at
+Returns the pen @deftech{cap style}, which determines the shape of a line at
 each of its ending points when drawn by @method[dc<%> draw-line] or at the
 non-connecting ends of lines when drawn by @method[dc<%> draw-lines] or
 @method[dc<%> draw-path]. The default is @racket['round], which draws the
@@ -141,7 +140,7 @@ Returns the pen's color object.
 @defmethod[(get-join)
            (one-of/c 'round 'bevel 'miter)]{
 
-Returns the pen join style that is used between multiple lines
+Returns the pen @deftech{join style} that is used between multiple lines
 connected through @method[dc<%> draw-lines], @method[dc<%>
 draw-rectangle], @method[dc<%> draw-polygon], or @method[dc<%>
 draw-path].  The join style fills the space that would be left at the
@@ -198,7 +197,7 @@ Each of the end points of the lines i with a red dot.
 @defmethod[(get-stipple)
            (or/c (is-a?/c bitmap%) #f)]{
 
-Gets the current stipple bitmap, or returns @racket[#f] if no stipple
+Gets the current @tech{pen stipple} bitmap, or returns @racket[#f] if no stipple
  bitmap is installed.
 
 }
@@ -209,7 +208,7 @@ Gets the current stipple bitmap, or returns @racket[#f] if no stipple
                      'xor-dot 'xor-long-dash 'xor-short-dash 
                      'xor-dot-dash)]{
 
-Returns the pen style. See @racket[pen%] for information about
+Returns the @tech{pen style}. See @racket[pen%] for information about
 possible styles.
 
 }
@@ -224,7 +223,7 @@ Returns the pen width.
 @defmethod[(set-cap [cap-style (one-of/c 'round 'projecting 'butt)])
            void?]{
 
-Sets the pen cap style. See @method[pen% get-cap] for information about cap
+Sets the pen @tech{cap style}. See @method[pen% get-cap] for information about cap
  styles.
 
 A pen cannot be modified if it was obtained from a @racket[pen-list%]
@@ -251,7 +250,7 @@ A pen cannot be modified if it was obtained from a
 @defmethod[(set-join [join-style (one-of/c 'round 'bevel 'miter)])
            void?]{
 
-Sets the pen join style. See @method[pen% get-join] for information about join
+Sets the pen @tech{join style}. See @method[pen% get-join] for information about join
  styles.
 
 A pen cannot be modified if it was obtained from a
@@ -262,7 +261,7 @@ A pen cannot be modified if it was obtained from a
 @defmethod[(set-stipple [bitmap (or/c (is-a?/c bitmap%) #f)])
            void?]{
 
-Sets the pen stipple bitmap, where @racket[#f] turns off the stipple bitmap.
+Sets the pen @tech{pen stipple} bitmap, where @racket[#f] turns off the stipple bitmap.
 
 If @racket[bitmap] is modified while is associated with a pen, the
  effect on the pen is unspecified. A pen cannot be modified if it was
@@ -277,7 +276,7 @@ If @racket[bitmap] is modified while is associated with a pen, the
                                        'xor-dot-dash)])
            void?]{
 
-Sets the pen style. See @racket[pen%] for information about the
+Sets the @tech{pen style}. See @racket[pen%] for information about the
  possible styles.
 
 A pen cannot be modified if it was obtained from a