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

2htdp/image fix bitmap scaling to respect alpha channels

Browse Source 
original commit: 1d89cfc9d7a236bb5c2f2516d71bc8eb204d7203
This commit is contained in:
Robby Findler 2010-12-28 18:13:53 -06:00
parent 6d348a2114
commit 4fe47c78de
1 changed files with 3 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mrlib/image-core.rkt
View File

@ -982,25 +982,16 @@ the mask bitmap and the original bitmap are all together in a single bytes!
[orig-h (send orig-bm get-height)] [orig-h (send orig-bm get-height)]
[scale-w (ceiling (inexact->exact (* x-scale (send orig-bm get-width))))] [scale-w (ceiling (inexact->exact (* x-scale (send orig-bm get-width))))]
[scale-h (ceiling (inexact->exact (* y-scale (send orig-bm get-height))))] [scale-h (ceiling (inexact->exact (* y-scale (send orig-bm get-height))))]
[new-bm (make-object bitmap% scale-w scale-h)] [new-bm (make-bitmap scale-w scale-h)])
[new-mask (and orig-mask (make-object bitmap% scale-w scale-h))])
(when new-mask
(send new-bm set-loaded-mask new-mask))
(send bdc set-bitmap new-bm) (send bdc set-bitmap new-bm)
(send bdc set-scale x-scale y-scale) (send bdc set-scale x-scale y-scale)
(send bdc erase) (send bdc erase)
(send bdc draw-bitmap orig-bm 0 0) (send bdc draw-bitmap orig-bm 0 0 'solid (send the-color-database find-color "black") orig-mask)
(when new-mask
(send bdc set-bitmap new-mask)
(send bdc set-scale x-scale y-scale)
(send bdc erase)
(send bdc draw-bitmap orig-mask 0 0))
(send bdc set-bitmap #f) (send bdc set-bitmap #f)
(values new-bm new-mask))]))) (values new-bm #f))])))
(define (text->font text) (define (text->font text)
(define adjusted-size (min (max (inexact->exact (round (text-size text))) 1) 255)) (define adjusted-size (min (max (inexact->exact (round (text-size text))) 1) 255))