From e3b51e8cf4da6fb1308d967129421386efeab4bc Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 6 Sep 2010 06:24:44 -0500
Subject: [PATCH] made scaling work with pinholes

---
 collects/2htdp/private/image-more.rkt | 14 +++++++++-----
 collects/2htdp/tests/test-image.rkt   |  7 +++++++
 collects/mrlib/image-core.rkt         |  5 -----
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt
index 03942aac0e..dcdaff36ba 100644
--- a/collects/2htdp/private/image-more.rkt
+++ b/collects/2htdp/private/image-more.rkt
@@ -104,11 +104,15 @@
   (scale-internal x-factor y-factor image))
 
 (define (scale-internal x-factor y-factor image)
-  (make-image (make-scale x-factor y-factor (image-shape image))
-              (make-bb (* x-factor (get-right image))
-                       (* y-factor (get-bottom image))
-                       (* y-factor (get-baseline image)))
-              #f))
+  (let ([ph (send image get-pinhole)])
+    (make-image (make-scale x-factor y-factor (image-shape image))
+                (make-bb (* x-factor (get-right image))
+                         (* y-factor (get-bottom image))
+                         (* y-factor (get-baseline image)))
+                #f
+                (and ph 
+                     (make-point (* x-factor (point-x ph))
+                                 (* y-factor (point-y ph)))))))
 
 ;; overlay : image image image ... -> image
 ;; places images on top of each other with their upper left corners aligned. 
diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt
index 8709045b85..07f565a3df 100644
--- a/collects/2htdp/tests/test-image.rkt
+++ b/collects/2htdp/tests/test-image.rkt
@@ -1594,6 +1594,13 @@
 (test (pinhole-x (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)
 (test (pinhole-y (clear-pinhole (rectangle 10 24 'solid 'blue))) => #f)
 
+(test (pinhole-x (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
+      =>
+      55)
+(test (pinhole-y (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
+      =>
+      132)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  test errors.
diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt
index d1a6fac8bd..9bcf1ba783 100644
--- a/collects/mrlib/image-core.rkt
+++ b/collects/mrlib/image-core.rkt
@@ -1,10 +1,5 @@
 #lang racket/base
 
-;; changed:
-;; - simple-shape
-;; - np-atomic-shape
-;; - atomic-shape
-
 #|
 
 This library is the part of the 2htdp/image