fixed pen and color so they signal errors properly

collects/2htdp/image.rkt

@@ -46,7 +46,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids
 |#
 
 
-(require (except-in "../mrlib/image-core.ss" make-color make-pen)
+(require (except-in "../mrlib/image-core.ss" make-color color make-pen pen)
          "private/image-more.ss"
          "private/img-err.ss"
          (only-in lang/prim provide-primitive provide-primitives define-primitive)
@@ -117,23 +117,24 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          pen-cap?
          pen-join?
          color-red color-blue color-green color? color
-         pen-color pen-width pen-style pen-cap pen-join pen
+         pen-color pen-width pen-style pen-cap pen-join 
 
          image-width
          image-height
          image-baseline
          
          make-color
-         make-pen
+         make-pen pen
          pen?
          step-count?
          save-image)
 
 (provide bitmap)
 
-
-(define-primitive make-color build-color)
-(define-primitive make-pen build-pen)
+(define-primitive make-color build-color/make-color)
+(define-primitive color build-color/color)
+(define-primitive make-pen build-pen/make-pen)
+(define-primitive pen build-pen/pen)
 
 #;
 (provide (rename-out [build-color make-color])

collects/2htdp/private/image-more.rkt

@@ -1165,18 +1165,30 @@
        #`(make-object image-snip% (make-object bitmap% #,path 'unknown/mask)))]))
 
 
-(define build-color
+(define build-color/make-color
   (let ([orig-make-color make-color])
     (define/chk (make-color int0-255-1 int0-255-2 int0-255-3) 
       (orig-make-color int0-255-1 int0-255-2 int0-255-3))
     make-color))
 
-(define build-pen
+(define build-color/color
+  (let ([orig-make-color make-color])
+    (define/chk (color int0-255-1 int0-255-2 int0-255-3) 
+      (orig-make-color int0-255-1 int0-255-2 int0-255-3))
+    color))
+
+(define build-pen/make-pen
   (let ([orig-make-pen make-pen])
     (define/chk (make-pen color real-0-255 pen-style pen-cap pen-join)
       (orig-make-pen color real-0-255 pen-style pen-cap pen-join))
     make-pen))
 
+(define build-pen/pen
+  (let ([orig-make-pen make-pen])
+    (define/chk (pen color real-0-255 pen-style pen-cap pen-join)
+      (orig-make-pen color real-0-255 pen-style pen-cap pen-join))
+    pen))
+
 (provide overlay
          overlay/align
          overlay/xy
@@ -1249,8 +1261,10 @@
          
          rotate-xy
          
-         build-color
-         build-pen)
+         build-color/make-color
+         build-color/color
+         build-pen/make-pen
+         build-pen/pen)
 
 (provide/contract
  [np-atomic-bb (-> np-atomic-shape? (values real? real? real? real?))]

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

@@ -644,8 +644,10 @@
 
 (test (empty-scene 185 100)
       =>
-      (overlay (rectangle 185 100 'outline 'black)
+      (overlay/align "left" "top"
+                     (rectangle 184 99 'outline 'solid)
                      (rectangle 185 100 'solid 'white)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  testing normalization
@@ -1604,6 +1606,21 @@
           =>
           #rx"^save-image:")
 
+(test/exn (pen 1 2 3 4 5)
+          =>
+          #rx"^pen:")
+
+(test/exn (make-pen 1 2 3 4 5)
+          =>
+          #rx"^make-pen:")
+
+(test/exn (make-color #f #f #f)
+          =>
+          #rx"^make-color:")
+(test/exn (color #f #f #f)
+          =>
+          #rx"^color:")
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  random testing of normalization