suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gradients: refine checking and docs to fit various conventions

Browse Source
This commit is contained in:
Matthew Flatt 2011-01-04 12:43:57 -07:00
parent 13ddab969b
commit 553723627c
11 changed files with 180 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/mred-sig.rkt
View File

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

2
collects/racket/draw.rkt
View File

@ -25,8 +25,6 @@
brush% brush-list% the-brush-list
linear-gradient%
radial-gradient%
make-linear-gradient
make-radial-gradient
region%
dc-path%
dc<%>

2
collects/racket/draw/draw-sig.rkt
View File

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

2
collects/racket/draw/private/brush.rkt
View File

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

101
collects/racket/draw/private/gradient.rkt
View File

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

30
collects/scribblings/draw/brush-class.scrbl
View File

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

68
collects/scribblings/draw/linear-gradient-class.scrbl
View File

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

2
collects/scribblings/draw/pen-class.scrbl
View File

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

75
collects/scribblings/draw/radial-gradient-class.scrbl
View File

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

35
collects/tests/gracket/draw.rkt
View File

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

2
doc/release-notes/racket/Draw_and_GUI_5_1.txt
View File

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