From 6ea6483221a6a9f4aad2db7a391043e61718757c Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 20 Nov 2011 16:30:42 -0600
Subject: [PATCH] adjust number-snip% so that it subscribes to the
 file/convertible protocol for 'png-bytes and 'text

---
 collects/framework/private/number-snip.rkt | 37 +++++++++++++++++++---
 collects/tests/framework/README            |  5 ++-
 collects/tests/framework/number-snip.rkt   | 22 +++++++++++++
 3 files changed, 56 insertions(+), 8 deletions(-)
 create mode 100644 collects/tests/framework/number-snip.rkt

diff --git a/collects/framework/private/number-snip.rkt b/collects/framework/private/number-snip.rkt
index 52811c3da1..16013d1225 100644
--- a/collects/framework/private/number-snip.rkt
+++ b/collects/framework/private/number-snip.rkt
@@ -4,7 +4,8 @@
            mred/mred-sig
            racket/class
            "../preferences.rkt"
-           string-constants)
+           string-constants
+           file/convertible)
   
   (import mred^)
   (export (rename framework:number-snip^
@@ -67,9 +68,32 @@
   ;; cut-off : number
   ;; indicates how many digits to fetch for each click
   (define cut-off 25)
+
+  (define-local-member-name draw-fraction)
+  
+  (define number-snip-convertible<%>
+    (interface* ()
+                ([prop:convertible
+                  (λ (number-snip request default)
+                    (case request
+                      [(png-bytes) 
+                       (define dc (make-object bitmap-dc% (make-bitmap 1 1)))
+                       (define wb (box 0))
+                       (define hb (box 0))
+                       (send number-snip get-extent dc 0 0 wb hb #f #f #f #f)
+                       (define bm (make-bitmap (inexact->exact (ceiling (unbox wb))) 
+                                               (inexact->exact (ceiling (unbox hb)))))
+                       (send dc set-bitmap bm)
+                       (send number-snip draw-fraction dc 0 0)
+                       (define bp (open-output-bytes))
+                       (send bm save-file bp 'png)
+                       (get-output-bytes bp)]
+                      [(text)
+                       (send number-snip get-text 0 1)]
+                      [else default]))])))
   
   (define number-snip%
-    (class* snip% (readable-snip<%>)
+    (class* snip% (readable-snip<%> number-snip-convertible<%>)
       ;; number : number
       ;; this is the number to show
       (init-field number)
@@ -352,12 +376,15 @@
             (when fg-color
               (send dc set-pen fg-color 1 'solid)
               (send dc set-text-foreground fg-color)))) 
+        (draw-fraction dc x y)
+        (send dc set-text-foreground clr)
+        (send dc set-pen pen))
+      
+      (define/public (draw-fraction dc x y)
         (case fraction-view
           [(mixed) (draw-mixed-fraction dc x y)]
           [(improper) (draw-improper-fraction dc x y)]
-          [(decimal) (draw-decimals dc x y)])
-        (send dc set-text-foreground clr)
-        (send dc set-pen pen))
+          [(decimal) (draw-decimals dc x y)]))
       
       (define/private (get-improper-fraction-extent dc x y w h descent space lspace rspace)
         (let* ([style (get-style)]
diff --git a/collects/tests/framework/README b/collects/tests/framework/README
index a9dae2dd65..48bfcd1156 100644
--- a/collects/tests/framework/README
+++ b/collects/tests/framework/README
@@ -66,10 +66,9 @@ signal failures when there aren't any.
   | make sure that mred:the-frame-group records frames correctly.
   | fake user input expected.
 
-- saving tests:
+- number snip: |# number-snip.rkt #|
 
-  | These tests will make sure that the usual checks against a user
-  | losing their work are in place.
+  | some tests for the number-snip% class
 
 - scheme tests:
 
diff --git a/collects/tests/framework/number-snip.rkt b/collects/tests/framework/number-snip.rkt
new file mode 100644
index 0000000000..6804361a88
--- /dev/null
+++ b/collects/tests/framework/number-snip.rkt
@@ -0,0 +1,22 @@
+#lang racket/base
+(require "test-suite-utils.rkt")
+
+(test
+ 'number-snip-convert-text
+ (λ (x) (equal? "1/2" x))
+ (lambda ()
+   (queue-sexp-to-mred
+    `((dynamic-require 'file/convertible 'convert)
+      (number-snip:make-fraction-snip 1/2 #f)
+      'text
+      #f))))
+
+(test
+ 'number-snip-convert-png
+ bytes?
+ (lambda ()
+   (queue-sexp-to-mred
+    `((dynamic-require 'file/convertible 'convert)
+      (number-snip:make-fraction-snip 1/2 #f)
+      'png-bytes
+      #f))))