suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve the performance of rotated or scaled (but not flipped) bitmap

Browse Source 
drawing in 2htdp/image

closes PR 13895

original commit: df446195bfea12120a5011ac39dd9de762338e56
This commit is contained in:
Robby Findler 2013-07-01 10:01:51 -05:00
parent 765bc134e8
commit c73fb751b0
1 changed files with 35 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt
View File

@ -921,12 +921,35 @@ has been moved out).
(send dc set-smoothing (mode-color->smoothing mode color))
(send dc draw-path path dx dy)))]
[(flip? np-atomic-shape)
(let ([bm (get-rendered-bitmap np-atomic-shape)])
(cond
[(flip-flipped? np-atomic-shape)
(define key (get-bitmap-cache-key np-atomic-shape))
(define bm (lookup/calc-rendered-bitmap np-atomic-shape key))
(send dc set-smoothing 'smoothed)
(send dc draw-bitmap
bm
(- dx (/ (send bm get-width) 2))
(- dy (/ (send bm get-height) 2))))]
(- dy (/ (send bm get-height) 2)))]
[else
(define transformation (send dc get-transformation))
(define bitmap (flip-shape np-atomic-shape))
(define bitmap-obj (ibitmap-raw-bitmap bitmap))
(define θ (degrees->radians (ibitmap-angle bitmap)))
(send dc translate dx dy)
(send dc rotate θ)
(define bw (send bitmap-obj get-width))
(define bh (send bitmap-obj get-height))
(send dc translate (- (/ bw 2)) (- (/ bh 2)))
(send dc set-scale (ibitmap-x-scale bitmap) (ibitmap-y-scale bitmap))
(send dc draw-bitmap bitmap-obj 0 0)
(send dc set-transformation transformation)
bitmap-obj])]
[(text? np-atomic-shape)
(let ([θ (degrees->radians (text-angle np-atomic-shape))]
[font (send dc get-font)])
@ -995,16 +1018,12 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|#
(define (get-rendered-bitmap flip-bitmap)
(let ([key (get-bitmap-cache-key flip-bitmap)])
(lookup/calc-rendered-bitmap flip-bitmap key)))
(define (get-bitmap-cache-key flip-bitmap)
(let ([bm (flip-shape flip-bitmap)])
(define bm (flip-shape flip-bitmap))
(list (flip-flipped? flip-bitmap)
(ibitmap-x-scale bm)
(ibitmap-y-scale bm)
(ibitmap-angle bm))))
(ibitmap-angle bm)))
(define (lookup/calc-rendered-bitmap flip-bitmap key)
(let ([bitmap (flip-shape flip-bitmap)])