made rotation work with pinholes

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

@@ -375,12 +375,17 @@
   (let* ([rotated-shape (rotate-normalized-shape 
                          angle
                          (send image get-normalized-shape))]
-        [ltrb (normalized-shape-bb rotated-shape)])
+         [ltrb (normalized-shape-bb rotated-shape)]
+         [ph (send image get-pinhole)])
     (make-image (make-translate (- (ltrb-left ltrb)) (- (ltrb-top ltrb)) rotated-shape)
                 (make-bb (- (ltrb-right ltrb) (ltrb-left ltrb))
                          (- (ltrb-bottom ltrb) (ltrb-top ltrb))
                          (- (ltrb-bottom ltrb) (ltrb-top ltrb)))
-                #f)))
+                #f
+                (and ph
+                     (let ([rp (rotate-point ph angle)])
+                       (make-point (- (point-x rp) (ltrb-left ltrb))
+                                   (- (point-y rp) (ltrb-top ltrb))))))))
 
 (define/contract (rotate-normalized-shape angle shape)
   (-> number? normalized-shape? normalized-shape?)
@@ -396,7 +401,7 @@
   (-> number? cn-or-simple-shape? cn-or-simple-shape?)
   (cond
     [(crop? shape)
-     (make-crop (rotate-points angle (crop-points shape))
+     (make-crop (rotate-points (crop-points shape) angle)
                 (rotate-normalized-shape angle (crop-shape shape)))]
     [else
      (rotate-simple angle shape)]))
@@ -422,7 +427,7 @@
                          (curve-segment-e-pull simple-shape)
                          (curve-segment-color simple-shape))]
     [(polygon? simple-shape)
-     (make-polygon (rotate-points θ (polygon-points simple-shape))
+     (make-polygon (rotate-points (polygon-points simple-shape) θ)
                    (polygon-mode simple-shape)
                    (polygon-color simple-shape))]
     [else
@@ -547,7 +552,7 @@
             (max ax bx cx dx)
             (max ay by cy dy))))
 
-(define (rotate-points θ in-points)
+(define (rotate-points in-points θ)
   (let* ([cs (map point->c in-points)]
          [vectors (points->vectors cs)]
          [rotated-vectors (map (λ (c) (rotate-c c θ)) vectors)]

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

@@ -1600,6 +1600,12 @@
 (test (pinhole-y (scale 11 (center-pinhole (rectangle 10 24 'solid 'blue))))
       =>
       132)
+(test (round-numbers (pinhole-x (rotate 90 (center-pinhole (rectangle 40 20 'solid 'red)))))
+      =>
+      10.0)
+(test (round-numbers (pinhole-y (rotate 90 (center-pinhole (rectangle 40 20 'solid 'red)))))
+      =>
+      20.0)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;

collects/teachpack/2htdp/scribblings/image-toc.rkt

@@ -42,6 +42,10 @@
     '(put-pinhole 2 18 (rectangle 40 20 "solid" "forestgreen"))
     'image
     "14fa9751041.png")
+   (list
+    '(rotate 30 (center-pinhole (rectangle 40 20 "solid" "orange")))
+    'image
+    "f89620acd3.png")
    (list
     '(center-pinhole (rectangle 40 20 "solid" "red"))
     'image

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

@@ -1291,7 +1291,8 @@ See @secref["nitty-gritty"] for more details about pixels.
 
 @defproc[(center-pinhole [image image?]) image?]{
   Creates a pinhole in @racket[image] at its center.
-  @image-examples[(center-pinhole (rectangle 40 20 "solid" "red"))]
+  @image-examples[(center-pinhole (rectangle 40 20 "solid" "red"))
+                  (rotate 30 (center-pinhole (rectangle 40 20 "solid" "orange")))]
 }
 @defproc[(put-pinhole [x integer?] [y integer?] [image image?]) image?]{
   Creates a pinhole in @racket[image] at the point (@racket[x],@racket[y]).