From 68e005fb2c14551be54beb5543928ac9b7b769ac Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 1 May 2012 20:09:27 -0600 Subject: [PATCH] racket/draw: make-immutable-{color,brush,pen} => make-{color,brush,pen} Also, use keywords for `make-pen' and `make-brush'. Adding `make-pen' and `make-color' creates many conflicts among teaching libraries, such as `2htdp/image'. These are easy to fix up in the tree, but adding such obvious names to `racket/draw' may create other compatibility problems, so we might have to reconsider the names. In consultation with Asumu. --- collects/2htdp/private/image-more.rkt | 3 +- collects/2htdp/private/img-err.rkt | 3 +- collects/deinprogramm/image.rkt | 3 +- collects/deinprogramm/world.rkt | 2 +- collects/htdp/image.rkt | 3 +- collects/htdp/world.rkt | 2 +- collects/mred/private/wx/cocoa/canvas.rkt | 2 +- collects/mred/private/wx/gtk/canvas.rkt | 2 +- collects/mrlib/image-core.rkt | 3 +- collects/mrlib/scribblings/common.rkt | 2 +- .../picturing-programs/private/map-image.rkt | 2 +- collects/plot/common/draw.rkt | 6 +- collects/racket/draw.rkt | 6 +- collects/racket/draw/private/brush.rkt | 23 +++--- collects/racket/draw/private/color.rkt | 4 +- collects/racket/draw/private/contract.rkt | 41 +++++----- collects/racket/draw/private/pen.rkt | 25 +++--- collects/scribblings/draw/brush-class.scrbl | 25 +----- collects/scribblings/draw/color-class.scrbl | 12 +-- collects/scribblings/draw/draw-funcs.scrbl | 80 +++++++++++++++++++ collects/scribblings/draw/pen-class.scrbl | 21 +---- .../2htdp/scribblings/image-guide.scrbl | 2 +- .../teachpack/2htdp/scribblings/image.scrbl | 2 +- .../2htdp/scribblings/planetcute.scrbl | 2 +- collects/tests/gracket/dc.rktl | 47 +++++++++++ collects/tests/racket/draw.rktl | 43 ---------- doc/release-notes/racket/HISTORY.txt | 3 + 27 files changed, 212 insertions(+), 157 deletions(-) delete mode 100644 collects/tests/racket/draw.rktl diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index ee820c4f6e..5f8a7d1a09 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -5,7 +5,8 @@ racket/match racket/contract racket/class - racket/draw + (except-in racket/draw + make-pen make-color) ;(only-in racket/gui/base frame% canvas% slider% horizontal-panel% button%) htdp/error racket/math diff --git a/collects/2htdp/private/img-err.rkt b/collects/2htdp/private/img-err.rkt index 19c57dca7c..e27f979c74 100644 --- a/collects/2htdp/private/img-err.rkt +++ b/collects/2htdp/private/img-err.rkt @@ -17,7 +17,8 @@ (require htdp/error racket/class lang/posn - racket/draw + (except-in racket/draw + make-pen make-color) mrlib/image-core (for-syntax racket/base racket/list)) diff --git a/collects/deinprogramm/image.rkt b/collects/deinprogramm/image.rkt index c5dc890ea1..b62d032304 100644 --- a/collects/deinprogramm/image.rkt +++ b/collects/deinprogramm/image.rkt @@ -7,7 +7,8 @@ collects/tests/deinprogramm/image.rkt |# -(require mred +(require (except-in mred + make-color) mzlib/class mrlib/cache-image-snip mzlib/math diff --git a/collects/deinprogramm/world.rkt b/collects/deinprogramm/world.rkt index ab442b8bb0..d5be3eaea5 100644 --- a/collects/deinprogramm/world.rkt +++ b/collects/deinprogramm/world.rkt @@ -8,7 +8,7 @@ ;; Thu Dec 1 17:03:03 EST 2005: fixed place-image; all coordinates okay now (require - mred + (except-in mred make-color) mzlib/class htdp/error "image.rkt" diff --git a/collects/htdp/image.rkt b/collects/htdp/image.rkt index 839bb1100d..177e333dad 100644 --- a/collects/htdp/image.rkt +++ b/collects/htdp/image.rkt @@ -8,7 +8,8 @@ plt/collects/tests/mzscheme/htdp-image.rkt |# -(require mred +(require (except-in mred + make-color) mzlib/class mrlib/cache-image-snip mzlib/math diff --git a/collects/htdp/world.rkt b/collects/htdp/world.rkt index b9ca5e072d..8c8235bb4c 100644 --- a/collects/htdp/world.rkt +++ b/collects/htdp/world.rkt @@ -68,7 +68,7 @@ Matthew (require scheme/class scheme/local scheme/bool - mred + (except-in mred make-color) htdp/error htdp/image mrlib/cache-image-snip diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 434c113d92..94926f6ad5 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -5,7 +5,7 @@ racket/draw racket/draw/private/gl-context (except-in racket/draw/private/color - color% make-immutable-color) + color% make-color) (only-in racket/draw/private/bitmap quartz-bitmap%) "pool.rkt" "utils.rkt" diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 80adf564f6..e13660d06d 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -4,7 +4,7 @@ racket/draw ffi/unsafe/alloc (except-in racket/draw/private/color - color% make-immutable-color) + color% make-color) racket/draw/private/local "../common/backing-dc.rkt" "../common/canvas-mixin.rkt" diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index 214aa6a648..7da15b38a2 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -28,7 +28,8 @@ has been moved out). |# (require racket/class - racket/draw + (except-in racket/draw + make-pen make-color) (for-syntax racket/base) file/convertible racket/math diff --git a/collects/mrlib/scribblings/common.rkt b/collects/mrlib/scribblings/common.rkt index a733b1d0be..cd0653ba60 100644 --- a/collects/mrlib/scribblings/common.rkt +++ b/collects/mrlib/scribblings/common.rkt @@ -4,7 +4,7 @@ (for-label scheme/base scheme/contract scheme/class - scheme/gui/base)) + (except-in scheme/gui/base make-color make-pen))) (provide (all-from-out scribble/manual) (for-label (all-from-out scheme/base diff --git a/collects/picturing-programs/private/map-image.rkt b/collects/picturing-programs/private/map-image.rkt index 3dc6a03fbe..b9fa76147e 100644 --- a/collects/picturing-programs/private/map-image.rkt +++ b/collects/picturing-programs/private/map-image.rkt @@ -22,7 +22,7 @@ ; render seems to take about a ms). ; Apr 28, 2012: added fold-image and fold-image/extra. -(require racket/draw +(require (except-in racket/draw make-color make-pen) racket/snip racket/class 2htdp/image diff --git a/collects/plot/common/draw.rkt b/collects/plot/common/draw.rkt index cb50e3934e..b8904e6f9c 100644 --- a/collects/plot/common/draw.rkt +++ b/collects/plot/common/draw.rkt @@ -71,15 +71,15 @@ ;; Returns an immutable instance of color%. Immutable colors are faster because they don't have to ;; have immutable copies made when they're used in a dc. (define (make-color% r g b) - (make-immutable-color r g b)) + (make-color r g b)) ;; Returns an immutable instance of pen%. Same reasoning as for make-color%. (define (make-pen% r g b w s) - (make-immutable-pen (make-color% r g b) w s)) + (make-pen #:color (make-color% r g b) #:width w #:style s)) ;; Returns an immutable instance of brush%. Same reasoning as for make-color%. (define (make-brush% r g b s) - (make-immutable-brush (make-color% r g b) s)) + (make-brush #:color (make-color% r g b) #:style s)) (define (color%? c) (is-a? c color%)) diff --git a/collects/racket/draw.rkt b/collects/racket/draw.rkt index 83195ce490..1d6cdbdb08 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -56,6 +56,6 @@ [dc-path% dc-path%/c] [gl-config% gl-config%/c] [bitmap% bitmap%/c] - [make-immutable-color make-immutable-color/c] - [make-immutable-pen make-immutable-pen/c] - [make-immutable-brush make-immutable-brush/c]) + [make-color make-color/c] + [make-pen make-pen/c] + [make-brush make-brush/c]) diff --git a/collects/racket/draw/private/brush.rkt b/collects/racket/draw/private/brush.rkt index 7dcbc7ccb5..d76e3ed1a2 100644 --- a/collects/racket/draw/private/brush.rkt +++ b/collects/racket/draw/private/brush.rkt @@ -11,7 +11,7 @@ "transform.rkt") (provide brush% - make-immutable-brush + make-brush brush-list% the-brush-list brush-style-symbol?) @@ -135,14 +135,19 @@ ;; color style stipple gradient transformation -> brush% ;; produce an immutable brush% object -(define (make-immutable-brush [color "black"] - [style 'solid] - [stipple #f] - [gradient #f] - [transformation #f]) - (define brush (make-object brush% color style stipple gradient transformation)) - (send brush set-immutable) - brush) +(define (make-brush #:color [color black] + #:style [style 'solid] + #:stipple [stipple #f] + #:gradient [gradient #f] + #:transformation [transformation #f] + #:immutable? [immutable? #t]) + (or (and (not (or stipple gradient transformation (not immutable?))) + (send the-brush-list find-or-create-brush color style)) + (let () + (define brush (make-object brush% color style stipple gradient transformation)) + (when immutable? + (send brush set-immutable)) + brush))) ;; unsafe (and so exported by `racket/draw/unsafe/brush'): (provide (protect-out make-handle-brush)) diff --git a/collects/racket/draw/private/color.rkt b/collects/racket/draw/private/color.rkt index 219fda2841..53206a421a 100644 --- a/collects/racket/draw/private/color.rkt +++ b/collects/racket/draw/private/color.rkt @@ -3,7 +3,7 @@ "syntax.rkt") (provide color% - make-immutable-color + make-color color-red color-green color-blue @@ -83,7 +83,7 @@ ;; byte byte byte real -> color% ;; produce an immutable color% object -(define (make-immutable-color [r 0] [g 0] [b 0] [a 1.0]) +(define (make-color r g b [a 1.0]) (define color (make-object color% r g b a)) (send color set-immutable) color) diff --git a/collects/racket/draw/private/contract.rkt b/collects/racket/draw/private/contract.rkt index 356bc42cb4..02d5a25125 100644 --- a/collects/racket/draw/private/contract.rkt +++ b/collects/racket/draw/private/contract.rkt @@ -49,33 +49,34 @@ (vector/c (vector/c real? real? real? real? real? real?) real? real? real? real? real?)) -(define make-immutable-color/c - (->* () - ((integer-in 0 255) +(define make-color/c + (->* ((integer-in 0 255) (integer-in 0 255) - (integer-in 0 255) - (real-in 0 1)) + (integer-in 0 255)) + ((real-in 0 1)) (is-a?/c color%))) -(define make-immutable-brush/c +(define make-brush/c (->* () - ((or/c string? (is-a?/c color%)) - brush-style/c - (or/c #f (is-a?/c bitmap%)) - (or/c #f - (is-a?/c linear-gradient%) - (is-a?/c radial-gradient%)) - (or/c #f transformation-vector/c)) + (#:color (or/c string? (is-a?/c color%)) + #:style brush-style/c + #:stipple (or/c #f (is-a?/c bitmap%)) + #:gradient (or/c #f + (is-a?/c linear-gradient%) + (is-a?/c radial-gradient%)) + #:transformation (or/c #f transformation-vector/c) + #:immutable? any/c) (is-a?/c brush%))) -(define make-immutable-pen/c +(define make-pen/c (->* () - ((or/c string? (is-a?/c color%)) - (real-in 0 255) - pen-style/c - pen-cap-style/c - pen-join-style/c - (or/c #f (is-a?/c bitmap%))) + (#:color (or/c string? (is-a?/c color%)) + #:width (real-in 0 255) + #:style pen-style/c + #:cap pen-cap-style/c + #:join pen-join-style/c + #:stipple (or/c #f (is-a?/c bitmap%)) + #:immutable? any/c) (is-a?/c pen%))) (define dc<%>/c diff --git a/collects/racket/draw/private/pen.rkt b/collects/racket/draw/private/pen.rkt index 32dc7d4aea..b05241038e 100644 --- a/collects/racket/draw/private/pen.rkt +++ b/collects/racket/draw/private/pen.rkt @@ -7,7 +7,7 @@ "bitmap.rkt") (provide pen% - make-immutable-pen + make-pen pen-list% the-pen-list pen-width? pen-style-symbol?) @@ -134,15 +134,20 @@ ;; color width style cap join stipple -> pen% ;; produce an immutable pen% object -(define (make-immutable-pen [color "black"] - [width 0] - [style 'solid] - [cap 'round] - [join 'round] - [stipple #f]) - (define pen (make-object pen% color width style cap join stipple)) - (send pen set-immutable) - pen) +(define (make-pen #:color [color black] + #:width [width 0] + #:style [style 'solid] + #:cap [cap 'round] + #:join [join 'round] + #:stipple [stipple #f] + #:immutable? [immutable? #t]) + (or (and (not (or stipple (not immutable?))) + (send the-pen-list find-or-create-pen color width style cap join)) + (let () + (define pen (make-object pen% color width style cap join stipple)) + (when immutable? + (send pen set-immutable)) + pen))) ;; ---------------------------------------- diff --git a/collects/scribblings/draw/brush-class.scrbl b/collects/scribblings/draw/brush-class.scrbl index 14af4b86de..7fc547f317 100644 --- a/collects/scribblings/draw/brush-class.scrbl +++ b/collects/scribblings/draw/brush-class.scrbl @@ -88,6 +88,8 @@ To avoid creating multiple brushes with the same characteristics, use @indexed-racket[the-brush-list], or provide a color and style to @xmethod[dc<%> set-brush]. +See also @racket[make-brush]. + @defconstructor[([color (or/c string? (is-a?/c color%)) "black"] [style (or/c 'transparent 'solid 'opaque @@ -114,29 +116,6 @@ Creates a brush with the given color, @tech{brush style}, @tech{brush @racket[color-database<%>] for information about color names; if the name is not known, the brush's color is black.} -@defproc[(make-immutable-brush - [color (or/c string? (is-a?/c color%)) "black"] - [style (or/c 'transparent 'solid 'opaque - 'xor 'hilite 'panel - 'bdiagonal-hatch 'crossdiag-hatch - 'fdiagonal-hatch 'cross-hatch - '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] - [transformation (or/c #f (vector/c (vector/c real? real? real? - real? real? real?) - real? real? real? real? real?)) - #f]) - (is-a?/c brush%)]{ - -Creates a new immutable brush with the given initialization values. -} - @defmethod[(get-color) (is-a?/c color%)]{ diff --git a/collects/scribblings/draw/color-class.scrbl b/collects/scribblings/draw/color-class.scrbl index 7350cf4f1b..ee29851dfb 100644 --- a/collects/scribblings/draw/color-class.scrbl +++ b/collects/scribblings/draw/color-class.scrbl @@ -12,7 +12,7 @@ A color is an object representing a red-green-blue (RGB) combination 0, 0.5) is translucent red. See @racket[color-database<%>] for information about obtaining a color -object using a color name. +object using a color name, and see also @racket[make-color]. @defconstructor*/make[(() @@ -29,16 +29,6 @@ Creates a new color with the given RGB values and alpha, or matching } -@defproc[(make-immutable-color - [red (integer-in 0 255)] - [green (integer-in 0 255)] - [blue (integer-in 0 255)] - [alpha (real-in 0 1) 1.0]) - (is-a?/c color%)]{ - -Creates a new immutable color with the given RGB values and alpha. -} - @defmethod[(alpha) (real-in 0 1)]{ diff --git a/collects/scribblings/draw/draw-funcs.scrbl b/collects/scribblings/draw/draw-funcs.scrbl index e1b7fcc6e9..d19fe4143a 100644 --- a/collects/scribblings/draw/draw-funcs.scrbl +++ b/collects/scribblings/draw/draw-funcs.scrbl @@ -48,6 +48,58 @@ more useful way. See also @racket[make-platform-bitmap] and @secref["Portability"]. } + +@defproc[(make-brush + [#:color color (or/c string? (is-a?/c color%)) (make-color 0 0 0)] + [#:style style (or/c 'transparent 'solid 'opaque + 'xor 'hilite 'panel + 'bdiagonal-hatch 'crossdiag-hatch + 'fdiagonal-hatch 'cross-hatch + 'horizontal-hatch 'vertical-hatch) + 'solid] + [#:stipple stipple (or/c #f (is-a?/c bitmap%)) + #f] + [#:gradient gradient (or/c #f + (is-a?/c linear-gradient%) + (is-a?/c radial-gradient%)) + #f] + [#:transformation + transformation (or/c #f (vector/c (vector/c real? real? real? + real? real? real?) + real? real? real? real? real?)) + #f] + [#:immutable? immutable? any/c #t]) + (is-a?/c brush%)]{ + +Creates a @racket[brush%] instance. This procedure provides a +nearly equivalent interface compared to using +@racket[make-object] with @racket[brush%], but it also supports +the creation of immutable brushes (and creates immutable burshes by default). + +When @racket[stipple] is @racket[#f], @racket[gradient] is +@racket[#f], @racket[transformation] is @racket[#f], +@racket[immutable?] is true, and @racket[color] is either a +@racket[color%] object or a string in @racket[the-color-database], the +result brush is created via @method[brush-list% find-or-create-brush] of +@racket[the-brush-list].} + + +@defproc[(make-color + [red (integer-in 0 255)] + [green (integer-in 0 255)] + [blue (integer-in 0 255)] + [alpha (real-in 0 1) 1.0]) + (is-a?/c color%)]{ + +Creates a @racket[color%] instance. This procedure provides a +nearly equivalent interface compared to using +@racket[make-object] with @racket[color%], but it creates +an immutable @racket[color%] object. + +To create an immutable color based on a color string, use @method[color-database<%> find-color] +or @racket[the-color-database].} + + @defproc[(make-font [#:size size (integer-in 1 1024) 12] [#:face face (or/c string? #f) #f] [#:family family (or/c 'default 'decorative 'roman 'script @@ -81,6 +133,34 @@ width height)] otherwise. This procedure is preferred to using overloaded.} +@defproc[(make-pen + [#:color color (or/c string? (is-a?/c color%)) (make-color 0 0 0)] + [#:width width (real-in 0 255) 0] + [#:style style (or/c 'transparent 'solid 'xor 'hilite + 'dot 'long-dash 'short-dash 'dot-dash + 'xor-dot 'xor-long-dash 'xor-short-dash + 'xor-dot-dash) + 'solid] + [#:cap cap (or/c 'round 'projecting 'butt) + 'round] + [#:join join (or/c 'round 'bevel 'miter) + 'round] + [#:stipple stipple (or/c #f (is-a?/c bitmap%)) + #f] + [#:immutable? immutable? any/c #t]) + (is-a?/c pen%)]{ + +Creates a @racket[pen%] instance. This procedure provides a +nearly equivalent interface compared to using +@racket[make-object] with @racket[pen%], but it also supports +the creation of immutable pens (and creates immutable pens by default). + +When @racket[stipple] is @racket[#f], @racket[immutable?] is true, and +@racket[color] is either a @racket[color%] object or a string in +@racket[the-color-database], the result pen is created via +@method[pen-list% find-or-create-pen] of @racket[the-pen-list].} + + @defproc[(make-platform-bitmap [width exact-positive-integer?] [height exact-positive-integer?]) (is-a?/c bitmap%)]{ diff --git a/collects/scribblings/draw/pen-class.scrbl b/collects/scribblings/draw/pen-class.scrbl index 33a6b8e634..770fb93695 100644 --- a/collects/scribblings/draw/pen-class.scrbl +++ b/collects/scribblings/draw/pen-class.scrbl @@ -65,6 +65,8 @@ When drawing in @racket['smoothed] or @racket['aligned] mode, a pen's canvas and bitmap contexts, a zero-width pen behaves the same as a pen of size @racket[1]. +See also @racket[make-pen]. + @defconstructor[([color (or/c string? (is-a?/c color%)) "black"] [width (real-in 0 255) 0] @@ -87,25 +89,6 @@ Creates a pen with the given color, width, @tech{pen style}, @tech{cap style}, @ } -@defproc[(make-immutable-pen - [color (or/c string? (is-a?/c color%)) "black"] - [width (real-in 0 255) 0] - [style (or/c 'transparent 'solid 'xor 'hilite - 'dot 'long-dash 'short-dash 'dot-dash - 'xor-dot 'xor-long-dash 'xor-short-dash - 'xor-dot-dash) - 'solid] - [cap (or/c 'round 'projecting 'butt) - 'round] - [join (or/c 'round 'bevel 'miter) - 'round] - [stipple (or/c #f (is-a?/c bitmap%)) - #f]) - (is-a?/c pen%)]{ - -Creates a new immutable pen with the given initialization values. -} - @defmethod[(get-cap) (or/c 'round 'projecting 'butt)]{ diff --git a/collects/teachpack/2htdp/scribblings/image-guide.scrbl b/collects/teachpack/2htdp/scribblings/image-guide.scrbl index a9543d6a29..d7e7557fe5 100644 --- a/collects/teachpack/2htdp/scribblings/image-guide.scrbl +++ b/collects/teachpack/2htdp/scribblings/image-guide.scrbl @@ -3,7 +3,7 @@ @(require (for-label 2htdp/image (except-in lang/htdp-beginner posn make-posn posn? posn-x posn-y image?) lang/posn - racket/gui/base) + (except-in racket/gui/base make-color make-pen)) "shared.rkt" "img-eval.rkt" scribble/decode diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index a557b64595..a5b32b5133 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -4,7 +4,7 @@ 2htdp/image (except-in lang/htdp-beginner posn make-posn posn? posn-x posn-y image?) lang/posn - racket/gui/base + (except-in racket/gui/base make-color make-pen) (only-in racket/base path-string?)) lang/posn "shared.rkt" diff --git a/collects/teachpack/2htdp/scribblings/planetcute.scrbl b/collects/teachpack/2htdp/scribblings/planetcute.scrbl index e20e16701e..9cb0b3324d 100644 --- a/collects/teachpack/2htdp/scribblings/planetcute.scrbl +++ b/collects/teachpack/2htdp/scribblings/planetcute.scrbl @@ -6,7 +6,7 @@ scribble/eval 2htdp/image racket/runtime-path - racket/draw + (except-in racket/draw make-color make-pen) racket/class (for-syntax racket/base) (for-label 2htdp/image diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl index 6e23667a03..ec57195665 100644 --- a/collects/tests/gracket/dc.rktl +++ b/collects/tests/gracket/dc.rktl @@ -520,4 +520,51 @@ ;; ---------------------------------------- +(let ([color (new color%)]) + (test #f 'color (send color is-immutable?)) + (test 0 'color (send color red)) + (test 0 'color (send color green)) + (test 0 'color (send color blue)) + (test 1.0 'color (send color alpha))) + +(let ([color (make-color 101 102 103 0.9)]) + (test #t 'color (send color is-immutable?)) + (test 101 'color (send color red)) + (test 102 'color (send color green)) + (test 103 'color (send color blue)) + (test 0.9 'color (send color alpha))) + +(let ([color (make-color 0 0 0)]) + (test #t 'color (send color is-immutable?)) + (test 0 'color (send color red)) + (test 0 'color (send color green)) + (test 0 'color (send color blue)) + (test 1.0 'color (send color alpha))) + +;; ---------------------------------------- + +(let ([brush (new brush%)]) + (test #f 'brush (send brush is-immutable?))) + +(let ([brush (make-brush)]) + (test #t 'brush (send brush is-immutable?)) + (test #t 'brush (eq? brush (send the-brush-list find-or-create-brush "black" 'solid)))) + +(let ([brush (make-brush #:immutable? #f)]) + (test #f 'brush (send brush is-immutable?))) + +;; ---------------------------------------- + +(let ([pen (new pen%)]) + (test #f 'pen (send pen is-immutable?))) + +(let ([pen (make-pen)]) + (test #t 'pen (send pen is-immutable?)) + (test #t 'pen (eq? pen (send the-pen-list find-or-create-pen "black" 0 'solid)))) + +(let ([pen (make-pen #:immutable? #f)]) + (test #f 'pen (send pen is-immutable?))) + +;; ---------------------------------------- + (report-errs) diff --git a/collects/tests/racket/draw.rktl b/collects/tests/racket/draw.rktl deleted file mode 100644 index a7be1a9975..0000000000 --- a/collects/tests/racket/draw.rktl +++ /dev/null @@ -1,43 +0,0 @@ -(load-relative "loadtest.rktl") - -(Section 'draw) -(require racket/draw) - -;; ---------------------------------------- - -(let ([color (new color%)]) - (test #f (λ (c) (send c is-immutable?)) color) - (test 0 (λ (c) (send c red)) color) - (test 0 (λ (c) (send c green)) color) - (test 0 (λ (c) (send c blue)) color) - (test 1.0 (λ (c) (send c alpha)) color)) - -(let ([color (make-immutable-color 101 102 103 0.9)]) - (test #t (λ (c) (send c is-immutable?)) color) - (test 101 (λ (c) (send c red)) color) - (test 102 (λ (c) (send c green)) color) - (test 103 (λ (c) (send c blue)) color) - (test 0.9 (λ (c) (send c alpha)) color)) - -(let ([color (make-immutable-color)]) - (test #t (λ (c) (send c is-immutable?)) color) - (test 0 (λ (c) (send c red)) color) - (test 0 (λ (c) (send c green)) color) - (test 0 (λ (c) (send c blue)) color) - (test 1.0 (λ (c) (send c alpha)) color)) - -;; ---------------------------------------- - -(let ([brush (new brush%)]) - (test #f (λ (b) (send b is-immutable?)) brush)) - -(let ([brush (make-immutable-brush)]) - (test #t (λ (b) (send b is-immutable?)) brush)) - -;; ---------------------------------------- - -(let ([pen (new pen%)]) - (test #f (λ (p) (send p is-immutable?)) pen)) - -(let ([pen (make-immutable-pen)]) - (test #t (λ (p) (send p is-immutable?)) pen)) \ No newline at end of file diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 638220c5fe..e19f42190b 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,3 +1,6 @@ +Version 5.3.0.4 +racket/draw: added make-color, make-brush, make-pen + Version 5.3.0.3 Added module-path-index-submodule Changed module-path-index-join to support a submodule argument