Added some illegal-argument tests to map-image.rkt.

Added test cases for these to map-image-bsl-tests.rkt.
Modified an error message from colorize, and its test cases.
Added map-image/extra and build-image/extra functions.

collects/picturing-programs/picturing-programs.scrbl

@@ -201,19 +201,46 @@ the bounds of the image, returns a transparent color.}
 
 Builds an image of the specified size and shape by calling the specified function
 on the coordinates of each pixel.  For example,
-@racketblock[
+@codeblock|{
-             (define (fuzz pic)
+; fuzz : image -> image
-               (local [(define (near-pixel x y)
+(define (fuzz pic)
-                         (get-pixel-color (+ x -3 (random 7))
+   (local [; near-pixel : num(x) num(y) -> color
-                                          (+ y -3 (random 7))
+           (define (near-pixel x y)
-                                          pic))]
+              (get-pixel-color (+ x -3 (random 7))
-                 (build-image (image-width pic)
+                               (+ y -3 (random 7))
-                              (image-height pic)
+                               pic))]
-                              near-pixel)))
+      (build-image (image-width pic)
-                                           ]
+                   (image-height pic)
+                   near-pixel)))
+}|
 produces a fuzzy version of the given picture by replacing each pixel with a
 randomly chosen pixel near it.}
 
+@defproc[(build-image/extra
+         [width natural-number/c]
+         [height natural-number/c]
+         [f (-> natural-number/c natural-number/c any/c color?)] [extra any/c]) image?]{
+Equivalent to @racketblock[(build-image width height (lambda (x y) (f x y extra)))]
+In other words, it passes the @racket[extra] argument in as a third argument in each call
+to @racket[f].  This allows students who haven't learned closures yet to do pixel-by-pixel image
+manipulations inside a function depending on a parameter of that function.
+
+For example, the above @racket[fuzz] example could also be written as
+@codeblock|{
+; near-pixel : number(x) number(y) image -> color
+(define (near-pixel x y pic)
+  (get-pixel-color (+ x -3 (random 7))
+                   (+ y -3 (random 7))
+                   pic))
+; fuzz : image -> image
+(define (fuzz pic)
+  (build-image/extra (image-width pic)
+                     (image-height pic)
+                     near-pixel
+                     pic))
+}|
+}
+
 @defproc[(build4-image [width natural-number/c] [height natural-number/c]
 		       [red-function (-> natural-number/c natural-number/c natural-number/c)]
 		       [green-function (-> natural-number/c natural-number/c natural-number/c)]
@@ -238,11 +265,12 @@ Just like @racket[build4-image], but without specifying the alpha component
 
 Applies the given function to each pixel in a given image, producing a new image the same
 size and shape.  For example,
-@racketblock[
+@codeblock|{
-             (define (lose-red x y old-color)
+; lose-red : num(x) num(y) color -> color
-               (make-color 0 (color-green old-color) (color-blue old-color)))
+(define (lose-red x y old-color)
+   (make-color 0 (color-green old-color) (color-blue old-color)))
              
-             (map-image lose-red my-picture)]
+(map-image lose-red my-picture)}|
 produces a copy of @racket[my-picture] with all the red leached out,
 leaving only the blue and green components.
 
@@ -255,17 +283,45 @@ that was in the original image.  To preserve this information, one could write
 old-color)))]
 
 Another example:
-@racketblock[
+@codeblock|{
-             (define (apply-gradient x y old-color)
+; apply-gradient : num(x) num(y) color -> color
-               (make-color (min (* 3 x) 255)
+(define (apply-gradient x y old-color)
-                           0 
+   (make-color (min (* 3 x) 255)
-                           (min (* 3 y) 255)))
+               0 
+               (min (* 3 y) 255)))
              
-             (map-image apply-gradient my-picture)]
+(map-image apply-gradient my-picture)}|
 produces a picture the size of @racket[my-picture]'s bounding rectangle,
 with a smooth color gradient with red increasing from left to
 right and blue increasing from top to bottom.}
 
+@defproc[(map-image/extra
+         [f (-> natural-number/c natural-number/c color? any/c color?)] [img image?] [extra any/c]) image?]{
+Equivalent to @racketblock[(map-image (lambda (x y c) (f x y c extra)) img)]
+In other words, it passes the @racket[extra] argument in as a fourth argument in each call
+to @racket[f].  This allows students who haven't learned closures yet to do pixel-by-pixel image
+manipulations inside a function depending on a parameter of that function.
+
+For example,
+@codeblock|{
+; new-pixel : number(x) number(y) color height -> color
+(check-expect (new-pixel 36 100 (make-color 30 60 90) 100)
+              (make-color 30 60 255))
+(check-expect (new-pixel 58 40 (make-color 30 60 90) 100)
+              (make-color 30 60 102))
+(define (new-pixel x y c h)
+  (make-color (color-red c)
+              (color-green c)
+              (real->int (* 255 (/ y h)))))
+
+; apply-blue-gradient : image -> image
+(define (apply-blue-gradient pic)
+  (map-image/extra new-pixel pic (image-height pic)))
+}|
+This @racket[apply-blue-gradient] function changes the blue component of an image to increase gradually
+from the top to the bottom of the image, (almost) reaching 255 at the bottom of the image.
+}
+
 @defproc[(map4-image 
 [red-func (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c)]
 [green-func (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c)]
@@ -284,20 +340,22 @@ The results of the four functions are used as the red, green, blue, and alpha
 components in the corresponding pixel of the resulting picture.
 
 For example,
-@racketblock[
+@codeblock{|
+; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num
 (define (zero x y r g b a) 0)
 (define (same-g x y r g b a) g)
 (define (same-b x y r g b a) b)
 (define (same-alpha x y r g b a) a)
-(map4-image zero same-g same-b same-alpha my-picture)]
+(map4-image zero same-g same-b same-alpha my-picture)}|
 produces a copy of @racket[my-picture] with all the red leached out,
 leaving only the blue, green, and alpha components.
 
-@racketblock[
+@codeblock|{
+; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num
 (define (3x x y r g b a) (min (* 3 x) 255))
 (define (3y x y r g b a) (min (* 3 y) 255))
 (define (return-255 x y r g b a) 255)
-(map4-image 3x zero 3y return-255 my-picture)]
+(map4-image 3x zero 3y return-255 my-picture)}|
 produces an opaque picture the size of @racket[my-picture]'s bounding rectangle,
 with a smooth color gradient with red increasing from left to
 right and blue increasing from top to bottom.
@@ -320,18 +378,20 @@ corresponding pixel of the resulting picture.
 
 The alpha component in the resulting picture is copied from the source
 picture.  For example,
-@racketblock[
+@codeblock|{
+; each function : num(x) num(y) num(r) num(g) num(b) -> num
 (define (zero x y r g b) 0)
 (define (same-g x y r g b) g)
 (define (same-b x y r g b) b)
-(map3-image zero same-g same-b my-picture)]
+(map3-image zero same-g same-b my-picture)}|
 produces a copy of @racket[my-picture] with all the red leached out; parts of
 the picture that were transparent are still transparent, and parts that were
 dithered are still dithered.
-@racketblock[
+@codeblock|{
+; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num
 (define (3x x y r g b a) (min (* 3 x) 255))
 (define (3y x y r g b a) (min (* 3 y) 255))
-(map3-image zero 3x 3y my-picture)]
+(map3-image zero 3x 3y my-picture)}|
 produces a @racket[my-picture]-shaped "window" on a color-gradient.
 }
 
@@ -339,14 +399,17 @@ produces a @racket[my-picture]-shaped "window" on a color-gradient.
          integer?]{
 Not specific to colors, but useful if you're building colors by arithmetic.
 For example,
-@racketblock[
+@codeblock|{
-             (define (bad-gradient x y)
+; bad-gradient : num(x) num(y) -> color
-               (make-color (* 2.5 x) (* 1.6 y) 0))
+(define (bad-gradient x y)
-             (build-image 50 30 bad-gradient)
+   (make-color (* 2.5 x) (* 1.6 y) 0))
-             (define (good-gradient x y)
+(build-image 50 30 bad-gradient)
-               (make-color (real->int (* 2.5 x)) (real->int (* 1.6 y)) 0))
+
-             (build-image 50 30 good-gradient)
+; good-gradient : num(x) num(y) -> color
-             ]
+(define (good-gradient x y)
+   (make-color (real->int (* 2.5 x)) (real->int (* 1.6 y)) 0))
+(build-image 50 30 good-gradient)
+}|
 The version using @racket[bad-gradient] crashes because color components must be exact integers.
 The version using @racket[good-gradient] works.}
 
@@ -396,16 +459,18 @@ Web page at the specified URL rather than from the keyboard.}
 Combines @racket[with-input-from-string] and @racket[with-output-to-string]:
 calls @tt{thunk} with its input coming from @tt{input} and accumulates
 its output into a string, which is returned.  Especially useful for testing:
-@racketblock[
+@codeblock|{
-             (define (ask question)
+; ask : string -> prints output, waits for text input, returns it
-               (begin (display question)
+(define (ask question)
-                      (read)))                  
+   (begin (display question)
-             (define (greet)
+          (read)))                  
-               (local [(define name (ask "What is your name?"))]
+; greet : nothing -> prints output, waits for text input, prints output
-                 (printf "Hello, ~a!" name)))
+(define (greet)
-             (check-expect
+   (local [(define name (ask "What is your name?"))]
-              (with-io-strings "Steve" greet)
+      (printf "Hello, ~a!" name)))
-              "What is your name?Hello, Steve!")]
+(check-expect
+   (with-io-strings "Steve" greet)
+   "What is your name?Hello, Steve!")}|
 }
 
 @; @include-section{worlds.scrbl}

collects/picturing-programs/private/map-image.rkt

@@ -9,6 +9,7 @@
 ; Dec. 26, 2010: API for bitmaps has changed for 5.1, so I need to rewrite to match it.
 ; Dec. 28, 2010: Robby added alphas into the "color" type, and provided an implementation
 ; of map-image.  He recommends using racket/draw bitmaps rather than 2htdp/image bitmaps.
+; May 10, 2011: added build-image/extra and map-image/extra.
 
 (require racket/draw
         racket/snip
@@ -41,6 +42,17 @@
 (provide-higher-order-primitive build3-image (_ _ rfunc gfunc bfunc))
 (provide-higher-order-primitive build4-image (_ _ rfunc gfunc bfunc afunc))
 ;(provide-higher-order-primitive build-masked-image (_ _ f))
+(provide-higher-order-primitive build-image/extra (_ _ f _))
+(provide-higher-order-primitive map-image/extra (f _ _))
+
+; check-procedure-arity : alleged-function nat-num symbol string
+; Note: if you invoke these things from a BSL or BSLL program, the syntax checker will
+; catch non-procedure arguments before the "(and (procedure? f) ..." test ever sees them,
+; but that's no longer true if you invoke them from an ISLL, ASL, or racket program,
+; so I'm keeping the test.
+(define (check-procedure-arity f n func-name msg)
+  (unless (and (procedure? f) (procedure-arity-includes? f n))
+    (error func-name msg)))
 
 (define transparent (make-color 0 0 0 0))
 
@@ -88,7 +100,7 @@
   (cond [(color? thing) thing]
         [(eqv? thing #f) transparent]
         [(image-color? thing) (name->color thing)]
-        [else (error 'colorize "Unrecognized type")]))
+        [else (error 'colorize (format "~v is not a color" thing))]))
 
 ; colorize-func : (... -> broad-color) -> (... -> color)
 (define (colorize-func f)
@@ -199,10 +211,21 @@
     (error 'build-image "Expected natural number as first argument"))
   (unless (natural? h)
     (error 'build-image "Expected natural number as second argument"))
-  (unless (procedure-arity-includes? f 2)
+  (check-procedure-arity f 2 'build-image "Expected function with contract num(x) num(y) -> color as third argument")
-    (error 'build-image "Expected function with contract num(x) num(y) -> color as third argument"))
   (build-image-internal w h (colorize-func f)))
 
+; build-image/extra : natural(width) natural(height) (nat nat any -> broad-color) any -> image
+; Like build-image, but passes a fixed extra argument to every call of the function.
+; For students who don't yet know function closures.
+(define (build-image/extra w h f extra)
+  (unless (natural? w)
+    (error 'build-image/extra "Expected natural number as first argument"))
+  (unless (natural? h)
+    (error 'build-image/extra "Expected natural number as second argument"))
+  (check-procedure-arity f 3 'build-image/extra "Expected function with contract num(x) num(y) any -> color as third argument")
+  (build-image-internal w h
+                        (colorize-func (lambda (x y) (f x y extra)))))
+
 ; build3-image : nat(width) nat(height) rfunc gfunc bfunc -> image
 ; where each of rfunc, gfunc, bfunc is (nat(x) nat(y) -> nat)
 (define (build3-image w h rfunc gfunc bfunc)
@@ -210,12 +233,9 @@
     (error 'build3-image "Expected natural number as first argument"))
   (unless (natural? h)
     (error 'build3-image "Expected natural number as second argument"))
-  (unless (procedure-arity-includes? rfunc 2)
+  (check-procedure-arity rfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as third argument")
-    (error 'build3-image "Expected function with contract num(x) num(y) -> color as third argument"))
+  (check-procedure-arity gfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as fourth argument")
-  (unless (procedure-arity-includes? gfunc 2)
+  (check-procedure-arity bfunc 2 'build3-image "Expected function with contract num(x) num(y) -> color as fifth argument")
-    (error 'build3-image "Expected function with contract num(x) num(y) -> color as fourth argument"))
-  (unless (procedure-arity-includes? bfunc 2)
-    (error 'build3-image "Expected function with contract num(x) num(y) -> color as fifth argument"))
   (build-image-internal w h
                         (lambda (x y)
                           (make-color (rfunc x y) (gfunc x y) (bfunc x y)))))
@@ -227,14 +247,10 @@
     (error 'build-image "Expected natural number as first argument"))
   (unless (natural? h)
     (error 'build-image "Expected natural number as second argument"))
-  (unless (procedure-arity-includes? rfunc 2)
+  (check-procedure-arity rfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as third argument")
-    (error 'build-image "Expected function with contract num(x) num(y) -> color as third argument"))
+  (check-procedure-arity gfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as fourth argument")
-  (unless (procedure-arity-includes? gfunc 2)
+  (check-procedure-arity bfunc 2 'build-image "Expected function with contract num(x) num(y) -> color as fifth argument")
-    (error 'build-image "Expected function with contract num(x) num(y) -> color as fourth argument"))
+  (check-procedure-arity afunc 2 'build-image "Expected function with contract num(x) num(y) -> color as sixth argument")
-  (unless (procedure-arity-includes? bfunc 2)
-    (error 'build-image "Expected function with contract num(x) num(y) -> color as fifth argument"))
-  (unless (procedure-arity-includes? afunc 2)
-    (error 'build-image "Expected function with contract num(x) num(y) -> color as sixth argument"))
   (build-image-internal w h
                         (lambda (x y)
                           (make-color (rfunc x y) (gfunc x y) (bfunc x y) (afunc x y)))))
@@ -259,12 +275,23 @@
 
 ; map-image : (int int color -> broad-color) image -> image
 (define (map-image f img)
-  (unless (procedure-arity-includes? f 3)
+  (check-procedure-arity f 3 'map-image "Expected function with contract num(x) num(y) color -> color as first argument")
-    (error 'map-image "Expected function with contract num(x) num(y) color -> color as first argument"))
   (unless (image? img)
     (error 'map-image "Expected image as second argument"))
   (map-image-internal (colorize-func f) img))
 
+; map-image/extra : (nat nat color X -> broad-color) image X -> image
+; Like map-image, but passes a fixed extra argument to every call of the function.
+; For students who don't yet know function closures.
+(define (map-image/extra f img extra)
+  (check-procedure-arity f 4 'map-image/extra "Expected function with contract num(x) num(y) color other -> color as first argument")
+  (unless (image? img)
+    (error 'map-image/extra "Expected image as second argument"))
+  (map-image-internal (colorize-func (lambda (x y c) (f x y c extra))) img))
+
+
+
+
 ; The version for use before students have seen structs:
 ; map3-image :
 ; (int(x) int(y) int(r) int(g) int(b) -> int(r))
@@ -273,12 +300,9 @@
 ; image -> image
 ; Note: by default, preserves alpha values from old image.
 (define (map3-image rfunc gfunc bfunc pic)
-  (unless (procedure-arity-includes? rfunc 5)
+  (check-procedure-arity rfunc 5 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
-    (error 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument"))
+  (check-procedure-arity gfunc 5 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument")
-  (unless (procedure-arity-includes? gfunc 5)
+  (check-procedure-arity bfunc 5 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
-    (error 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument"))
-  (unless (procedure-arity-includes? bfunc 5)
-    (error 'map3-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument"))
   (unless (image? pic)
     (error 'map3-image "Expected image as fourth argument"))
    (map-image-internal
@@ -296,14 +320,10 @@
 ;  (int(x) int(y) int(r) int(g) int(b) int(a) -> int(a))
 ;  image -> image
 (define (map4-image rfunc gfunc bfunc afunc pic)
-  (unless (procedure-arity-includes? rfunc 6)
+  (check-procedure-arity rfunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(r) as first argument")
-    (error 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(r) as first argument"))
+  (check-procedure-arity gfunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument")
-  (unless (procedure-arity-includes? gfunc 6)
+  (check-procedure-arity bfunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument")
-    (error 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument"))
+  (check-procedure-arity afunc 6 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument")
-  (unless (procedure-arity-includes? rfunc 6)
-    (error 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument"))
-  (unless (procedure-arity-includes? gfunc 6)
-    (error 'map4-image "Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument"))
   (unless (image? pic)
     (error 'map4-image "Expected image as fifth argument"))
    (map-image-internal

collects/picturing-programs/tests/map-image-bsl-tests.rkt

@@ -1,6 +1,6 @@
 ;; The first three lines of this file were inserted by DrRacket. They record metadata
 ;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-beginner-reader.ss" "lang")((modname map-image-bsl-tests) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
+#reader(lib "htdp-beginner-reader.ss" "lang")((modname new.map-image-bsl-tests) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
 (require picturing-programs)
 
 ; Test cases for primitives:
@@ -36,10 +36,25 @@
 (check-expect (color=? (make-color 5 10 15 255) (make-color 5 10 15)) true)
 (check-expect (color=? (make-color 5 10 15 0) false) true)
 (check-expect (color=? (make-color 5 10 15 20) false) false)
-(check-error (color=? "white" 3) "colorize: Unrecognized type")
+(check-error (color=? "white" 3) "colorize: 3 is not a color")
 (check-error (color=? "white" "plaid") "color=?: Expected two colors or color names as arguments")
 
 ; Test cases for map3-image:
+;(check-error (map3-image 5 + + pic:bloch)
+;             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
+; Actually, the above is caught by Check Syntax, before map3-image has a chance to check anything.
+(check-error (map3-image sqrt + + pic:bloch)
+             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
+;(check-error (map3-image + 5 + pic:bloch)
+;             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument")
+(check-error (map3-image + sqrt + pic:bloch)
+             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(g) as second argument")
+;(check-error (map3-image + + 5 pic:bloch)
+;             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
+(check-error (map3-image + + sqrt pic:bloch)
+             "map3-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(b) as third argument")
+(check-error (map3-image + + + 5)
+             "map3-image: Expected image as fourth argument")
 
 ; red-id : x y r g b -> num
 (define (red-id x y r g b) r)
@@ -81,6 +96,24 @@
 (map3-image blue-id red-id green-id bloch)
 
 "Test cases for map4-image:"
+;(check-error (map4-image 5 + + + pic:bloch)
+;             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) -> num(r) as first argument")
+(check-error (map4-image sqrt + + + pic:bloch)
+             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(r) as first argument")
+;(check-error (map4-image + 5 + + pic:bloch)
+;             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument")
+(check-error (map4-image + sqrt + + pic:bloch)
+             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(g) as second argument")
+;(check-error (map4-image + + 5 + pic:bloch)
+;             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument")
+(check-error (map4-image + + sqrt + pic:bloch)
+             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(b) as third argument")
+;(check-error (map4-image + + + 5 pic:bloch)
+;             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(a) as fourth argument")
+(check-error (map4-image + + + sqrt pic:bloch)
+             "map4-image: Expected function with contract num(x) num(y) num(r) num(g) num(b) num(alpha) -> num(alpha) as fourth argument")
+(check-error (map4-image + + + + 5)
+             "map4-image: Expected image as fifth argument")
 ; red-id6 : x y r g b a -> num
 (define (red-id6 x y r g b a) r)
 ; green-id6 : x y r g b a -> num
@@ -115,6 +148,13 @@
 (overlay (map4-image red-id6 green-id6 blue-id6 x-gradient-6 bloch) bluebox)
 
 ; Test cases for map-image:
+;(check-error (map-image 5 pic:bloch)
+;             "map-image: Expected function with contract num(x) num(y) color -> color as first argument")
+(check-error (map-image sqrt pic:bloch)
+             "map-image: Expected function with contract num(x) num(y) color -> color as first argument")
+(check-error (map-image + 5)
+             "map-image: Expected image as second argument")
+
 ; color-id : x y color -> color
 (define (color-id x y c)
   c)
@@ -146,7 +186,7 @@
 (define ex6 (map-image kill-red bloch)) ex6
 (define (return-5 x y c) 5)
 
-(check-error (map-image return-5 bloch) "colorize: Unrecognized type")
+(check-error (map-image return-5 bloch) "colorize: 5 is not a color")
 
 "Test cases for build3-image:"
 (define (x-gradient-2 x y) (min 255 (* 4 x)))
@@ -241,13 +281,6 @@ fuzzy-tri
    white-pixel->trans
    pic))
 
-(define (white-pixel->red x y old-color)
-  (if (color=? old-color 'white)
-      "red"
-      old-color))
-(define (white->red pic)
-  (map-image white-pixel->red pic))
-
 "(overlay (white->trans hieroglyphics) (rectangle 100 100 'solid 'blue)):"
 (define hier (white->trans hieroglyphics))
 (overlay hier (rectangle 100 100 "solid" "blue"))
@@ -275,4 +308,58 @@ fuzzy-tri
 "(overlay (color->gray hieroglyphics) bluebox):"
 (overlay (color->gray hieroglyphics) bluebox)
 "(overlay (color->gray (white->trans hieroglyphics)) bluebox):"
-(overlay (color->gray (white->trans hieroglyphics)) bluebox)
+(overlay (color->gray (white->trans hieroglyphics)) bluebox)
+
+; invert-pixel : x y color -> color
+(check-expect (invert-pixel 3 17 (make-color 0 0 0)) (make-color 255 255 255))
+(check-expect (invert-pixel 92 4 (make-color 50 100 150)) (make-color 205 155 105))
+(define (invert-pixel x y color)
+  (make-color (- 255 (color-red color))
+              (- 255 (color-green color))
+              (- 255 (color-blue color))))
+
+; invert-pic : image -> image
+(define (invert-pic pic)
+  (map-image invert-pixel pic))
+
+(check-expect (invert-pic (rectangle 30 20 "solid" "red"))
+              (rectangle 30 20 "solid" (make-color 0 255 255)))
+(invert-pic pic:bloch) "should be Dr. Bloch in photonegative"
+
+; Test cases for map-image/extra and build-image/extra:
+; Exercise 27.4.1:
+; new-pixel : number(x) number(y) color height -> color
+(check-expect (new-pixel 36 100 (make-color 30 60 90) 100)
+              (make-color 30 60 255))
+(check-expect (new-pixel 58 40 (make-color 30 60 90) 100)
+              (make-color 30 60 102))
+(define (new-pixel x y c h)
+  ; x         number
+  ; y         number
+  ; c         color
+  ; h         number
+  (make-color (color-red c)
+              (color-green c)
+              (real->int (* 255 (/ y h)))))
+
+; apply-blue-gradient : image -> image
+(define (apply-blue-gradient pic)
+  (map-image/extra new-pixel pic (image-height pic)))
+
+(apply-blue-gradient pic:bloch)
+"should be Dr. Bloch with an amount of blue increasing steadily from top to bottom"
+(apply-blue-gradient (rectangle 40 60 "solid" "red"))
+"should be a rectangle shading from red at the top to purple at the bottom"
+
+; flip-pixel : num(x) num(y) image -> color
+(define (flip-pixel x y pic)
+   (if (>= x y)
+       (get-pixel-color x y pic)
+       (get-pixel-color y x pic)))
+
+(define (diag-mirror pic)
+   (build-image/extra (image-width pic) (image-width pic) flip-pixel pic))
+
+(diag-mirror pic:bloch)
+"should be the upper-right corner of Dr. Bloch's head, mirrored to the lower-left"
+