diff --git a/collects/racket/draw/private/brush.rkt b/collects/racket/draw/private/brush.rkt index 09c2ea0a94..2d5c495913 100644 --- a/collects/racket/draw/private/brush.rkt +++ b/collects/racket/draw/private/brush.rkt @@ -80,7 +80,7 @@ (raise-type-error (init-name 'brush%) "transformation-vector" _transformation)) - (when _gradient + (when (or _gradient _stipple) (set! transformation (transformation-vector->immutable _transformation)))) @@ -114,9 +114,11 @@ (define/public (get-transformation) transformation) (def/public (get-stipple) stipple) - (def/public (set-stipple [(make-or-false bitmap%) s]) + (def/public (set-stipple [(make-or-false bitmap%) s] + [(make-or-false transformation-vector?) [t #f]]) (check-immutable 'set-stipple) - (set! stipple s))) + (set! stipple s) + (set! transformation (and s t)))) ;; ---------------------------------------- diff --git a/collects/racket/draw/private/dc.rkt b/collects/racket/draw/private/dc.rkt index 0523b9c13e..e45887adf4 100644 --- a/collects/racket/draw/private/dc.rkt +++ b/collects/racket/draw/private/dc.rkt @@ -758,6 +758,16 @@ (cairo_set_source cr p) (cairo_pattern_destroy p)))) + (define/private (install-transformation transformation cr) + (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))))) + (define/private (make-gradient-pattern cr gradient transformation) (define p (if (is-a? gradient linear-gradient%) @@ -772,14 +782,7 @@ [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)))) + (install-transformation transformation cr) (cairo_set_source cr p) (when transformation (do-reset-matrix cr)) @@ -787,7 +790,7 @@ ;; Stroke, fill, and flush the current path (define/private (draw cr brush? pen?) - (define (install-stipple st col mode get put) + (define (install-stipple st col mode transformation get put) (let ([s (cond [(get) => (lambda (s) s)] [(and (not (send st is-color?)) @@ -815,7 +818,10 @@ get-cairo-surface))])]) (let* ([p (cairo_pattern_create_for_surface s)]) (cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT) + (install-transformation transformation cr) (cairo_set_source cr p) + (when transformation + (do-reset-matrix cr)) (cairo_pattern_destroy p)))) (cairo_set_antialias cr (case (dc-adjust-smoothing smoothing) [(unsmoothed) CAIRO_ANTIALIAS_NONE] @@ -831,6 +837,7 @@ (make-gradient-pattern cr gradient (send brush get-transformation)) (if st (install-stipple st col s + (send brush get-transformation) (lambda () brush-stipple-s) (lambda (v) (set! brush-stipple-s v) v)) (let ([horiz (lambda (cr2) @@ -896,6 +903,7 @@ [col (send pen get-color)]) (if st (install-stipple st col s + #f (lambda () pen-stipple-s) (lambda (v) (set! pen-stipple-s v) v)) (install-color cr diff --git a/collects/racket/draw/private/record-dc.rkt b/collects/racket/draw/private/record-dc.rkt index 4e2f1dbbee..dc6931e7f7 100644 --- a/collects/racket/draw/private/record-dc.rkt +++ b/collects/racket/draw/private/record-dc.rkt @@ -54,12 +54,21 @@ (if s (let ([b (make-object brush% (send b get-color) - (send b get-style))]) - (send b set-stipple (clone-bitmap s)) + (send b get-style))] + [t (send b get-transformation)]) + (send b set-stipple (clone-bitmap s) t) b) - (send the-brush-list find-or-create-brush - (send b get-color) - (send b get-style))))) + (let ([g (send b get-gradient)]) + (if g + (make-object brush% + (send b get-color) + (send b get-style) + #f + g + (send b get-transformation)) + (send the-brush-list find-or-create-brush + (send b get-color) + (send b get-style))))))) (define (region-maker r) (if (send r internal-get-dc) diff --git a/collects/scribblings/draw/brush-class.scrbl b/collects/scribblings/draw/brush-class.scrbl index 620b73d4e1..8f2fc73b14 100644 --- a/collects/scribblings/draw/brush-class.scrbl +++ b/collects/scribblings/draw/brush-class.scrbl @@ -23,10 +23,11 @@ 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 + +By default, coordinates in a stipple or 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 + can have its own @deftech{brush transformation} that is used, instead. + A brush transformation has the same representation and meaning as for @xmethod[dc<%> get-transformation]. A @deftech{brush style} is one of the following (but is ignored if the brush @@ -102,10 +103,12 @@ To avoid creating multiple brushes with the same characteristics, use real? real? real?) real? real? real? real? real?))])]{ -Creates a brush with the given color, @tech{brush style}, @tech{brush stipple}, @tech{gradient}, and - @tech{gradient transformation}. 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 brush's color is black.} +Creates a brush with the given color, @tech{brush style}, @tech{brush + stipple}, @tech{gradient}, and @tech{brush transformation} (which is + kept only if the gradient or stipple is non-@racket[#f]). 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 brush's color is black.} @defmethod[(get-color) @@ -143,12 +146,12 @@ 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. +Returns the brush's @tech{brush 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 +If a brush with a stipple or gradient also has a transformation, then the +transformation applies to the stipple or gradient's coordinates instead of the target drawing context's transformation; otherwise, the target drawing -context's transformation applies to gradient coordinates.} +context's transformation applies to stipple and gradient coordinates.} @defmethod*[([(set-color [color (is-a?/c color%)]) @@ -169,12 +172,17 @@ For the case that the color is specified using a string, see } -@defmethod[(set-stipple [bitmap (or/c (is-a?/c bitmap%) #f)]) +@defmethod[(set-stipple [bitmap (or/c (is-a?/c bitmap%) #f)] + [transformation (or/c #f (vector/c (vector/c real? real? real? + real? real? real?) + real? real? real? real? real?)) + #f]) void?]{ -Sets or removes the @tech{brush stipple} bitmap, where @racket[#f] removes the - stipple. See @racket[brush%] for information about drawing with - stipples. +Sets or removes the @tech{brush stipple} bitmap, where @racket[#f] + removes the stipple. The @tech{brush transformation} is set at the + same time to @racket[transformation]. See @racket[brush%] for + information about drawing with stipples. If @racket[bitmap] is modified while is associated with a brush, the effect on the brush is unspecified. A brush cannot be modified if it