adjust number-snip% so that it subscribes to the file/convertible
protocol for 'png-bytes and 'text
This commit is contained in:
parent
d416dfaa8c
commit
6ea6483221
|
@ -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)]
|
||||
|
|
|
@ -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:
|
||||
|
||||
|
|
22
collects/tests/framework/number-snip.rkt
Normal file
22
collects/tests/framework/number-snip.rkt
Normal file
|
@ -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))))
|
Loading…
Reference in New Issue
Block a user