diff --git a/collects/2htdp/image.rkt b/collects/2htdp/image.rkt index 80502263d2..9aff254658 100644 --- a/collects/2htdp/image.rkt +++ b/collects/2htdp/image.rkt @@ -50,7 +50,8 @@ and they all have good sample contracts. (It is amazing what we can do with kids "private/image-more.ss" "private/img-err.ss" (only-in lang/prim provide-primitive provide-primitives define-primitive) - htdp/error) + htdp/error + (only-in lang/imageeq image=?)) (provide-primitives overlay @@ -137,9 +138,11 @@ and they all have good sample contracts. (It is amazing what we can do with kids make-pen pen pen? step-count? - save-image) + save-image + image=?) -(provide bitmap) +(provide bitmap + image=?) (define-primitive make-color build-color/make-color) (define-primitive color build-color/color) diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index dab52101c7..f91b8fe85a 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -304,6 +304,25 @@ => #t) +;; test to make sure that image=? is provided from 2htdp/image and +;; not just built into the teaching languages. +(test (image=? (rectangle 10 10 'solid 'red) (rectangle 10 10 'solid 'red)) + => + #t) + +(test (image=? (overlay (rectangle 3 1 'solid 'blue) + (rectangle 1 3 'solid 'blue)) + (overlay (rectangle 1 3 'solid 'blue) + (rectangle 3 1 'solid 'blue))) + => + #t) + + +(test (with-handlers ((exn:fail? (λ (x) 'passed))) + (begin (image=? 1 2) 'fail)) + => + 'passed) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; testing overlays diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index 60c23e1a98..d3e48d1761 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -2,7 +2,7 @@ @(require (for-label (only-in racket/contract and/c or/c any/c not/c) 2htdp/image - (except-in lang/htdp-beginner posn make-posn posn? posn-x posn-y image?) + (except-in lang/htdp-beginner posn make-posn posn? posn-x posn-y image? image=?) lang/posn racket/gui/base (only-in racket/base path-string?)) @@ -1279,10 +1279,16 @@ Using @racket["pinhole"] or @racket['pinhole] is only allowed when all of the im @section{Equality Testing of Images} -Two images are equal if they draw exactly the same way at their current size +Two images are @racket[equal?] if they draw exactly the same way at their current size (not neccessarily at all sizes) and, if there are pinholes, the pinholes are in the same place. +@defproc[(image=? [i1 image?] [i2 image?]) boolean?]{ + Tests the same thing as @racket[(equal? i1 i2)], but + insists that its arguments are images, signalling an error + otherwise. +} + @section[#:tag "pinholes"]{Pinholes} A pinhole is an optional property of an image that identifies a point somewhere