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

PR 10783

Browse Source 
svn: r18340
This commit is contained in:
Robby Findler 2010-02-25 20:57:45 +00:00
parent 2c408dbcdd
commit 39dd21c240
2 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/drscheme/private/unit.ss
View File

@ -185,7 +185,12 @@ module browser threading seems wrong.
(let ([kind (filename->kind fn)])
(cond
[kind
(send (send snip get-bitmap) save-file fn kind)]
(cond
[(or (is-a? snip image-snip%)
(is-a? snip cache-image-snip%))
(send (send snip get-bitmap) save-file fn kind)]
[else
(image-core:save-image-as-bitmap snip fn kind)])]
[else
(message-box
(string-constant drscheme)

12
collects/mrlib/image-core.ss
View File

@ -559,6 +559,17 @@ has been moved out).
(send dc set-text-foreground fg)
(send dc set-smoothing smoothing)))
(define (save-image-as-bitmap image filename kind)
(let* ([bb (send image get-bb)]
[bm (make-object bitmap%
(ceiling (inexact->exact (bb-right bb)))
(ceiling (inexact->exact (bb-bottom bb))))]
[bdc (make-object bitmap-dc% bm)])
(send bdc clear)
(render-image image bdc 0 0)
(send bdc set-bitmap #f)
(send bm save-file filename kind)))
(define (render-normalized-shape shape dc dx dy)
(cond
[(overlay? shape)
@ -939,6 +950,7 @@ the mask bitmap and the original bitmap are all together in a single bytes!
text->font
render-image
save-image-as-bitmap
skip-image-equality-fast-path