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

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

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

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

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"

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

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

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"

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"

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

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

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

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

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

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

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)

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

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

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%)]{
 

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

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%)]{

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

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

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"

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

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)

collects/tests/racket/draw.rktl

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

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