gradients: refine checking and docs to fit various conventions

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%

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<%>

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%

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))
 

collects/racket/draw/private/gradient.rkt

@@ -4,72 +4,63 @@
          "color.rkt")
 
 (provide linear-gradient%
-         radial-gradient%
+         radial-gradient%)
-         make-linear-gradient
-         make-radial-gradient)
-
-;(define gradient<%> 
-;  (interface ()
-;    get-stops))
 
 (define (check-reals name lst)
-  (for ([x lst])
+  (for ([x (in-list lst)])
     (unless (real? x)
-     (raise-type-error (init-name name) "Coordinate must be a real? ~a" x))))
+      (raise-type-error (init-name name) "real number" x))))
 
 (define (check-radius name lst)
-  (for ([x lst])
+  (for ([x (in-list lst)])
     (unless (and (real? x) (not (negative? x)))
-     (raise-type-error (init-name name) "Radius must be a real? ~a" 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))
+  (unless (and (list? stops)
-  (for ([x stops])
+               (for/and ([x (in-list stops)])
-    (unless (list? x) (error name "A stop must be a list ~a" x))
+                 (and (list? x)
-    (unless (= (length x) 2) (error  name "A stop must be a element list ~a" x))
+                      (= (length x) 2)
-    (unless (and (real? (car x)) (<= 0.0 (car x) 1.0)) 
+                      (real? (car x))
-      (error  name "First element of a stop must be a real between 0.0 and 1.0 ~a" (car x)))
+                      (<= 0.0 (car x) 1.0)
-    (unless (is-a? (cadr x) color%) 
+                      (is-a? (cadr x) color%))))
-      (error  name "Second element of a stop must be a color% ~a" (cdr x)))))
+    (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% 
-(define linear-gradient% (class object%
+  (class object%
-  (init-field [x0 0]
+    (init x0 y0 x1 y1 stops)
-              [y0 0]
+    (define _x0 x0)
-              [x1 0]
+    (define _y0 y0)
-              [y1 0]
+    (define _x1 x1)
-              [stops null])
+    (define _y1 y1)
+    (define _stops stops)
 
     (check-reals 'linear-gradient% (list x0 y0 x1 y1))
     (check-stops 'linear-gradient% stops)
 
     (super-new)
 
-  (define/public (get-line) (values x0 y0 x1 y1))
+    (define/public (get-line) (values _x0 _y0 _x1 _y1))
-  (define/public (get-stops) stops)))
+    (define/public (get-stops) _stops)))
 
-;(define radial-gradient% (class* object% (gradient<%>)
+(define radial-gradient% 
-(define radial-gradient% (class object%
+  (class object%
-  (init-field [x0 0]
+    (init x0 y0 r0 x1 y1 r1 stops)
-              [y0 0]
+    (define _x0 x0)
-              [r0 0]
+    (define _y0 y0)
-              [x1 0]
+    (define _r0 r0)
-              [y1 0]
+    (define _x1 x1)
-              [r1 0]
+    (define _y1 y1)
-              [stops null])
+    (define _r1 r1)
+    (define _stops stops)
 
-  (check-reals  'radial-gradient% (list x0 y0 x1 y1))
+    (check-reals  'radial-gradient% (list _x0 _y0 _x1 _y1))
-  (check-radius 'radial-gradient% (list r0 r1))
+    (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-circles) (values _x0 _y0 _r0 _x1 _y1 _r1))
-  (define/public (get-stops) stops)))
+    (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))
-

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
+As an alternative to a color, style, and stipple, a brush can have a
-@racket[radial-gradient%].
+ 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
+A brush's style is one of the following (but is ignored if the brush
-(new brush% [gradient (make-object linear-gradient% 0 0 10 10 
+ has a gradient):
-  (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:
 
 @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]
+                 [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.
 

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
+A @deftech{linear gradient} is used with a @racket[brush%] to fill
- filling in areas, such as the interior of a rectangle or ellipse.
+ 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.
+@defconstructor[([x0 real?]
-The gradients control vector is defined by its start point (x0, y0) and end point (x1, y1).
+                 [y0 real?]
-A color stop is a list containing an offset value between 0.0 and 1.0 and a @racket[color%].
+                 [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)

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.

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
+A @deftech{radial gradient} is used with a @racket[brush%] to fill
- filling in areas, such as the interior of a circle or ellipse.
+ 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]
+@defconstructor[([x0 real?]
-                 [y0 real? 0]
+                 [y0 real?]
-                 [r0 real? 0]
+                 [r0 real?]
-                 [x1 real? 0]
+                 [x1 real?]
-                 [y1 real? 0]
+                 [y1 real?]
-                 [r1 real? 0]
+                 [r1 real?]
-                 [stops (listof/c (list/c (real-in 0 1) (is-a?/c color%))) null])]{
+                 [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.
+Creates a radial gradient with the starting circle as the one with
-Point (x0, y0) and radius r0 define the start bounding circle, while
+radius @racket[r0] centered at (@racket[x0], @racket[y0]) and the
-point (x1, y1) and radius r1 define the end bounding circle.
+ending circle as the one with radius @racket[r1] centered at
-The gradient's control vector extends from any point on the start circle to the
+(@racket[x1], @racket[y1]). The @racket[stops] list assigns colors to
-corresponding point on the end circle.
+circles, where @racket[0.0] corresponds to the starting circle,
-A color stop is a list containing an offset value between 0.0 and 1.0 and a @racket[color%].
+@racket[1.0] corresponds to the ending circle, and numbers in between
+correspond to circles in between.
 
-}
+@examples[ 
-
+  #:eval class-eval
-@defmethod[(get-circles)
+  (new radial-gradient% 
-           (values real? real? real? real? real? real?)]{
-
-Returns the gradient's boundary circles.
-
-}
-
-@defmethod[(get-stops)
-           (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)))]))
+           (list 1   (make-object color% 255 0 0)))])
-
+  (make-object radial-gradient% 150 150 0 150 150 100
-  (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)))))]
+                    (list 1   (make-object color% 255 0 0))))
+]}
+
+@defmethod[(get-circles)
+           (values real? real? real? real? real? real?)]{
+
+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%)))]{
+
+Returns the gradient's list of color stops.
+
+}}
 
 @(close-eval class-eval)
-
-

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)

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).