From 13cae20838e8d7a6de1fff3c242fb8d85fca22cb Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 15 Dec 2010 13:59:57 -0500
Subject: [PATCH] Fixes for PNG conversion, and make `image-snip%' convertible.

---
 collects/mred/private/wxme/snip.rkt | 15 +++++++++++++--
 collects/mrlib/image-core.rkt       | 13 ++++++++-----
 2 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/collects/mred/private/wxme/snip.rkt b/collects/mred/private/wxme/snip.rkt
index 9737fd4863..6313c54afe 100644
--- a/collects/mred/private/wxme/snip.rkt
+++ b/collects/mred/private/wxme/snip.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 (require scheme/class
-         scheme/file
+         scheme/file file/convertible
          "../syntax.ss"
          "snip-flags.ss"
          "private.ss"
@@ -863,7 +863,18 @@
              jpeg png png/mask png/alpha
              xbm xpm bmp pict))
 
-(defclass* image-snip% internal-snip% (equal<%>)
+(define png-convertible<%>
+  (interface* ()
+              ([prop:convertible
+                (lambda (img format default)
+                  (case format
+                    [(png-bytes)
+                     (let ([s (open-output-bytes)])
+                       (send (send img get-bitmap) save-file s 'png)
+                       (get-output-bytes s))]
+                    [else default]))])))
+
+(defclass* image-snip% internal-snip% (equal<%> png-convertible<%>)
   (inherit-field s-admin
                  s-flags)
   (inherit set-snipclass)
diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt
index b95c8314ee..8d65e27110 100644
--- a/collects/mrlib/image-core.rkt
+++ b/collects/mrlib/image-core.rkt
@@ -28,6 +28,7 @@ has been moved out).
 |#
 
 (require racket/class
+         racket/draw
          racket/gui/base
          racket/math
          racket/contract
@@ -211,13 +212,15 @@ has been moved out).
 
 (define (to-bitmap img)  
   (let* ([bb (send img get-bb)]
-         [bm (make-object bitmap% 
-               (add1 (inexact->exact (ceiling (bb-right bb)))) 
-               (add1 (inexact->exact (ceiling (bb-bottom bb)))))]
-         [bdc (make-object bitmap-dc% bm)])
+         [bm (make-bitmap
+              (add1 (inexact->exact (ceiling (bb-right bb)))) 
+              (add1 (inexact->exact (ceiling (bb-bottom bb)))))]
+         [bdc (new bitmap-dc% [bitmap bm])])
     (send bdc clear)
     (render-image img bdc 0 0)
-    (send bdc get-bitmap)))
+    (begin0
+        (send bdc get-bitmap)
+      (send bdc set-bitmap #f)))
 	     
 (define image%
   (class* snip% (png-convertible<%> equal<%> image<%>)