10834 fixed

svn: r18668

collects/2htdp/image.ss

@@ -46,12 +46,14 @@ and they all have good sample contracts. (It is amazing what we can do with kids
 |#
 
 
-(require "../mrlib/image-core.ss"
+(require (except-in "../mrlib/image-core.ss" make-color make-pen)
          "private/image-more.ss"
          "private/img-err.ss"
+         (only-in lang/prim provide-primitive provide-primitives define-primitive)
          htdp/error)
 
-(provide overlay
+(provide-primitives
+         overlay
          overlay/align
          overlay/xy
          underlay
@@ -93,7 +95,6 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          scene+curve
          text
          text/font
-         bitmap
          
          x-place?
          y-place?
@@ -105,12 +106,23 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          pen-style? 
          pen-cap?
          pen-join?
-         (rename-out [build-color make-color])
          color-red color-blue color-green color? color
-         
-         (rename-out [build-pen make-pen])
          pen-color pen-width pen-style pen-cap pen-join pen
 
          image-width
          image-height
-         image-baseline)
+         image-baseline
+         
+         make-color
+         make-pen
+         )
+
+(provide bitmap)
+
+
+(define-primitive make-color build-color)
+(define-primitive make-pen build-pen)
+
+#;
+(provide (rename-out [build-color make-color])
+         (rename-out [build-pen make-pen]))

collects/2htdp/tests/bad-draw.ss

@@ -5,7 +5,7 @@
 (define s "")
 (define x 0)
 
-(with-handlers ((exn? void))
+(with-handlers ((exn? (lambda _ "success!")))
   (big-bang 0
             (on-tick (lambda (w) (begin (set! x (+ x 1)) w)))
             (on-draw (lambda (w) (set! s (number->string w))))))

collects/2htdp/tests/mp.ss

@@ -1,9 +1,8 @@
-;; The first three lines of this file were inserted by DrScheme. They record metadata
+#lang scheme (require test-engine/scheme-tests)
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-beginner-reader.ss" "lang")((modname mp) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
 (require 2htdp/universe)
 (require htdp/image)
 
+
 ;; WorldState = Image 
 
 ;; graphical constants
@@ -13,11 +12,11 @@
 ;; add a dot at (x,y) to ws 
 
 (check-expect 
- (clack mt 10 20 "something mousy")
+ (clack mt 10 20 "button-down")
  (place-image (circle 1 "solid" "red") 10 20 mt))
 
 (check-expect 
- (clack (place-image (circle 1 "solid" "red") 1 2 mt) 3 3 "")
+ (clack (place-image (circle 1 "solid" "red") 1 2 mt) 3 3 "button-down")
  (place-image (circle 1 "solid" "red") 3 3
               (place-image (circle 1 "solid" "red") 1 2 mt)))
 
@@ -34,8 +33,13 @@
 (define (show ws)
   ws)
 
+(test)
+
 ;; run program run 
-(big-bang (empty-scene 100 100)
+(define (main x)
-          (on-draw show)
+  (big-bang (empty-scene 100 100)
-          (record? true)
+            (on-draw show)
-          (on-mouse clack))
+            (record? x)
+            (on-mouse clack)))
+
+(main false)

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

@@ -38,7 +38,8 @@
          (only-in "../private/image-more.ss" 
                   bring-between
                   swizzle)
-         "../private/img-err.ss"
+         (only-in "../private/img-err.ss" image-snip->image)
+         ; "../private/img-err.ss"
          "../../mrlib/private/image-core-bitmap.ss"
          lang/posn
          scheme/math

collects/2htdp/universe.ss

@@ -11,10 +11,7 @@
    -- what if the initial world or universe state is omitted? the error message is bad then. 
 |#
 
-(require (for-syntax "private/syn-aux.ss"
+(require (for-syntax "private/syn-aux.ss" scheme/function)
-                     scheme/function
-                     #;
-                     (rename-in lang/prim (first-order->higher-order f2h)))
          "private/syn-aux-aux.ss" 
          "private/syn-aux.ss"
          "private/check-aux.ss"
@@ -26,8 +23,9 @@
          htdp/error
          (rename-in lang/prim (first-order->higher-order f2h)))
 
-(provide 
+(define-primitive stop-with make-stop-the-world)
- (rename-out (make-stop-the-world stop-with))) ;; World -> STOP
+
+(provide stop-with) ;; World -> STOP
 
 (provide
  launch-many-worlds
@@ -35,7 +33,7 @@
  ;; run expressions e1 through e2 in parallel, produce all values in same order
  )
 
-(provide
+(provide-primitive
  sexp?  ;; Any -> Boolean 
  )
 
@@ -71,6 +69,9 @@
 ;                                     
 
 (provide big-bang     ;; <syntax> : see below 
+         )
+
+(provide-primitives
          make-package ;; World Sexp -> Package
          package?     ;; Any -> Boolean 
          run-movie    ;; [Listof Image] -> true 
@@ -235,7 +236,7 @@
 ;                                                          
 ;                                                          
 
-(provide
+(provide-primitives
  ;; type World 
  iworld?    ;; Any -> Boolean 
  iworld=?   ;; World World -> Boolean