fix problem with rotation on images such as bitmaps
and replace internal `bring-between' with an efficient version Closes PR 11124
This commit is contained in:
parent
7e1a6ec908
commit
e0d9d2565c
|
@ -616,8 +616,8 @@
|
||||||
(make-bitmap (bitmap-raw-bitmap bitmap)
|
(make-bitmap (bitmap-raw-bitmap bitmap)
|
||||||
(bitmap-raw-mask bitmap)
|
(bitmap-raw-mask bitmap)
|
||||||
(bring-between (if flipped?
|
(bring-between (if flipped?
|
||||||
(+ θ (bitmap-angle bitmap))
|
(- (bitmap-angle bitmap) θ)
|
||||||
(- (+ θ (bitmap-angle bitmap))))
|
(+ (bitmap-angle bitmap) θ))
|
||||||
360)
|
360)
|
||||||
(bitmap-x-scale bitmap)
|
(bitmap-x-scale bitmap)
|
||||||
(bitmap-y-scale bitmap)
|
(bitmap-y-scale bitmap)
|
||||||
|
@ -647,19 +647,14 @@
|
||||||
(make-point x y)))
|
(make-point x y)))
|
||||||
|
|
||||||
|
|
||||||
;; bring-between : number number -> number
|
;; bring-between : rational integer -> rational
|
||||||
;; returns a number that is much like the modulo of 'x' and 'upper-bound'
|
;; 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),
|
|
||||||
;; since modulo only works on integers
|
;; since modulo only works on integers
|
||||||
(define (bring-between x upper-bound)
|
(define (bring-between x upper-bound)
|
||||||
(let loop ([x x])
|
(let* ([x-floor (floor x)]
|
||||||
(cond
|
[fraction (- x x-floor)])
|
||||||
[(< x 0)
|
(+ (modulo x-floor upper-bound)
|
||||||
(loop (+ x upper-bound))]
|
fraction)))
|
||||||
[(< x upper-bound)
|
|
||||||
x]
|
|
||||||
[else
|
|
||||||
(loop (- x upper-bound))])))
|
|
||||||
|
|
||||||
(define/chk (flip-horizontal image)
|
(define/chk (flip-horizontal image)
|
||||||
(rotate 90 (flip-vertical (rotate -90 image))))
|
(rotate 90 (flip-vertical (rotate -90 image))))
|
||||||
|
|
|
@ -1262,15 +1262,28 @@
|
||||||
=>
|
=>
|
||||||
(image-snip->image (make-object image-snip% blue-20x10-bitmap)))
|
(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)))
|
(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
|
;; 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)))))
|
(test (image-width (frame (rotate 90 (scale 1/2 (bitmap icons/plt-logo-red-diffuse.png)))))
|
||||||
=>
|
=>
|
||||||
128)
|
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)
|
;; cropping (and place-image)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user