From 256e3fedd298b79e49c6ac89717a19bbc0369e9b Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 23 Apr 2010 12:34:17 -0500
Subject: [PATCH] fixed a bug with zero-sized htdp/image images interactive
 with 2htdp/image primitives

---
 collects/2htdp/private/img-err.ss  | 24 +++++++++++++++++++++---
 collects/2htdp/tests/test-image.ss |  9 +++++++++
 2 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/collects/2htdp/private/img-err.ss b/collects/2htdp/private/img-err.ss
index f9f24ebc04..a5bd685678 100644
--- a/collects/2htdp/private/img-err.ss
+++ b/collects/2htdp/private/img-err.ss
@@ -20,6 +20,7 @@
          lang/posn
          scheme/gui/base
          "../../mrlib/image-core.ss"
+         (prefix-in cis: "../../mrlib/cache-image-snip.ss")
          (for-syntax scheme/base
                      scheme/list))
 
@@ -270,9 +271,26 @@
     [else arg]))
 
 (define (image-snip->image is)
-  (bitmap->image (send is get-bitmap)
-                 (or (send is get-bitmap-mask)
-                     (send (send is get-bitmap) get-loaded-mask))))
+  (let ([bm (send is get-bitmap)])
+    (cond
+      [(not bm)
+       ;; this might mean we have a cache-image-snip% 
+       ;; or it might mean we have a useless snip.
+       (let-values ([(w h) (if (is-a? is cis:cache-image-snip%)
+                               (send is get-size)
+                               (values 0 0))])
+         (make-image (make-polygon
+                      (list (make-point 0 0)
+                            (make-point w 0)
+                            (make-point w h)
+                            (make-point 0 h))
+                      'solid "black")
+                     (make-bb w h h)
+                     #f))]
+      [else
+       (bitmap->image bm
+                      (or (send is get-bitmap-mask)
+                          (send bm get-loaded-mask)))])))
 
 (define (bitmap->image bm [mask-bm (send bm get-loaded-mask)])
   (let ([w (send bm get-width)]
diff --git a/collects/2htdp/tests/test-image.ss b/collects/2htdp/tests/test-image.ss
index e5dd1c84e5..2db4c687f7 100644
--- a/collects/2htdp/tests/test-image.ss
+++ b/collects/2htdp/tests/test-image.ss
@@ -46,6 +46,7 @@
          scheme/class
          scheme/gui/base
          schemeunit
+         (prefix-in 1: htdp/image)
          (only-in lang/htdp-advanced equal~?))
 
 (require (for-syntax scheme/base))
@@ -202,6 +203,14 @@
 (check-close (image-height (rotate 30 (ellipse 0 100 'solid 'blue)))
              (ceiling (* (cos (* pi 1/6)) 100)))
 
+;; zero-sized htdp/image images should also work
+(test (image-width (1:text "" 18 "blue"))
+      =>
+      0)
+(test (image-height (1:rectangle 10 0 'solid "red"))
+      =>
+      0)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  polygon equality