suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Tweak snip/draw contracts for better error messages.

Browse Source 
This commit names some intermediate class contracts,
which now print better due to a recent change by Robby.
This commit is contained in:
Asumu Takikawa 2012-04-08 12:45:42 -04:00
parent a376725c77
commit c40ce285cf
2 changed files with 68 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/racket/draw.rkt
View File

@ -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]

129
collects/racket/draw/private/contract.rkt
View File

@ -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