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

added check-color

Browse Source 
svn: r15671
This commit is contained in:
Robby Findler 2009-08-04 20:36:07 +00:00
parent fbb31a1393
commit 3e8c91337f
1 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/htdp/error.ss
View File

@ -1,7 +1,10 @@
#lang scheme/base
(require scheme/gui/base
scheme/class)
;; --------------------------------------------------------------------------
(provide check-arg check-arity check-proc check-result check-list-list
(provide check-arg check-arity check-proc check-result
check-list-list check-color
check-fun-res
natural?
find-non tp-exn? number->ord)
@ -59,6 +62,26 @@
(car other-given)
given))))
;; check-color : symbol (or/c str non-negative-integer) TST -> void
(define (check-color pname arg-pos given)
(check-arg pname
(or (is-a? given color%)
(string? given)
(symbol? given))
'color
arg-pos given)
(let ([color
(cond
[(symbol? given)
(send the-color-database find-color (symbol->string given))]
[(string? given)
(send the-color-database find-color given)]
[else given])])
(unless color
(tp-error pname
"expected the name ~e to be a color, but did not recognize it"
given))))
;; check-arg : sym bool str (or/c str non-negative-integer) TST -> void
(define (check-arg pname condition expected arg-posn given)
(unless condition