add transparent "color" to 2htdp/image.

pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt

@@ -958,6 +958,7 @@ has been moved out).
        (let ([color (get-color-arg (text-color np-atomic-shape))])
          (send dc set-text-foreground 
                (cond
+                 [(equal? color "transparent") transparent-color]
                  [(string? color)
                   (or (send the-color-database find-color color)
                       (send the-color-database find-color "black"))]
@@ -1195,9 +1196,11 @@ the mask bitmap and the original bitmap are all together in a single bytes!
 
 (define (get-color-arg color [extra-alpha 255])
   (cond
+    [(equal? color "transparent") transparent-color]
     [(string? color) 
-     (define color-obj (or (send the-color-database find-color color)
+     (define color-obj 
-                           (send the-color-database find-color "black")))
+       (or (send the-color-database find-color color)
+           (send the-color-database find-color "black")))
      (make-object color%
        (send color-obj red)
        (send color-obj green)
@@ -1211,6 +1214,7 @@ the mask bitmap and the original bitmap are all together in a single bytes!
        (* (/ (color-alpha color) 255)
           (/ extra-alpha 255)))]))
 
+(define transparent-color (make-object color% 255 255 255 0))
 
 (define (pen->pen-obj/cache pen)
   (send the-pen-list find-or-create-pen 
@@ -1343,3 +1347,4 @@ the mask bitmap and the original bitmap are all together in a single bytes!
 (provide get-shape get-bb get-pinhole get-normalized? get-normalized-shape)
 
 (provide np-atomic-shape? atomic-shape? simple-shape? cn-or-simple-shape? normalized-shape?)
+

pkgs/htdp/2htdp/private/img-err.rkt

@@ -203,13 +203,14 @@
        [(color? arg) arg]
        [(pen? arg) arg]
        [else
-        (let* ([color-str
+        (define color-str
-                (if (symbol? arg)
+          (if (symbol? arg)
-                    (symbol->string arg)
+              (symbol->string arg)
-                    arg)])
+              arg))
-          (if (send the-color-database find-color color-str)
+        (cond
-              color-str
+          [(equal? color-str "transparent") "transparent"]
-              "black"))])]
+          [(send the-color-database find-color color-str) color-str]
+          [else "black"])])]
     [(color-list)
      (check-arg fn-name (and (list? arg) (andmap image-color? arg)) 'color-list i arg)
      arg]

pkgs/htdp/2htdp/tests/test-image.rkt

@@ -115,7 +115,8 @@
         (loop (image-bb x))
         (loop (image-normalized? x)))]
       [(object? x)
-       ;; add a random number here to hack around the way Eli's tester treats two errors as a passing test
+       ;; add a random number here to hack around the way Eli's 
+       ;; tester treats two errors as a passing test
        (error 'round-numbers/proc "cannot handle objects ~a" (random))]
       [(let-values ([(a b) (struct-info x)]) a)
        =>
@@ -317,6 +318,21 @@
       =>
       (rectangle 10 10 'solid 'black))
 
+(test (overlay (rectangle 10 10 'solid "blue")
+               (rectangle 10 10 'solid "transparent"))
+      =>
+      (rectangle 10 10 'solid "blue"))
+
+(test (overlay (rectangle 10 10 'solid 'transparent)
+               (rectangle 10 10 'solid "blue"))
+      =>
+      (rectangle 10 10 'solid "blue"))
+
+(test (overlay (rectangle 10 10 'solid "blue")
+               (rectangle 10 10 'solid "transparent"))
+      =>
+      (rectangle 10 10 'solid "blue"))
+
 ;; test zero sized image equalities
 
 (test (rectangle 0 100 'solid 'white)
@@ -796,7 +812,8 @@
       =>
       (make-translate 125 150 (make-ellipse 50 100 0 255 "blue")))
 
-(test (normalize-shape (make-translate 10 20 (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue)))))
+(test (normalize-shape 
+       (make-translate 10 20 (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue)))))
       =>
       (make-translate 135 170 (make-ellipse 50 100 0 255 "blue")))
 
@@ -2364,7 +2381,8 @@
     (lambda (p)
       (display (convert i 'png-bytes) p))
     #:exists 'truncate)
-  (define i2 (rotate 0 (read-bitmap tmpfile))) ;; add rotate to be sure we get an image so that equal? works properly
+  ;; add rotate to be sure we get an image so that equal? works properly
+  (define i2 (rotate 0 (read-bitmap tmpfile))) 
   (delete-file tmpfile)
   (test (image-width i2) => 30)
   (test (image-height i2) => 30)
@@ -2438,7 +2456,8 @@
     (let loop ([obj obj])
       (when (struct? obj)
         (let ([stuff (vector->list (struct->vector obj))])
-          (unless (member (car stuff) '(struct:flip struct:translate struct:scale)) ;; skip these because normalization eliminates them
+           ;; skip these because normalization eliminates them
+          (unless (member (car stuff) '(struct:flip struct:translate struct:scale))
             (hash-set! counts (car stuff) (+ 1 (hash-ref counts (car stuff) 0))))
           (for-each loop (cdr stuff)))))
     (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))
@@ -2552,6 +2571,7 @@ This was found by the first redex check above:
         (max 0 (min (image-height i) (+ (* 10 2) 12))) 
         (+ (* 10 1) 7) (+ (* 10 1) 2)
         i))
-raises an exception crop: expected <number that is between 0 than the width (-1)> as first argument, given: 0
+raises an exception crop: expected <number that is between 0 than the width (-1)> 
+as first argument, given: 0
 
 |#

pkgs/htdp/teachpack/2htdp/scribblings/image.scrbl

@@ -1435,8 +1435,9 @@ This section lists predicates for the basic structures provided by the image lib
   are also allowed, and are the same colors as in the previous sentence.
   If a string or symbol color name is not recognized, black is used in its place.
   
-  The complete list of colors is available in the documentation for
+  The complete list of colors is the same as the colors allowed in
-  @racket[color-database<%>].
+  @racket[color-database<%>], plus the color @racket["transparent"], a transparent
+  color.
 
 }