Permalink
Browse files

Tweak snip/draw contracts for better error messages.

This commit names some intermediate class contracts,
which now print better due to a recent change by Robby.
  • Loading branch information...
1 parent a376725 commit c40ce285cfb08bc78f3085e4f337e07e6932fd90 @takikawa takikawa committed Apr 8, 2012
Showing with 68 additions and 72 deletions.
  1. +6 −5 collects/racket/draw.rkt
  2. +62 −67 collects/racket/draw/private/contract.rkt
View
@@ -28,7 +28,7 @@
the-pen-list
the-brush-list
dc<%>
- record-dc% recorded-datum->procedure
+ recorded-datum->procedure
ps-setup% current-ps-setup
get-face-list
get-family-builtin-face
@@ -45,10 +45,11 @@
[pen-list% pen-list%/c]
[brush% brush%/c]
[brush-list% brush-list%/c]
- [bitmap-dc% bitmap-dc%/c]
- [post-script-dc% post-script-dc%/c]
- [pdf-dc% pdf-dc%/c]
- [svg-dc% svg-dc%/c]
+ [bitmap-dc% (and/c dc<%>/c bitmap-dc%/c)]
+ [post-script-dc% (and/c dc<%>/c post-script-dc%/c)]
+ [pdf-dc% (and/c dc<%>/c pdf-dc%/c)]
+ [svg-dc% (and/c dc<%>/c svg-dc%/c)]
+ [record-dc% (and/c dc<%>/c record-dc%/c)]
[linear-gradient% linear-gradient%/c]
[radial-gradient% radial-gradient%/c]
[region% region%/c]
@@ -306,81 +306,76 @@
[get-stops (->m (listof (list/c real? (is-a?/c color%))))]))
(define bitmap-dc%/c
- (and/c dc<%>/c
- (class/c
- (init [bitmap (or/c (is-a?/c bitmap%) #f)])
- [draw-bitmap-section-smooth
- (->*m ((is-a?/c bitmap%)
- real? real?
- (and/c real? (not/c negative?))
- (and/c real? (not/c negative?))
- real? real?
- (and/c real? (not/c negative?))
- (and/c real? (not/c negative?)))
- ((or/c 'solid 'opaque 'xor)
- (or/c (is-a?/c color%) #f)
- (or/c (is-a?/c bitmap%) #f))
- boolean?)]
- [get-argb-pixels
- (->*m (exact-nonnegative-integer?
- exact-nonnegative-integer?
- exact-nonnegative-integer?
- exact-nonnegative-integer?
- (and/c bytes? (not/c immutable?)))
- (any/c any/c)
- void?)]
- [get-bitmap (->m (or/c (is-a?/c bitmap%) #f))]
- [get-pixel (->m real? real? (is-a?/c color%) boolean?)]
- [set-argb-pixels
- (->*m (exact-nonnegative-integer?
- exact-nonnegative-integer?
- exact-nonnegative-integer?
- exact-nonnegative-integer?
- bytes?)
- (any/c any/c)
- void?)]
- [set-bitmap (->m (or/c (is-a?/c bitmap%) #f) void?)]
- [set-pixel (->m real? real? (is-a?/c color%) void?)])))
+ (class/c
+ (init [bitmap (or/c (is-a?/c bitmap%) #f)])
+ [draw-bitmap-section-smooth
+ (->*m ((is-a?/c bitmap%)
+ real? real?
+ (and/c real? (not/c negative?))
+ (and/c real? (not/c negative?))
+ real? real?
+ (and/c real? (not/c negative?))
+ (and/c real? (not/c negative?)))
+ ((or/c 'solid 'opaque 'xor)
+ (or/c (is-a?/c color%) #f)
+ (or/c (is-a?/c bitmap%) #f))
+ boolean?)]
+ [get-argb-pixels
+ (->*m (exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ (and/c bytes? (not/c immutable?)))
+ (any/c any/c)
+ void?)]
+ [get-bitmap (->m (or/c (is-a?/c bitmap%) #f))]
+ [get-pixel (->m real? real? (is-a?/c color%) boolean?)]
+ [set-argb-pixels
+ (->*m (exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ exact-nonnegative-integer?
+ bytes?)
+ (any/c any/c)
+ void?)]
+ [set-bitmap (->m (or/c (is-a?/c bitmap%) #f) void?)]
+ [set-pixel (->m real? real? (is-a?/c color%) void?)]))
(define post-script-dc%/c
- (and/c dc<%>/c
- (class/c
- (init [interactive any/c]
- [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
- [use-paper-bbox any/c]
- [as-eps any/c]
- [width (or/c (and/c real? (not/c negative?)) #f)]
- [height (or/c (and/c real? (not/c negative?)) #f)]
- [output (or/c path-string? output-port? #f)]))))
+ (class/c
+ (init [interactive any/c]
+ [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
+ [use-paper-bbox any/c]
+ [as-eps any/c]
+ [width (or/c (and/c real? (not/c negative?)) #f)]
+ [height (or/c (and/c real? (not/c negative?)) #f)]
+ [output (or/c path-string? output-port? #f)])))
(define pdf-dc%/c
- (and/c dc<%>/c
- (class/c
- (init [interactive any/c]
- [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
- [use-paper-bbox any/c]
- [as-eps any/c]
- [width (or/c (and/c real? (not/c negative?)) #f)]
- [height (or/c (and/c real? (not/c negative?)) #f)]
- [output (or/c path-string? output-port? #f)]))))
+ (class/c
+ (init [interactive any/c]
+ [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
+ [use-paper-bbox any/c]
+ [as-eps any/c]
+ [width (or/c (and/c real? (not/c negative?)) #f)]
+ [height (or/c (and/c real? (not/c negative?)) #f)]
+ [output (or/c path-string? output-port? #f)])))
(define svg-dc%/c
- (and/c dc<%>/c
- (class/c
- (init [width (or/c (and/c real? (not/c negative?)) #f)]
- [height (or/c (and/c real? (not/c negative?)) #f)]
- [output (or/c path-string? output-port? #f)]
- [exists (or/c 'error 'append 'update 'can-update
- 'replace 'truncate
- 'must-truncate 'truncate/replace)]))))
+ (class/c
+ (init [width (or/c (and/c real? (not/c negative?)) #f)]
+ [height (or/c (and/c real? (not/c negative?)) #f)]
+ [output (or/c path-string? output-port? #f)]
+ [exists (or/c 'error 'append 'update 'can-update
+ 'replace 'truncate
+ 'must-truncate 'truncate/replace)])))
(define record-dc%/c
- (and/c dc<%>/c
- (class/c
- (init [width (>=/c 0)]
- [height (>=/c 0)])
- [get-recorded-datum (->m any/c)]
- [get-recorded-procedure (->m ((is-a?/c dc<%>) . -> . void?))])))
+ (class/c
+ (init [width (>=/c 0)]
+ [height (>=/c 0)])
+ [get-recorded-datum (->m any/c)]
+ [get-recorded-procedure (->m ((is-a?/c dc<%>) . -> . void?))]))
(define region%/c
(class/c

0 comments on commit c40ce28

Please sign in to comment.