From e0d9d2565cacc3f8580f4be8986537e57a6d37bc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 30 Aug 2010 19:18:08 -0600 Subject: [PATCH] fix problem with rotation on images such as bitmaps and replace internal `bring-between' with an efficient version Closes PR 11124 --- collects/2htdp/private/image-more.rkt | 21 ++++++++------------- collects/2htdp/tests/test-image.rkt | 15 ++++++++++++++- 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index e7262f08c4..e775238d79 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -616,8 +616,8 @@ (make-bitmap (bitmap-raw-bitmap bitmap) (bitmap-raw-mask bitmap) (bring-between (if flipped? - (+ θ (bitmap-angle bitmap)) - (- (+ θ (bitmap-angle bitmap)))) + (- (bitmap-angle bitmap) θ) + (+ (bitmap-angle bitmap) θ)) 360) (bitmap-x-scale bitmap) (bitmap-y-scale bitmap) @@ -647,19 +647,14 @@ (make-point x y))) -;; bring-between : number number -> number -;; returns a number that is much like the modulo of 'x' and 'upper-bound' -;; but does this by repeated subtraction (or addition if it is negative), +;; bring-between : rational integer -> rational +;; returns a number that is much like the modulo of 'x' and 'upper-bound', ;; since modulo only works on integers (define (bring-between x upper-bound) - (let loop ([x x]) - (cond - [(< x 0) - (loop (+ x upper-bound))] - [(< x upper-bound) - x] - [else - (loop (- x upper-bound))]))) + (let* ([x-floor (floor x)] + [fraction (- x x-floor)]) + (+ (modulo x-floor upper-bound) + fraction))) (define/chk (flip-horizontal image) (rotate 90 (flip-vertical (rotate -90 image)))) diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 966c48d746..603346ce7c 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -1262,15 +1262,28 @@ => (image-snip->image (make-object image-snip% blue-20x10-bitmap))) -(test (rotate 90 (make-object image-snip% green-blue-20x10-bitmap)) +(test (rotate -90 (make-object image-snip% green-blue-20x10-bitmap)) => (image-snip->image (make-object image-snip% green-blue-10x20-bitmap))) +(test (rotate 90 (rotate 90 (make-object image-snip% green-blue-20x10-bitmap))) + => + (rotate 180 (make-object image-snip% green-blue-20x10-bitmap))) + +(test (rotate 90 (flip-vertical (rotate 90 (make-object image-snip% green-blue-20x10-bitmap)))) + => + (rotate 0 (make-object image-snip% green-blue-20x10-bitmap))) + ;; there was a bug in the bounding box computation for scaled bitmaps that this test exposes (test (image-width (frame (rotate 90 (scale 1/2 (bitmap icons/plt-logo-red-diffuse.png))))) => 128) +;; Rotation by 0 should produce an equivalent object +(test (rotate 0 (make-object image-snip% green-blue-20x10-bitmap)) + => + (to-img (make-object image-snip% green-blue-20x10-bitmap))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; cropping (and place-image)