fixed PR 8830
svn: r6979
This commit is contained in:
parent
e3c97257a1
commit
23d245c09f
|
@ -1,3 +1,57 @@
|
|||
;; this is like (lib "htdp" "image.ss")
|
||||
;; except that it provides things with
|
||||
;; provide-primitives for better error
|
||||
;; reporting in the teaching languages.
|
||||
|
||||
(module image mzscheme
|
||||
(require (lib "image.ss" "htdp"))
|
||||
(provide (all-from (lib "image.ss" "htdp"))))
|
||||
(require (lib "image.ss" "htdp")
|
||||
(lib "prim.ss" "lang"))
|
||||
|
||||
|
||||
(provide-primitives
|
||||
image-width
|
||||
image-height
|
||||
overlay
|
||||
overlay/xy
|
||||
|
||||
pinhole-x
|
||||
pinhole-y
|
||||
move-pinhole
|
||||
put-pinhole
|
||||
|
||||
rectangle
|
||||
circle
|
||||
ellipse
|
||||
triangle
|
||||
line
|
||||
star
|
||||
add-line
|
||||
text
|
||||
|
||||
shrink
|
||||
shrink-tl
|
||||
shrink-tr
|
||||
shrink-bl
|
||||
shrink-br
|
||||
|
||||
image-inside?
|
||||
find-image
|
||||
|
||||
image->color-list
|
||||
color-list->image
|
||||
|
||||
image->alpha-color-list
|
||||
alpha-color-list->image
|
||||
|
||||
image-color?
|
||||
make-color
|
||||
color-red
|
||||
color-green
|
||||
color-blue
|
||||
color?
|
||||
make-alpha-color
|
||||
alpha-color-alpha
|
||||
alpha-color-red
|
||||
alpha-color-green
|
||||
alpha-color-blue
|
||||
alpha-color?))
|
|
@ -1,7 +1,7 @@
|
|||
;; Load this one with MrEd
|
||||
|
||||
(load-relative "loadtest.ss")
|
||||
(require (lib "image.ss" "htdp")
|
||||
(require (lib "image.ss" "teachpack" "htdp")
|
||||
(lib "error.ss" "htdp")
|
||||
(lib "posn.ss" "lang")
|
||||
(lib "list.ss")
|
||||
|
@ -1182,4 +1182,10 @@
|
|||
(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) 10 +inf.0 #f) "third")
|
||||
(err/rt-name-test (overlay/xy (rectangle 100 200 'outline 'red) -inf.0 +inf.0 #f) "second")
|
||||
|
||||
(report-errs)
|
||||
(parameterize ((current-namespace (make-namespace)))
|
||||
(err/rt-test (eval '(module m (lib "htdp-beginner.ss" "lang") (require (lib "image.ss" "teachpack" "htdp")) overlay))
|
||||
(lambda (exn)
|
||||
(regexp-match #rx"must be applied to arguments"
|
||||
(exn-message exn)))))
|
||||
|
||||
(report-errs)
|
||||
|
|
Loading…
Reference in New Issue
Block a user