diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 602c91feb3..fb4a99923c 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -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) diff --git a/collects/mrlib/image-core.ss b/collects/mrlib/image-core.ss index ef6dc81232..f81e1a7825 100644 --- a/collects/mrlib/image-core.ss +++ b/collects/mrlib/image-core.ss @@ -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