diff --git a/collects/mred/mred-sig.rkt b/collects/mred/mred-sig.rkt index 0b5efef1eb..dd27c01b2d 100644 --- a/collects/mred/mred-sig.rkt +++ b/collects/mred/mred-sig.rkt @@ -113,6 +113,7 @@ key-event% keymap% label->plain-label labelled-menu-item<%> +linear-gradient% list-box% list-control<%> make-bitmap @@ -160,6 +161,7 @@ read-bitmap read-editor-global-footer read-editor-global-header read-editor-version +radial-gradient% region% register-collecting-blit scroll-event% diff --git a/collects/racket/draw.rkt b/collects/racket/draw.rkt index 09970b1a65..c06c9b19a0 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -25,8 +25,6 @@ brush% brush-list% the-brush-list linear-gradient% radial-gradient% - make-linear-gradient - make-radial-gradient region% dc-path% dc<%> diff --git a/collects/racket/draw/draw-sig.rkt b/collects/racket/draw/draw-sig.rkt index e2afb135e4..03d77516ee 100644 --- a/collects/racket/draw/draw-sig.rkt +++ b/collects/racket/draw/draw-sig.rkt @@ -18,9 +18,7 @@ gl-config% gl-context<%> linear-gradient% make-bitmap -make-linear-gradient make-monochrome-bitmap -make-radial-gradient pdf-dc% pen% pen-list% diff --git a/collects/racket/draw/private/brush.rkt b/collects/racket/draw/private/brush.rkt index 8a7ff6e550..84dabf402d 100644 --- a/collects/racket/draw/private/brush.rkt +++ b/collects/racket/draw/private/brush.rkt @@ -61,7 +61,7 @@ (unless (or (_gradient . is-a? . linear-gradient%) (_gradient . is-a? . radial-gradient%)) (raise-type-error (init-name 'brush%) - "gradient<%> or #f" + "linear-gradient%, radial-gradient%, or #f" _gradient)) (set! gradient _gradient)) diff --git a/collects/racket/draw/private/gradient.rkt b/collects/racket/draw/private/gradient.rkt index 5dc9b0257f..e434556f8d 100644 --- a/collects/racket/draw/private/gradient.rkt +++ b/collects/racket/draw/private/gradient.rkt @@ -4,72 +4,63 @@ "color.rkt") (provide linear-gradient% - radial-gradient% - make-linear-gradient - make-radial-gradient) - -;(define gradient<%> -; (interface () -; get-stops)) + radial-gradient%) (define (check-reals name lst) - (for ([x lst]) - (unless (real? x) - (raise-type-error (init-name name) "Coordinate must be a real? ~a" x)))) + (for ([x (in-list lst)]) + (unless (real? x) + (raise-type-error (init-name name) "real number" x)))) (define (check-radius name lst) - (for ([x lst]) - (unless (and (real? x) (not (negative? x))) - (raise-type-error (init-name name) "Radius must be a real? ~a" x)))) + (for ([x (in-list lst)]) + (unless (and (real? x) (not (negative? x))) + (raise-type-error (init-name name) "non-negative real number" x)))) (define (check-stops name stops) - (unless (list? stops) (error name "Stops must be a list ~a" stops)) - (for ([x stops]) - (unless (list? x) (error name "A stop must be a list ~a" x)) - (unless (= (length x) 2) (error name "A stop must be a element list ~a" x)) - (unless (and (real? (car x)) (<= 0.0 (car x) 1.0)) - (error name "First element of a stop must be a real between 0.0 and 1.0 ~a" (car x))) - (unless (is-a? (cadr x) color%) - (error name "Second element of a stop must be a color% ~a" (cdr x))))) + (unless (and (list? stops) + (for/and ([x (in-list stops)]) + (and (list? x) + (= (length x) 2) + (real? (car x)) + (<= 0.0 (car x) 1.0) + (is-a? (cadr x) color%)))) + (raise-type-error (init-name name) + "list of (list x c) where x is a real in [0,1] and c is a color%" + stops))) -;(define linear-gradient% (class* object% (gradient<%>) -(define linear-gradient% (class object% - (init-field [x0 0] - [y0 0] - [x1 0] - [y1 0] - [stops null]) +(define linear-gradient% + (class object% + (init x0 y0 x1 y1 stops) + (define _x0 x0) + (define _y0 y0) + (define _x1 x1) + (define _y1 y1) + (define _stops stops) - (check-reals 'linear-gradient% (list x0 y0 x1 y1)) - (check-stops 'linear-gradient% stops) + (check-reals 'linear-gradient% (list x0 y0 x1 y1)) + (check-stops 'linear-gradient% stops) - (super-new) + (super-new) - (define/public (get-line) (values x0 y0 x1 y1)) - (define/public (get-stops) stops))) + (define/public (get-line) (values _x0 _y0 _x1 _y1)) + (define/public (get-stops) _stops))) -;(define radial-gradient% (class* object% (gradient<%>) -(define radial-gradient% (class object% - (init-field [x0 0] - [y0 0] - [r0 0] - [x1 0] - [y1 0] - [r1 0] - [stops null]) +(define radial-gradient% + (class object% + (init x0 y0 r0 x1 y1 r1 stops) + (define _x0 x0) + (define _y0 y0) + (define _r0 r0) + (define _x1 x1) + (define _y1 y1) + (define _r1 r1) + (define _stops stops) - (check-reals 'radial-gradient% (list x0 y0 x1 y1)) - (check-radius 'radial-gradient% (list r0 r1)) - (check-stops 'radial-gradient% stops) + (check-reals 'radial-gradient% (list _x0 _y0 _x1 _y1)) + (check-radius 'radial-gradient% (list _r0 _r1)) + (check-stops 'radial-gradient% stops) - (super-new) - - (define/public (get-circles) (values x0 y0 r0 x1 y1 r1)) - (define/public (get-stops) stops))) - -(define (make-linear-gradient x0 y0 x1 y1 stopslst) - (make-object linear-gradient% x0 y0 x1 y1 stopslst)) - -(define (make-radial-gradient x0 y0 r0 x1 y1 r1 stopslst) - (make-object radial-gradient% x0 y0 r0 x1 y1 r1 stopslst)) + (super-new) + (define/public (get-circles) (values _x0 _y0 _r0 _x1 _y1 _r1)) + (define/public (get-stops) _stops))) diff --git a/collects/scribblings/draw/brush-class.scrbl b/collects/scribblings/draw/brush-class.scrbl index e9ced9ed43..9bebc6120f 100644 --- a/collects/scribblings/draw/brush-class.scrbl +++ b/collects/scribblings/draw/brush-class.scrbl @@ -15,16 +15,16 @@ In addition to its color and style, a brush can have a stipple bitmap. stipple brush is similar to calling @method[dc<%> draw-bitmap] with the stipple bitmap in the filled region. -A brush can also be constructed as a @racket[linear-gradient%] or -@racket[radial-gradient%]. +As an alternative to a color, style, and stipple, a brush can have a + gradient that is a @racket[linear-gradient%] or + @racket[radial-gradient%]. For each point in a drawing destination, a + gradient associates a color to the point based on starting and 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 is that touched when drawing with the brush. -@examples[ #:eval class-eval -(new brush% [gradient (make-object linear-gradient% 0 0 10 10 - (list (list 0 (make-object color% 255 0 0)) - (list 0.5 (make-object color% 0 255 0)) - (list 1 (make-object color% 0 0 255))))])] - -A brush's style is one of the following: +A brush's style is one of the following (but is ignored if the brush + has a gradient): @itemize[ @@ -87,9 +87,13 @@ To avoid creating multiple brushes with the same characteristics, use 'horizontal-hatch 'vertical-hatch) 'solid] [stipple (or/c #f (is-a?/c bitmap%)) - #f])]{ + #f] + [gradient (or/c #f + (is-a?/c linear-gradient%) + (is-a?/c radial-gradient%)) + #f])]{ -Creates a brush with the given color, style, and stipple. For +Creates a brush with the given color, style, stipple, and gradient. For the case that the color is specified using a name, see @scheme[color-database<%>] for information about color names; if the name is not known, the brush's color is black. @@ -104,14 +108,14 @@ Returns the brush's color. } @defmethod[(get-stipple) - (or/c (is-a?/c bitmap%) false/c)]{ + (or/c (is-a?/c bitmap%) #f)]{ Gets the stipple bitmap, or @scheme[#f] if the brush has no stipple. } @defmethod[(get-gradient) - (or/c (is-a?/c gradient<%>) false/c)]{ + (or/c (is-a?/c gradient<%>) #f)]{ Gets the gradient, or @scheme[#f] if the brush has no gradient. diff --git a/collects/scribblings/draw/linear-gradient-class.scrbl b/collects/scribblings/draw/linear-gradient-class.scrbl index f65dbfcf40..3bd23d7497 100644 --- a/collects/scribblings/draw/linear-gradient-class.scrbl +++ b/collects/scribblings/draw/linear-gradient-class.scrbl @@ -7,27 +7,52 @@ @defclass/title[linear-gradient% object% ()]{ -A linear gradient is a pattern tool that is used for - filling in areas, such as the interior of a rectangle or ellipse. +A @deftech{linear gradient} is used with a @racket[brush%] to fill + areas, such as the interior of a rectangle or ellipse, with smooth + color transitions. -A linear gradient has a control vector and color stops along the line. +Colors transitions are based on a line, where colors are assigned to + stop points along the line, and colors for in-between points are + interpolated from the stop-point colors. The color of a point on the + gradient's line is propagated to all points in the drawing context + that are touched by a line through the point and perpendicular to the + gradient's line. -@defconstructor[([x0 real? 0] - [y0 real? 0] - [x1 real? 0] - [y1 real? 0] - [stops (listof/c (list/c (real-in 0 1) (is-a?/c color%))) null])]{ -Creates a linear gradient with the given line and color stops. -The gradients control vector is defined by its start point (x0, y0) and end point (x1, y1). -A color stop is a list containing an offset value between 0.0 and 1.0 and a @racket[color%]. +@defconstructor[([x0 real?] + [y0 real?] + [x1 real?] + [y1 real?] + [stops (listof/c (list/c (real-in 0 1) (is-a?/c color%)))])]{ + +Creates a linear gradient with a line from (@racket[x0], @racket[y0]) +to end point (@racket[x1], @racket[y1]). The @racket[stops] list +assigns colors to stop points along the line, where @racket[0.0] +corresponds to (@racket[x0], @racket[y0]), @racket[1.0] corresponds to +(@racket[x1], @racket[y2]), and numbers in between correspond to +points in between. + +@examples[ + #:eval class-eval + (new linear-gradient% + [x0 0] [y0 100] [x1 300] [y1 100] + [stops + (list (list 0 (make-object color% 0 0 255)) + (list 0.5 (make-object color% 0 255 0)) + (list 1 (make-object color% 255 0 0)))]) + (make-object linear-gradient% + 0 100 300 100 + (list (list 0 (make-object color% 0 0 255)) + (list 0.5 (make-object color% 0 255 0)) + (list 1 (make-object color% 255 0 0)))) +]} -} @defmethod[(get-line) (values real? real? real? real?)]{ -Returns the gradient's control line. +Returns the gradient's control line as @racket[_x0], @racket[_y0], +@racket[_x1], and @racket[_y1]. } @@ -36,21 +61,6 @@ Returns the gradient's control line. Returns the gradient's list of color stops. -} - -} -@examples[ #:eval class-eval - (define grad (new linear-gradient% - [x0 0] [y0 100] [x1 300] [y1 100] - [stops - (list (list 0 (make-object color% 0 0 255)) - (list 0.5 (make-object color% 0 255 0)) - (list 1 (make-object color% 255 0 0)))])) - - (define grad2 (make-object linear-gradient% 0 0 100 300 - (list (list 0 (make-object color% 0 0 255)) - (list 0.5 (make-object color% 0 255 0)) - (list 1 (make-object color% 255 0 0)))))] - +}} @(close-eval class-eval) diff --git a/collects/scribblings/draw/pen-class.scrbl b/collects/scribblings/draw/pen-class.scrbl index ed7f70d75e..6da11e48c4 100644 --- a/collects/scribblings/draw/pen-class.scrbl +++ b/collects/scribblings/draw/pen-class.scrbl @@ -99,7 +99,7 @@ Returns the pen join style. The default is @scheme['round]. } @defmethod[(get-stipple) - (or/c (is-a?/c bitmap%) false/c)]{ + (or/c (is-a?/c bitmap%) #f)]{ Gets the current stipple bitmap, or returns @scheme[#f] if no stipple bitmap is installed. diff --git a/collects/scribblings/draw/radial-gradient-class.scrbl b/collects/scribblings/draw/radial-gradient-class.scrbl index 0133db2e0e..e3a132142e 100644 --- a/collects/scribblings/draw/radial-gradient-class.scrbl +++ b/collects/scribblings/draw/radial-gradient-class.scrbl @@ -7,56 +7,59 @@ @defclass/title[radial-gradient% object% ()]{ -A radial gradient is a pattern tool that is used for - filling in areas, such as the interior of a circle or ellipse. +A @deftech{radial gradient} is used with a @racket[brush%] to fill + areas, such as the interior of a rectangle or ellipse, with smooth + color transitions. -A radial gradient has two circles boundaries and color stops between the circles. +Colors transitions are based on two circles and the sequence of circles that + ``morph'' from the starting circle to the ending circle. Colors are + assigned to stop circles in the sequence, and the colors of + the start and end circles radiate inward and outward to points that + are not on any intermediate circles. -@defconstructor[([x0 real? 0] - [y0 real? 0] - [r0 real? 0] - [x1 real? 0] - [y1 real? 0] - [r1 real? 0] - [stops (listof/c (list/c (real-in 0 1) (is-a?/c color%))) null])]{ +@defconstructor[([x0 real?] + [y0 real?] + [r0 real?] + [x1 real?] + [y1 real?] + [r1 real?] + [stops (listof/c (list/c (real-in 0 1) (is-a?/c color%)))])]{ -Creates a radial gradient with the given circles boundaries and color stops. -Point (x0, y0) and radius r0 define the start bounding circle, while -point (x1, y1) and radius r1 define the end bounding circle. -The gradient's control vector extends from any point on the start circle to the -corresponding point on the end circle. -A color stop is a list containing an offset value between 0.0 and 1.0 and a @racket[color%]. +Creates a radial gradient with the starting circle as the one with +radius @racket[r0] centered at (@racket[x0], @racket[y0]) and the +ending circle as the one with radius @racket[r1] centered at +(@racket[x1], @racket[y1]). The @racket[stops] list assigns colors to +circles, where @racket[0.0] corresponds to the starting circle, +@racket[1.0] corresponds to the ending circle, and numbers in between +correspond to circles in between. -} +@examples[ + #:eval class-eval + (new radial-gradient% + [x0 0] [y0 100] [r0 10] [x1 300] [y1 100] [r1 100] + [stops + (list (list 0 (make-object color% 0 0 255)) + (list 0.5 (make-object color% 0 255 0)) + (list 1 (make-object color% 255 0 0)))]) + (make-object radial-gradient% 150 150 0 150 150 100 + (list (list 0 (make-object color% 0 0 255)) + (list 0.5 (make-object color% 0 255 0)) + (list 1 (make-object color% 255 0 0)))) +]} @defmethod[(get-circles) (values real? real? real? real? real? real?)]{ -Returns the gradient's boundary circles. +Returns the gradient's boundary circles as @racket[_x0], @racket[_y0], +@racket[_r0], @racket[_x1], @racket[_y1], and @racket[_r1]. } @defmethod[(get-stops) - (listof/c (list/c (real-in 0 1) (is-a?/c color%)))])]{ + (listof/c (list/c (real-in 0 1) (is-a?/c color%)))]{ Returns the gradient's list of color stops. -} - -} -@examples[ #:eval class-eval - (define grad (new radial-gradient% - [x0 0] [y0 100] [r0 10] [x1 300] [y1 100] [r1 100] - [stops - (list (list 0 (make-object color% 0 0 255)) - (list 0.5 (make-object color% 0 255 0)) - (list 1 (make-object color% 255 0 0)))])) - - (define grad2 (make-object radial-gradient% 150 150 0 150 150 100 - (list (list 0 (make-object color% 0 0 255)) - (list 0.5 (make-object color% 0 255 0)) - (list 1 (make-object color% 255 0 0)))))] +}} @(close-eval class-eval) - - diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index ae31b0c954..3663cb7a44 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -923,9 +923,40 @@ (let ([p (send dc get-pen)]) (send dc set-pen (make-object color% 0 0 0 0.1) 1 'solid) (send dc set-brush (make-object color% 255 0 200 0.5) 'solid) - (send dc draw-rectangle 250 310 20 20) + (send dc draw-rectangle 250 320 20 20) (send dc set-brush (make-object color% 0 255 200 0.5) 'solid) - (send dc draw-rectangle 260 320 20 20) + (send dc draw-rectangle 260 330 20 20) + (send dc set-pen p)) + + (let ([p (send dc get-pen)]) + (send dc set-pen "white" 1 'transparent) + (send dc set-brush (new brush% + [gradient + (make-object linear-gradient% + 300 0 380 0 + (list (list 0.0 + (make-object color% 255 0 0)) + (list 0.5 + (make-object color% 0 255 0)) + (list 1.0 + (make-object color% 0 0 255 0.0))))])) + (send dc draw-rectangle 300 320 80 20) + (send dc set-pen p)) + + (let ([p (send dc get-pen)]) + (send dc set-pen "white" 1 'transparent) + (send dc set-brush (new brush% + [gradient + (make-object radial-gradient% + 360 250 5 + 365 245 25 + (list (list 0.0 + (make-object color% 255 0 0)) + (list 0.5 + (make-object color% 0 255 0)) + (list 1.0 + (make-object color% 0 0 255 0.0))))])) + (send dc draw-rectangle 338 228 44 44) (send dc set-pen p)) (send dc draw-line 130 310 150 310) diff --git a/doc/release-notes/racket/Draw_and_GUI_5_1.txt b/doc/release-notes/racket/Draw_and_GUI_5_1.txt index 8e3b7069a2..a899d6a657 100644 --- a/doc/release-notes/racket/Draw_and_GUI_5_1.txt +++ b/doc/release-notes/racket/Draw_and_GUI_5_1.txt @@ -120,6 +120,8 @@ A `region%' can be created as independent of any `dc<%>', in which cases it uses the drawing context's current transformation at the time that it is installed as a clipping region. +Brushes now support linear and radial gradients. + The old 'xor mode for pens and brushes is no longer available (since it is not supported by Cairo).