From 157e9c2512807d9f26812661f8e65fdade93dee4 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 6 Sep 2010 07:04:42 -0500 Subject: [PATCH] made rotation work with pinholes --- collects/2htdp/private/image-more.rkt | 15 ++++++++++----- collects/2htdp/tests/test-image.rkt | 6 ++++++ .../teachpack/2htdp/scribblings/image-toc.rkt | 4 ++++ collects/teachpack/2htdp/scribblings/image.scrbl | 3 ++- .../2htdp/scribblings/img/f89620acd3.png | Bin 0 -> 812 bytes 5 files changed, 22 insertions(+), 6 deletions(-) create mode 100644 collects/teachpack/2htdp/scribblings/img/f89620acd3.png diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index dcdaff36ba..cf7ec3a6f5 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/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)] diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 07f565a3df..2302ab202e 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/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) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/teachpack/2htdp/scribblings/image-toc.rkt b/collects/teachpack/2htdp/scribblings/image-toc.rkt index d8f4fb2da5..41c89781e4 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.rkt +++ b/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 diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index f723e89dcb..b918444224 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/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]). diff --git a/collects/teachpack/2htdp/scribblings/img/f89620acd3.png b/collects/teachpack/2htdp/scribblings/img/f89620acd3.png new file mode 100644 index 0000000000000000000000000000000000000000..7b132ec4d63cd7ebf5f69db6bd296bc5ed519f9c GIT binary patch literal 812 zcmV+{1JnG8P)NklF>trbtlbLBkNV!lE9hp#s2SH&<=fG2)gcJk`yoh)ZFG2{S9;9n}=%}d> zB;=uk33HguX5z#@B(tfTo6G6jp+BN-zrF9?cl9~`e$Vsp+4%0^Hxzx0kB@u3-ULN^ zpOkkFWphGYWkMeZ2M0$-M{%zsK3v_bjG#mbekH#S*&MG{)~ON~C5mU5iBdenC{cib z2Y0`qBQ+}9(@a(}*Gj~9?tHPA(B{8V*Su@cl2B=L@3O+p`2X4(EAHwZvpoV())|C5a4&RGJ@^dg<~Dx%CA@~^%4H2 zx!2W2WY-84m9Y>_*u~YQPv!EqNSc)q{LW-m;%$rMP)?X{14W~Xcv~dR&Ma$Vs#WyI zLX5M6XfTnAfw2$}+GMd;sA6m^#JKwjcw(ufC>8=vBh0r0rq$Kea5xNbyvOn&>#t*O z<#=p-=juk__{t9slU2#Ooo|0)1(VzDJ`4u%ePDZ+W`Kl>Scp|1$4+sxE(z7KNTdQ(^kB9o>7gYSDpbr?Dta`}$hgk^mzrXs zLIo&pCdaO}+nmd-r<6SBngNl&q#~tJH2_kAzQ3`^uQ%#1W~?cBH54_8nsmoPwF+SG z!(@qZu6>@+yz|^ivfDzp3Q*EcmJRf73-!bwEt{$8XL&H@+v2QBmL(}s#?>Jy qijuf0K7PO7VzH#Br~iKy1NjL%N1jW;H}VMp0000