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-pen-list
the-brush-list the-brush-list
dc<%> dc<%>
record-dc% recorded-datum->procedure recorded-datum->procedure
ps-setup% current-ps-setup ps-setup% current-ps-setup
get-face-list get-face-list
get-family-builtin-face get-family-builtin-face
@ -45,10 +45,11 @@
[pen-list% pen-list%/c] [pen-list% pen-list%/c]
[brush% brush%/c] [brush% brush%/c]
[brush-list% brush-list%/c] [brush-list% brush-list%/c]
[bitmap-dc% bitmap-dc%/c] [bitmap-dc% (and/c dc<%>/c bitmap-dc%/c)]
[post-script-dc% post-script-dc%/c] [post-script-dc% (and/c dc<%>/c post-script-dc%/c)]
[pdf-dc% pdf-dc%/c] [pdf-dc% (and/c dc<%>/c pdf-dc%/c)]
[svg-dc% svg-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] [linear-gradient% linear-gradient%/c]
[radial-gradient% radial-gradient%/c] [radial-gradient% radial-gradient%/c]
[region% region%/c] [region% region%/c]

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

@ -306,7 +306,6 @@
[get-stops (->m (listof (list/c real? (is-a?/c color%))))])) [get-stops (->m (listof (list/c real? (is-a?/c color%))))]))
(define bitmap-dc%/c (define bitmap-dc%/c
(and/c dc<%>/c
(class/c (class/c
(init [bitmap (or/c (is-a?/c bitmap%) #f)]) (init [bitmap (or/c (is-a?/c bitmap%) #f)])
[draw-bitmap-section-smooth [draw-bitmap-section-smooth
@ -340,10 +339,9 @@
(any/c any/c) (any/c any/c)
void?)] void?)]
[set-bitmap (->m (or/c (is-a?/c bitmap%) #f) void?)] [set-bitmap (->m (or/c (is-a?/c bitmap%) #f) void?)]
[set-pixel (->m real? real? (is-a?/c color%) void?)]))) [set-pixel (->m real? real? (is-a?/c color%) void?)]))
(define post-script-dc%/c (define post-script-dc%/c
(and/c dc<%>/c
(class/c (class/c
(init [interactive any/c] (init [interactive any/c]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
@ -351,10 +349,9 @@
[as-eps any/c] [as-eps any/c]
[width (or/c (and/c real? (not/c negative?)) #f)] [width (or/c (and/c real? (not/c negative?)) #f)]
[height (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)])))) [output (or/c path-string? output-port? #f)])))
(define pdf-dc%/c (define pdf-dc%/c
(and/c dc<%>/c
(class/c (class/c
(init [interactive any/c] (init [interactive any/c]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)] [parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)]
@ -362,25 +359,23 @@
[as-eps any/c] [as-eps any/c]
[width (or/c (and/c real? (not/c negative?)) #f)] [width (or/c (and/c real? (not/c negative?)) #f)]
[height (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)])))) [output (or/c path-string? output-port? #f)])))
(define svg-dc%/c (define svg-dc%/c
(and/c dc<%>/c
(class/c (class/c
(init [width (or/c (and/c real? (not/c negative?)) #f)] (init [width (or/c (and/c real? (not/c negative?)) #f)]
[height (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)] [output (or/c path-string? output-port? #f)]
[exists (or/c 'error 'append 'update 'can-update [exists (or/c 'error 'append 'update 'can-update
'replace 'truncate 'replace 'truncate
'must-truncate 'truncate/replace)])))) 'must-truncate 'truncate/replace)])))
(define record-dc%/c (define record-dc%/c
(and/c dc<%>/c
(class/c (class/c
(init [width (>=/c 0)] (init [width (>=/c 0)]
[height (>=/c 0)]) [height (>=/c 0)])
[get-recorded-datum (->m any/c)] [get-recorded-datum (->m any/c)]
[get-recorded-procedure (->m ((is-a?/c dc<%>) . -> . void?))]))) [get-recorded-procedure (->m ((is-a?/c dc<%>) . -> . void?))]))
(define region%/c (define region%/c
(class/c (class/c