diff --git a/collects/2htdp/picture.ss b/collects/2htdp/picture.ss
new file mode 100644
index 0000000000..07d61a828e
--- /dev/null
+++ b/collects/2htdp/picture.ss
@@ -0,0 +1,16 @@
+#lang scheme/base
+(require "private/picture.ss")
+(provide overlay
+         overlay/places
+         overlay/xy
+         
+         beside
+         beside/places
+         
+         rotate
+         rotate/places
+         
+         frame
+         
+         ellipse
+         rectangle)
\ No newline at end of file
diff --git a/collects/2htdp/private/picture.ss b/collects/2htdp/private/picture.ss
new file mode 100644
index 0000000000..8f75bfd853
--- /dev/null
+++ b/collects/2htdp/private/picture.ss
@@ -0,0 +1,692 @@
+#lang scheme/base
+(require scheme/class
+         scheme/gui/base
+         htdp/error
+         scheme/math
+         (for-syntax scheme/base))
+
+(provide overlay
+         overlay/places
+         overlay/xy
+         
+         beside
+         beside/places
+         
+         rotate
+         rotate/places
+         
+         frame
+         
+         ellipse
+         rectangle
+         
+         ;; internal stuff, for the test suite
+         
+         show-picture
+         
+         normalize-shape
+         
+         simple-bb
+         make-picture picture-shape
+         
+         make-bb
+         make-overlay
+         make-translate
+         make-rotate
+         make-ellipse
+         make-text
+         make-polygon)
+
+(define-struct posn (x y) #:transparent)
+
+;; when rendering these things in error messages,
+;; they should come out as #<picture: {THE ACTUAL PICTURE}>
+;; (automatically scale them down so they fit)
+
+;; redex randomized testing: see if normalization produces normalized shapes.
+;;        see if normalization always puts things in the right order
+
+;; need to change error messages to say "the width (second) argument"
+;; by passing "width (second)" to the check-arg function
+
+#|
+
+From Matthias: (to use to compare with this library)
+
+
+You asked about exercises and code snippets for HtDP/2e yesterday. I actually do have a bunch of stuff in
+
+ svn: 2HtDP/SampleCode/
+
+and they all have good sample contracts. (It is amazing what we can do with kids who have just a few weeks of cs down; I would have never dared to write an editor after six weeks in Algol.)
+
+
+|#
+
+
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;       ;;           ;;                  ;;           ;;;        
+;       ;;          ;;;                  ;;          ;;;         
+;    ;;;;;   ;;;;  ;;;;;  ;;;;        ;;;;;   ;;;;  ;;;;; ;; ;;; 
+;   ;;;;;;  ;;  ;;  ;;;; ;;  ;;      ;;;;;;  ;;  ;; ;;;;  ;;;;;; 
+;  ;;;  ;;    ;;;;  ;;;    ;;;;     ;;;  ;; ;;;;;;;; ;;   ;;  ;; 
+;  ;;;  ;;  ;;; ;;  ;;;  ;;; ;;     ;;;  ;; ;;;      ;;   ;;  ;; 
+;   ;;;;;; ;;;  ;;  ;;;;;;;  ;;      ;;;;;;  ;;; ;;  ;;   ;;  ;; 
+;    ;;;;;  ;;;;;;   ;;; ;;;;;;       ;;;;;   ;;;;   ;;   ;;  ;; 
+;                                                                
+;                                                                
+;                                                                
+;                                                         
+
+
+;; a picture is 
+;;  (make-picture shape bb boolean)
+;; NOTE: the shape field is mutated when normalized, as
+;;       is the normalized? field.
+(define-struct picture (shape bb normalized?)  #:mutable #:transparent)
+
+;; a bb is  (bounding box)
+;;  (make-bb number number number)
+(define-struct bb (right bottom baseline) #:transparent)
+
+;; a shape is either:
+;;
+;;  - (make-overlay shape shape)
+;;    the shapes are in the order passed to the overlay or beside,
+;;    which means the bottom one should be drawn first so as to appear
+;;    underneath the top one.
+(define-struct overlay (top bottom) #:transparent #:omit-define-syntaxes) 
+;;
+;;  - (make-translate dx dy shape)
+(define-struct translate (dx dy shape) #:transparent #:omit-define-syntaxes)
+;;
+;;  - (make-rotate angle shape)
+(define-struct rotate (angle shape) #:transparent #:omit-define-syntaxes)
+;;
+;;  - atomic-shape
+
+;; an atomic-shape is either:
+;;
+;;  - (make-ellipse width height pen brush)
+(define-struct ellipse (width height pen brush) #:transparent #:omit-define-syntaxes)
+;;
+;;  - (make-text string font)
+(define-struct text (string font) #:omit-define-syntaxes)
+;;
+;;  - (make-polygon (listof points) pen brush)
+(define-struct polygon (points pen brush))
+;;
+;;  - (is-a?/c bitmap%)
+
+
+;; a normalized-shape (subtype of shape) is either
+;;  - (make-overlay normalized-shape simple-shape)
+;;  - simple-shape
+
+;; a simple-shape (subtype of shape) is
+;;  - (make-translate dx dy (make-rotate angle atomic-shape))
+
+;; picture-normalized-shape : picture -> normalized-shape
+(define (picture-normalized-shape picture)
+  (unless (picture-normalized? picture)
+    (set-picture-shape! picture (normalize-shape (picture-shape picture) void))
+    (set-picture-normalized?! picture #t))
+  (picture-shape picture))
+
+;; normalize-shape : shape (atomic-shape -> void) -> normalized-shape
+;; normalizes 'shape', calling 'f' on each atomic shape in the normalized shape.
+(define (normalize-shape shape f)
+  (let loop ([shape shape]
+             [angle 0]
+             [translation (xy->c 0 0)]
+             [bottom #f])
+    (cond
+      [(translate? shape)
+       (loop (translate-shape shape)
+             angle
+             (+ translation 
+                (* (xy->c (translate-dx shape)
+                          (translate-dy shape))
+                   (make-polar 1 angle)))
+             bottom)]
+      [(rotate? shape)
+       (loop (rotate-shape shape)
+             (+ angle (rotate-angle shape))
+             translation
+             bottom)]
+      [(overlay? shape)
+       (loop (overlay-bottom shape)
+             angle translation
+             (loop (overlay-top shape)
+                   angle translation bottom))]
+      [(atomic-shape? shape)
+       (let-values ([(dx dy) (c->xy translation)])
+         (let ([this-one (make-translate dx dy (make-rotate angle shape))]) 
+           (f this-one)
+           (if bottom
+               (make-overlay bottom this-one)
+               this-one)))])))
+
+(define (atomic-shape? shape)
+  (or (ellipse? shape)
+      (text? shape)
+      (polygon? shape)
+      (and (object? shape)
+           (is-a?/c shape bitmap%))))
+
+;; simple-bb : simple-shape -> (values number number number number)
+;; returns the bounding box of 'shape' 
+;; (only called for rotated shapes, so bottom=baseline)
+(define (simple-bb shape)
+  (let ([dx (translate-dx shape)]
+        [dy (translate-dy shape)]
+        [θ (rotate-angle (translate-shape shape))]
+        [simple-shape (rotate-shape (translate-shape shape))])
+    (cond
+      [(polygon? simple-shape)
+       (let ([points (polygon-points simple-shape)])
+         (let-values ([(x y) (rotate-point (+ dx (posn-x (car points)))
+                                           (+ dy (posn-y (car points)))
+                                           θ)])
+           (let ([left x]
+                 [top y]
+                 [right x]
+                 [bottom y])
+             (for-each (λ (posn)
+                         (let-values ([(new-x new-y)
+                                       (rotate-point (+ dx (posn-x posn))
+                                                     (+ dy (posn-y posn))
+                                                     θ)])
+                           (set! left (min new-x left))
+                           (set! right (max new-x right))
+                           (set! top (min new-y top))
+                           (set! bottom (max new-y bottom))))
+                       (cdr points))
+             (values left top right bottom))))]
+      [else
+       (fprintf (current-error-port) "BAD\n")
+       (values 0 0 100 100)])))
+
+;; rotate-point : x,y theta -> x,y
+(define (rotate-point x y θ)
+  (c->xy (* (make-polar 1 θ) 
+            (xy->c x y))))
+
+(define (xy->c x y) (make-rectangular x (- y)))
+(define (c->xy c) 
+  (values (real-part c)
+          (- (imag-part c))))
+
+(define (picture-right picture) (bb-right (picture-bb picture)))
+(define (picture-bottom picture) (bb-bottom (picture-bb picture)))
+(define (picture-baseline picture) (bb-baseline (picture-bb picture)))
+
+
+;                                                                                                 
+;                                                                                                 
+;                                                                                                 
+;                                                                                                 
+;                                                                                                 
+;                                                                                                 
+;                                              ;;                      ;;      ;;                 
+;                                              ;;                      ;;      ;;                 
+;    ;;;;   ;;;;;;;;;  ;;;;   ;;;;      ;;;;   ;;;;;;   ;;;;    ;;;;   ;; ;;;  ;;  ;; ;;;  ;;;;;; 
+;   ;;  ;;  ;;;; ;;;; ;;;;;;  ;;;;     ;;;;;;  ;;;;;;  ;;  ;;  ;;;;;;  ;;;;;   ;;  ;;;;;;  ;;;;;; 
+;  ;;;;;;;; ;;   ;;  ;;;  ;;; ;;      ;;;      ;;  ;; ;;;;;;;;;;;      ;;;;;   ;;  ;;  ;; ;;;  ;; 
+;  ;;;      ;;   ;;  ;;;  ;;; ;;      ;;;      ;;  ;; ;;;     ;;;      ;;;;;   ;;  ;;  ;; ;;;  ;; 
+;   ;;; ;;  ;;   ;;   ;;;;;;  ;;       ;;;;;;  ;;  ;;  ;;; ;;  ;;;;;;  ;;  ;;  ;;  ;;  ;;  ;;;;;; 
+;    ;;;;   ;;   ;;    ;;;;   ;;        ;;;;   ;;  ;;   ;;;;    ;;;;   ;;  ;;; ;;  ;;  ;;   ;;;;; 
+;                                                                                          ;; ;;; 
+;                                                                                          ;;;;;  
+;                                                                                                 
+;
+
+
+(define-syntax define/chk
+  (λ (stx)
+    (syntax-case stx ()
+      [(define/chk (fn-name args ... . final-arg) body)
+       (identifier? #'final-arg)
+       (let ([len (length (syntax->list #'(args ...)))])
+         (with-syntax ([(i ...) (build-list len values)])
+           #`(define (fn-name args ... . final-arg)
+               (let ([args (check/normalize 'fn-name 'args args i)] ...
+                     [final-arg (map/i (λ (x j) (check/normalize 'fn-name 'final-arg x (+ #,len j)))
+                                       final-arg)])
+                 body))))]
+      [(define/chk (fn-name args ...) body)
+       (with-syntax ([(i ...) (build-list (length (syntax->list #'(args ...))) add1)])
+         #'(define (fn-name args ...)
+             (let ([args (check/normalize 'fn-name 'args args i)] ...)
+               body)))])))
+
+(define (map/i f l)
+  (let loop ([l l]
+             [i 0])
+    (cond
+      [(null? l) null]
+      [else (cons (f (car l) i)
+                  (loop (cdr l) (+ i 1)))])))
+
+;; check/normalize : symbol symbol any number -> any
+;; based on the name of the argument, checks to see if the input
+;; is valid and, if so, transforms it to a specific kind of value
+;;   width, height -> number
+;;   mode -> 'outline 'solid
+;;   color -> (is-a?/c color<%>)
+(define (check/normalize fn-name argname arg i)
+  (case argname
+    [(x-place)
+     (check-arg fn-name
+                (member arg '("left" left "right" right "middle" middle "center" center))
+                'x-place
+                i
+                arg)
+     (let ([sym (if (string? arg)
+                    (string->symbol arg)
+                    arg)])
+       (if (eq? sym 'center)
+           'middle
+           sym))]
+    [(y-place) 
+     (check-arg fn-name
+                (member arg '("top" top "bottom" bottom "middle" middle "center" center "baseline" baseline))
+                'y-place
+                i
+                arg)
+     (let ([sym (if (string? arg)
+                    (string->symbol arg)
+                    arg)])
+       (if (eq? sym 'center)
+           'middle
+           sym))]
+    [(picture picture1 picture2 picture3) 
+     (check-arg fn-name
+                (picture? arg)
+                'picture
+                i
+                arg)
+     arg]
+    [(mode)
+     (check-arg fn-name
+                (member arg '(solid outline "solid" "outline"))
+                'mode
+                i
+                arg)
+     (if (string? arg)
+         (string->symbol arg)
+         arg)]
+    [(width height)
+     (check-arg fn-name
+                (and (number? arg)
+                     (not (negative? arg)))
+                'non-negative-number
+                i arg)
+     arg]
+    [(dx dy angle)
+     (check-arg fn-name
+                (number? arg)
+                'number
+                i arg)
+     arg]
+    [(color)
+     (check-color fn-name i arg)
+     (cond
+       [(symbol? arg)
+        (send the-color-database find-color (symbol->string arg))]
+       [(string? arg)
+        (send the-color-database find-color arg)]
+       [else arg])]
+    [else
+     (error 'check "the function ~a has an argument with an unknown name: ~s"
+            fn-name
+            argname)]))
+
+
+
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;                                                                
+;                            ;;               ;;                 
+;                            ;;               ;;                 
+;   ;;;;  ;;;;   ;; ;;;   ;;;;;   ;;;;   ;;;;;;;  ;; ;;;  ;;;;;; 
+;   ;;;; ;;  ;;  ;;;;;;  ;;;;;;  ;;  ;;  ;;;; ;;  ;;;;;;  ;;;;;; 
+;   ;;  ;;;;;;;; ;;  ;; ;;;  ;; ;;;;;;;; ;;   ;;  ;;  ;; ;;;  ;; 
+;   ;;  ;;;      ;;  ;; ;;;  ;; ;;;      ;;   ;;  ;;  ;; ;;;  ;; 
+;   ;;   ;;; ;;  ;;  ;;  ;;;;;;  ;;; ;;  ;;   ;;  ;;  ;;  ;;;;;; 
+;   ;;    ;;;;   ;;  ;;   ;;;;;   ;;;;   ;;   ;;  ;;  ;;   ;;;;; 
+;                                                         ;; ;;; 
+;                                                         ;;;;;  
+;                                                                
+;                                                         
+
+(define (show-picture g [extra-space 0])
+  (letrec ([f (new frame% [label ""])]
+           [c (new canvas% 
+                   [parent f]
+                   [min-width (+ extra-space (inexact->exact (floor (picture-right g))))]
+                   [min-height (+ extra-space (inexact->exact (floor (picture-bottom g))))]
+                   [paint-callback
+                    (λ (c dc)
+                      (send dc set-smoothing 'aligned)
+                      (let-values ([(w h) (send c get-client-size)])
+                        (let ([scale (send sl get-value)])
+                          (send dc set-scale scale scale)
+                          (render-picture 
+                           g
+                           dc
+                           (inexact->exact (floor (- (/ w 2 scale) (/ (picture-right g) 2))))
+                           (inexact->exact (floor (- (/ h 2 scale) (/ (picture-bottom g) 2))))))))])]
+           [min-scale 1]
+           [max-scale 10]
+           [sl (new slider% 
+                    [label "Scale factor"] 
+                    [parent f] 
+                    [min-value min-scale]
+                    [max-value max-scale]
+                    [callback (λ ignore (send c refresh))])]
+           [bp (new horizontal-panel% [parent f] [alignment '(center center)] [stretchable-height #f])]
+           [scale-adjust
+            (λ (f)
+              (send sl set-value (max min-scale (min max-scale (f (send sl get-value)))))
+              (send c refresh))])
+    (new button% [label "√"] [callback (λ x (scale-adjust sub1))] [parent bp])
+    (new button% [label "²"] [callback (λ x (scale-adjust add1))] [parent bp])
+    (send f show #t)))
+
+;; render-picture : normalized-shape dc dx dy -> void
+(define (render-picture picture dc dx dy)
+  (let loop ([shape (picture-normalized-shape picture)])
+    (cond
+      [(overlay? shape)
+       (render-simple-shape (overlay-bottom shape) dc dx dy)
+       (loop (overlay-top shape))]
+      [else
+       (render-simple-shape shape dc dx dy)])))
+
+(define (render-simple-shape shape dc dx dy)
+  (let ([dx (+ dx (translate-dx shape))]
+        [dy (+ dy (translate-dy shape))]
+        [θ (rotate-angle (translate-shape shape))]
+        [atomic-shape (rotate-shape (translate-shape shape))])
+    (cond
+      [(ellipse? atomic-shape)
+       (let ([path (new dc-path%)])
+         (send path ellipse 0 0 (ellipse-width atomic-shape) (ellipse-height atomic-shape))
+         (send path rotate θ)
+         (send dc set-pen (ellipse-pen atomic-shape))
+         (send dc set-brush (ellipse-brush atomic-shape))
+         (send dc draw-path path dx dy))]
+      [(polygon? atomic-shape)
+       (let ([path (new dc-path%)]
+             [points (polygon-points atomic-shape)])
+         (send path move-to (posn-x (car points)) (posn-y (car points)))
+         (let loop ([points (cdr points)])
+           (unless (null? points)
+             (send path line-to (posn-x (car points)) (posn-y (car points)))
+             (loop (cdr points))))
+         (send path line-to (posn-x (car points)) (posn-y (car points)))
+         (send path rotate θ)
+         (send dc set-pen (polygon-pen atomic-shape))
+         (send dc set-brush (polygon-brush atomic-shape))
+         (send dc draw-path path dx dy))]
+      [(text? atomic-shape)
+       (send dc set-font (text-font atomic-shape))
+       (send dc draw-text (text-string atomic-shape) dx dy #f 0 angle)])))
+
+
+;                                                                                   
+;                                                                                   
+;                                                                                   
+;                                                                                   
+;                                                                                   
+;                               ;;      ;;                   ;;                     
+;                               ;;      ;;                  ;;;                     
+;    ;;;;    ;;;;   ;;;;;; ;;;  ;;;;;   ;;  ;; ;;;   ;;;;  ;;;;;  ;;;;   ;;;; ;;;;; 
+;   ;;;;;;  ;;;;;;  ;;;;;;;;;;  ;;;;;;  ;;  ;;;;;;  ;;  ;;  ;;;; ;;;;;;  ;;;; ;; ;; 
+;  ;;;     ;;;  ;;; ;;  ;;  ;;  ;;  ;;; ;;  ;;  ;;    ;;;;  ;;; ;;;  ;;; ;;   ;;;;; 
+;  ;;;     ;;;  ;;; ;;  ;;  ;;  ;;  ;;; ;;  ;;  ;;  ;;; ;;  ;;; ;;;  ;;; ;;     ;;;;
+;   ;;;;;;  ;;;;;;  ;;  ;;  ;;  ;;;;;;  ;;  ;;  ;; ;;;  ;;  ;;;; ;;;;;;  ;;   ;; ;;;
+;    ;;;;    ;;;;   ;;  ;;  ;;  ;; ;;   ;;  ;;  ;;  ;;;;;;   ;;;  ;;;;   ;;   ;;;;; 
+;                                                                                   
+;                                                                                   
+;                                                                                   
+;                                                                           ;  ;   ;
+
+;; bitmap : string -> picture
+;; gets one of the bitmaps that comes with drscheme, scales it down by 1/8 or something
+;; so that later scaling /translation/whatever will look reasonable.
+;; (the error message for a bad argument will list all of the currently installed example pictures;
+;; we may want to have some way teachers can stick new ones in there)
+
+;; overlay : picture picture picture ... -> picture
+;; places pictures on top of each other with their upper left corners aligned. last one goes on the bottom
+
+(define/chk (overlay picture picture2 . picture3)
+  (overlay/internal 'left 'top picture (cons picture2 picture3)))
+
+;; overlay/places : string string picture picture picture ... -> picture
+;; the first string has to be one of "center" "middle" "left" or "right" (or symbols)
+;; the second string has to be one of "center" "middle" "top" "bottom" or "baseline" (or symbols)
+;; behaves like overlay, but lines up the pictures in the various places.
+;; overlay without string arguments is the same as passing "left" and "top"
+;; for the two string arguments. Passing, eg, "center" "center" lines the
+;; pictures up at their centers.
+
+(define/chk (overlay/places x-place y-place picture picture2 . picture3)
+  (overlay/internal x-place y-place picture (cons picture2 picture3)))
+
+(define (overlay/internal x-place y-place fst rst)
+  (let loop ([fst fst]
+             [rst rst])
+    (cond
+      [(null? rst) fst]
+      [else 
+       (let* ([fst-x-spot (find-x-spot x-place fst)]
+              [fst-y-spot (find-y-spot y-place fst)]
+              [snd-x-spot (find-x-spot x-place (car rst))]
+              [snd-y-spot (find-y-spot y-place (car rst))]
+              [dx (- fst-x-spot snd-x-spot)]
+              [dy (- fst-y-spot snd-y-spot)])
+         (loop (overlay/δ fst
+                          (if (< dx 0) (- dx) 0) 
+                          (if (< dy 0) (- dy) 0)
+                          (car rst)
+                          (if (< dx 0) 0 dx)
+                          (if (< dy 0) 0 dy))
+               (cdr rst)))])))
+
+(define (find-x-spot x-place picture)
+  (case x-place
+    [(left) 0]
+    [(middle) (/ (picture-right picture) 2)]
+    [(right) (picture-right picture)]))
+
+(define (find-y-spot y-place picture)
+  (case y-place
+    [(top) 0]
+    [(middle) (/ (picture-bottom picture) 2)]
+    [(bottom) (picture-bottom picture)]
+    [(baseline) (picture-baseline picture)]))
+
+;; overlay/xy : picture number number picture -> picture
+;; places pictures on top of each other with their upper-left corners offset by the two numbers
+
+(define/chk (overlay/xy picture dx dy picture2) 
+  (overlay/δ picture
+             (if (< dx 0) (- dx) 0)
+             (if (< dy 0) (- dy) 0)
+             picture2
+             (if (< dx 0) 0 dx)
+             (if (< dy 0) 0 dy)))
+
+(define (overlay/δ picture1 dx1 dy1 picture2 dx2 dy2)
+  (make-picture (make-overlay (make-translate dx1 dy1 (picture-shape picture1))
+                              (make-translate dx2 dy2 (picture-shape picture2)))
+                (make-bb (max (+ (picture-right picture1) dx1)
+                              (+ (picture-right picture2) dx2))
+                         (max (+ (picture-bottom picture1) dy1)
+                              (+ (picture-bottom picture2) dy2))
+                         (max (+ (picture-baseline picture1) dy1)
+                              (+ (picture-baseline picture2) dy2)))
+                #f))
+
+
+;; beside : picture picture picture ... -> picture
+;; places pictures in a single horizontal row, top aligned
+(define/chk (beside picture1 picture2 . picture3)
+  (beside/internal 'top picture1 (cons picture2 picture3)))
+
+;; beside/places : string picture picture picture ... -> picture
+;; places pictures in a horizontal row where the vertical alignment is
+;; covered by the string argument
+(define/chk (beside/places y-place picture1 picture2 . picture3)
+  (beside/internal y-place picture1 (cons picture2 picture3)))
+
+(define (beside/internal y-place fst rst)
+  (let loop ([fst fst]
+             [rst rst])
+    (cond
+      [(null? rst) fst]
+      [else
+       (let* ([snd (car rst)]
+              [fst-y-spot (find-y-spot y-place fst)]
+              [snd-y-spot (find-y-spot y-place (car rst))]
+              [dy (- fst-y-spot snd-y-spot)])
+         (loop (overlay/δ fst
+                          0 
+                          (if (< dy 0) (- dy) 0)
+                          (car rst)
+                          (picture-right fst)
+                          (if (< dy 0) 0 dy))
+               (cdr rst)))])))
+
+;; above : picture picture picture ... -> picture
+;; above/places : string I I I ... -> I
+;; like beside, but vertically
+
+
+;; frame : picture -> picture
+;; draws a black frame around a picture where the bounding box is
+;; (useful for debugging pictures)
+
+(define/chk (frame picture)
+  (make-picture (make-overlay (picture-shape picture)
+                              (picture-shape 
+                               (rectangle (picture-right picture)
+                                          (picture-bottom picture)
+                                          'outline
+                                          'black)))
+                (make-bb (picture-right picture)
+                         (picture-bottom picture)
+                         (picture-baseline picture))
+                #f))
+
+;; scale : I number -> I
+;; scales the I by the given factor
+
+;; rotate : I number -> I
+;; rotates the I around the top-left corner by the given angle
+;; (in degrees)
+
+(define/chk (rotate angle picture)
+  (rotate/internal 'left 'top angle picture))
+
+;; rotate/places : string string I number -> I
+;; rotates the I around the given point inside the I, using
+;; the strings like overlay does.
+(define/chk (rotate/places x-place y-place angle picture)
+  (rotate/internal x-place y-place angle picture))
+
+;; LINEAR TIME OPERATION!!
+(define (rotate/internal x-place y-place angle picture)
+  (define left #f)
+  (define top #f)
+  (define right #f)
+  (define bottom #f)
+  (define (add-to-bounding-box simple-shape)
+    (let-values ([(this-left this-top this-right this-bottom) (simple-bb simple-shape)])
+      (set! left (if left (min this-left left) this-left))
+      (set! top (if top (min this-top top) this-top))
+      (set! right (if right (max this-right right) this-right))
+      (set! bottom (if bottom (max this-bottom bottom) this-bottom))))
+  (let ([rotated (normalize-shape (make-rotate angle (picture-shape picture)) add-to-bounding-box)])
+    (make-picture (make-translate (- left) (- top) rotated)
+                  (make-bb (- right left) (- bottom top) (- bottom top))
+                  #f)))
+
+;; stamp : I I -> I
+;; treats the first I as if it were a mask and uses that mask to
+;; mask out parts of the first I (the mask is solid; no alpha stuff
+;; here, even if dim were used).
+;; only accepts solid black Is
+
+;; see-thru : I number -> I
+;; applies an alpha value to the I, making it translucent
+
+
+;; -- as in the current I library, but they don't actually create
+;; bitmaps, but instead just records that are rendered right as they are
+;; about to be drawn
+
+;;       rectangle
+
+(define/chk (rectangle width height mode color)
+  (make-picture (make-polygon (list (make-posn 0 0)
+                                    (make-posn width 0)
+                                    (make-posn width height)
+                                    (make-posn 0 height))
+                              (mode-color->pen mode color)
+                              (mode-color->brush mode color))
+                (make-bb width
+                         height
+                         height)
+                #f))
+
+;;       circle
+;;       ellipse
+;;       triangle
+;;       line
+;;       star
+;;       text
+;;       regular-polygon
+
+(define/chk (ellipse width height mode color)
+  (make-picture (make-ellipse width height 
+                              (mode-color->pen mode color)
+                              (mode-color->brush mode color))
+                (make-bb width height height)
+                #f))
+
+(define (mode-color->pen mode color)
+  (send the-pen-list find-or-create-pen color 1 
+        (case mode
+          [(outline) 'solid]
+          [(solid) 'transparent])))
+
+(define (mode-color->brush mode color)
+  (send the-brush-list find-or-create-brush color 
+        (case mode
+          [(outline) 'transparent]
+          [(solid) 'solid])))
+
+;; add-line : I number number number number -> I
+;; add-line : string string I number number number number -> I
+;; like add-line, but adapted to use coordinates relative the top-left of the I,
+;; or to the user-specified spot
+
+;; add-curve : I posn number number posn number number -> I
+;; add-curve : string string I posn number number posn number number -> I
+;; the posns are the start and end points of the curve
+;; the pair of numbers following each posn are the angle and "pull" of the curve
+;; see pin-line in slideshow
+;; the initial strings in the second instance of add-curve are like the strings in add-line
+
diff --git a/collects/2htdp/private/test-picture.ss b/collects/2htdp/private/test-picture.ss
new file mode 100644
index 0000000000..4ba600748d
--- /dev/null
+++ b/collects/2htdp/private/test-picture.ss
@@ -0,0 +1,292 @@
+#lang scheme/base
+(require "picture.ss" 
+         scheme/math
+         tests/eli-tester)
+
+(let* ([first (rectangle 100 10 'solid 'red)]
+       [second 
+        (overlay/places 'center
+                        'center
+                        first
+                        (rotate/places 'center 'center 
+                                       (* pi 1/4)
+                                       first))]
+       [third 
+        (overlay/places 'center
+                        'center
+                        (frame second)
+                        (rotate/places 'center 'center 
+                                       (* pi 1/8)
+                                       (frame second)))])
+  (show-picture (frame third)))
+
+(define (round-numbers x)
+  (let loop ([x x])
+    (cond
+      [(number? x) (/ (round (* 100. x)) 100)]
+      [(pair? x) (cons (loop (car x)) (loop (cdr x)))]
+      [(let-values ([(a b) (struct-info x)]) a)
+       =>
+       (λ (struct-type)
+         (apply
+          (struct-type-make-constructor
+           struct-type)
+          (map loop (cdr (vector->list (struct->vector x))))))])))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  testing overlays
+;;
+
+(test (overlay (ellipse 100 100 'solid 'blue)
+               (ellipse 120 120 'solid 'red))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 100 100 'solid 'blue)))
+        (make-translate 0 0 (picture-shape (ellipse 120 120 'solid 'red))))
+       (make-bb 120
+                120
+                120)
+       #f))
+
+(test (overlay/xy (ellipse 100 100 'solid 'blue)
+                  0 0
+                  (ellipse 120 120 'solid 'red))
+      =>
+      (overlay (ellipse 100 100 'solid 'blue)
+               (ellipse 120 120 'solid 'red)))
+
+
+(test (overlay/xy (ellipse 50 100 'solid 'red)
+                  -25 25
+                  (ellipse 100 50 'solid 'green))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate
+         25 0
+         (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate
+         0 25
+         (picture-shape (ellipse 100 50 'solid 'green))))
+       (make-bb 100
+                100
+                100)
+       #f))
+
+(test (overlay/xy (ellipse 100 50 'solid 'green)
+                  10 10
+                  (ellipse 50 100 'solid 'red))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 100 50 'solid 'green)))
+        (make-translate 10 10 (picture-shape (ellipse 50 100 'solid 'red))))
+       (make-bb 100
+                110
+                110)
+       #f))
+
+(test (overlay (ellipse 100 50 'solid 'green)
+               (ellipse 50 100 'solid 'red))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 100 50 'solid 'green)))
+        (make-translate 0 0 (picture-shape (ellipse 50 100 'solid 'red))))
+       (make-bb 100
+                100
+                100)
+       #f))
+
+(test (overlay (ellipse 100 100 'solid 'blue)
+               (ellipse 120 120 'solid 'red)
+               (ellipse 140 140 'solid 'green))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 
+         0 0
+         (make-overlay
+          (make-translate 0 0 (picture-shape (ellipse 100 100 'solid 'blue)))
+          (make-translate 0 0 (picture-shape (ellipse 120 120 'solid 'red)))))
+        (make-translate 0 0 (picture-shape (ellipse 140 140 'solid 'green))))
+       (make-bb 140 140 140)
+       #f))
+
+(test (overlay/places 'middle
+                      'middle
+                      (ellipse 100 50 'solid 'green)
+                      (ellipse 50 100 'solid 'red))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 25 (picture-shape (ellipse 100 50 'solid 'green)))
+        (make-translate 25 0 (picture-shape (ellipse 50 100 'solid 'red))))
+       (make-bb 100 100 100)
+       #f))
+
+(test (overlay/places 'middle
+                      'middle
+                      (ellipse 50 100 'solid 'red)
+                      (ellipse 100 50 'solid 'green))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 25 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 0 25 (picture-shape (ellipse 100 50 'solid 'green))))
+       (make-bb 100 100 100)
+       #f))
+
+
+(test (overlay/places 'right
+                      'bottom
+                      (ellipse 50 100 'solid 'red)
+                      (ellipse 100 50 'solid 'green))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 50 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 0 50 (picture-shape (ellipse 100 50 'solid 'green))))
+       (make-bb 100 100 100)
+       #f))
+
+(test (overlay/places 'right
+                      'baseline
+                      (ellipse 50 100 'solid 'red)
+                      (ellipse 100 50 'solid 'green))
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 50 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 0 50 (picture-shape (ellipse 100 50 'solid 'green))))
+       (make-bb 100 100 100)
+       #f))
+
+(test (beside/places 'top
+                     (ellipse 50 100 'solid 'red)
+                     (ellipse 100 50 'solid 'blue))
+      
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 50 0 (picture-shape (ellipse 100 50 'solid 'blue))))
+       (make-bb 150 100 100)
+       #f))
+
+(test (beside/places 'center
+                     (ellipse 50 100 'solid 'red)
+                     (ellipse 100 50 'solid 'blue))
+      
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 50 25 (picture-shape (ellipse 100 50 'solid 'blue))))
+       (make-bb 150 100 100)
+       #f))
+
+(test (beside/places 'baseline
+                     (ellipse 50 100 'solid 'red)
+                     (ellipse 100 50 'solid 'blue))
+      
+      =>
+      (make-picture
+       (make-overlay
+        (make-translate 0 0 (picture-shape (ellipse 50 100 'solid 'red)))
+        (make-translate 50 50 (picture-shape (ellipse 100 50 'solid 'blue))))
+       (make-bb 150 100 100)
+       #f))
+
+(test (beside (ellipse 50 100 'solid 'red)
+              (ellipse 100 50 'solid 'blue))
+      =>
+      (beside/places 'top
+                     (ellipse 50 100 'solid 'red)
+                     (ellipse 100 50 'solid 'blue)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  testing rotation bounding boxes.
+;;
+
+(test (simple-bb (make-translate 0 0 (make-rotate (* pi 1/4) (picture-shape (rectangle 100 50 'solid 'red)))))
+      =>
+      (values 0.0
+              (- (imag-part (* (make-rectangular 100 0) (make-polar 1 (* pi 1/4)))))
+              (real-part (* (make-rectangular 100 -50) (make-polar 1 (* pi 1/4)))) 
+              (- (imag-part (* (make-rectangular 0 -50) (make-polar 1 (* pi 1/4)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  testing normalization
+;;
+
+(test (normalize-shape (picture-shape (ellipse 50 100 'solid 'red))
+                       void)
+      =>
+      (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'red)))))
+
+(test (normalize-shape (make-overlay (picture-shape (ellipse 50 100 'solid 'red))
+                                     (picture-shape (ellipse 50 100 'solid 'blue)))
+                       void)
+      =>
+      (make-overlay (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'red))))
+                    (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'blue))))))
+
+(test (normalize-shape (make-overlay
+                        (make-overlay (picture-shape (ellipse 50 100 'solid 'red))
+                                      (picture-shape (ellipse 50 100 'solid 'blue)))
+                        (picture-shape (ellipse 50 100 'solid 'green)))
+                       void)
+      =>
+      (make-overlay 
+       (make-overlay (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'red))))
+                     (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'blue)))))
+       (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'green))))))
+
+(test (normalize-shape (make-overlay
+                        (picture-shape (ellipse 50 100 'solid 'green))
+                        (make-overlay (picture-shape (ellipse 50 100 'solid 'red))
+                                      (picture-shape (ellipse 50 100 'solid 'blue))))
+                       void)
+      =>
+      (make-overlay 
+       (make-overlay (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'green))))
+                     (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'red)))))
+       (make-translate 0 0 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'blue))))))
+
+(test (normalize-shape (make-translate 100 100 (picture-shape (ellipse 50 100 'solid 'blue)))
+                       void)
+      =>
+      (make-translate 100 100 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'blue)))))
+
+(test (normalize-shape (make-translate 10 20 (make-translate 100 100 (picture-shape (ellipse 50 100 'solid 'blue))))
+                       void)
+      =>
+      (make-translate 110 120 (make-rotate 0 (picture-shape (ellipse 50 100 'solid 'blue)))))
+
+(test (normalize-shape (make-rotate pi (picture-shape (ellipse 50 100 'solid 'blue)))
+                       void)
+      =>
+      (make-translate 0 0 (make-rotate pi (picture-shape (ellipse 50 100 'solid 'blue)))))
+
+(test (normalize-shape (make-rotate (* pi 1/2) (make-rotate (* pi 1/2) (picture-shape (ellipse 50 100 'solid 'blue))))
+                       void)
+      =>
+      (make-translate 0 0 (make-rotate pi (picture-shape (ellipse 50 100 'solid 'blue)))))
+
+(test (round-numbers
+       (normalize-shape (make-rotate pi (make-translate 100 100 (picture-shape (rectangle 50 100 'solid 'blue))))
+                        void))
+      =>
+      (round-numbers (make-translate -100 -100 (make-rotate pi (picture-shape (rectangle 50 100 'solid 'blue))))))
+
+
+(test (round-numbers
+       (normalize-shape (make-rotate (* pi 1/2) (make-translate 100 50 (picture-shape (rectangle 50 100 'solid 'blue))))
+                        void))
+      =>
+      (round-numbers (make-translate 50 -100 (make-rotate (* pi 1/2) (picture-shape (rectangle 50 100 'solid 'blue))))))