added freeze to 2htdp/image

collects/2htdp/image.rkt

@@ -125,7 +125,9 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          make-pen pen
          pen?
          step-count?
-         save-image)
+         save-image
+         
+         freeze)
 
 (provide bitmap
          empty-image)

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

@@ -1335,6 +1335,19 @@
       (orig-make-pen color real-0-255 pen-style pen-cap pen-join))
     pen))
 
+(define/chk freeze
+  (case-lambda 
+    [(image) (freeze/internal 0 0 (image-width image) (image-height image) image)]
+    [(width height image) (freeze/internal 0 0 width height image)]
+    [(x y width height image) (freeze/internal x y width height image)]))
+
+(define (freeze/internal x y w h image)
+  (define bm (make-bitmap w h))
+  (define bdc (make-object bitmap-dc% bm))
+  (render-image image bdc (- x) (- y))
+  (send bdc set-bitmap #f)
+  (to-img bm))
+
 (provide overlay
          overlay/align
          overlay/xy
@@ -1422,6 +1435,8 @@
          build-pen/make-pen
          build-pen/pen
          
+         freeze
+         
          render-image)
 
 (provide/contract

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

@@ -1618,6 +1618,38 @@
         =>
         #t))
 
+
+(let ([i 
+       (overlay (circle 20 'solid 'red)
+                (rectangle 10 60 'solid 'blue))])
+  (test (freeze i)
+        => 
+        i))
+
+(test (freeze 10 10 (rectangle 20 20 'solid 'blue))
+      =>
+      (rectangle 10 10 'solid 'blue))
+
+(test (freeze 5 5 10 10 (rectangle 20 20 'solid 'blue))
+      =>
+      (rectangle 10 10 'solid 'blue))
+
+(test (freeze 5 7 12 10 (rectangle 20 20 'solid 'blue))
+      =>
+      (rectangle 12 10 'solid 'blue))
+
+(let ()
+  (define bkg (rectangle 12 12 'solid 'white))
+  (define i1 (overlay/xy 
+              (freeze 0 0 11 11 (rectangle 10 10 'outline 'orange))
+              0 0
+              bkg))
+  (define i2 (overlay/xy
+              (rectangle 10 10 'outline 'orange)
+              0 0
+              bkg))
+  (test i1 => i2))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  test pinholes.

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

@@ -1108,7 +1108,29 @@ more expensive than with the other shapes.
                     3 1))]
   
   }
-                             
+                
+
+@deftogether[(@defproc[(freeze [image image?]) image?]{}
+              @defproc[(freeze [width (and/c real? (not/c negative?))]
+                               [width (and/c real? (not/c negative?))]
+                               [image image?]) image?]{}
+              @defproc[(freeze [x real?]
+                               [y real?]
+                               [width (and/c real? (not/c negative?))]
+                               [width (and/c real? (not/c negative?))]
+                               [image image?]) image?]{})]{
+  Freezing an image internally builds a bitmap, crops the image, draws the cropped image
+  into the bitmap and then
+  uses the bitmap to draw that image afterwards. Typically this is used as a performance
+  hint. When an image both contains many sub-images and is going to be drawn many times
+  (but not scaled or rotated),
+  using freeze on the image can substantially improve performance without changing how
+  the image draws.
+  
+  If @racket[freeze] is passed only the image argument, then it crops the image to its bounding
+  box. If it is given three arguments, the two numbers are used as the width and height and
+  the five argument version fully specifies where to crop the image.
+}
 
 @section{Image Properties}