add definitely-same-image? to mrlib/image-core

gui-doc/mrlib/scribblings/image-core.scrbl

@@ -41,3 +41,13 @@ up an image.
   Ordinarily, the image's bitmap cache is computed the first time
   the image is actually rendered.
 }
+
+@defproc[(definitely-same-image? [i1 image?] [i2 image?]) boolean?]{
+  Returns @racket[#t] if @racket[i1] and @racket[i2] draw identically
+  and @racket[#f] if they may draw the same or may draw differently. 
+  
+  This test is intended to be cheaper than a full equality comparison.
+  It is also used by the implementation of @racket[equal?] on images
+  to short-circuit the full check. (The full check draws the two images
+  and then compares the resulting bitmaps.)
+}

gui-lib/mrlib/image-core.rkt

@@ -436,6 +436,22 @@ has been moved out).
     (inherit set-snipclass)
     (set-snipclass snip-class)))
 
+(define (definitely-same-image? i1 i2)
+  (cond
+    [(and (is-a? i1 image<%>) (is-a? i2 image<%>))
+     (equal? (send i1 get-normalized-shape)
+             (send i2 get-normalized-shape))]
+    [(or (is-a? i1 image<%>) (is-a? i2 image<%>))
+     #f]
+    [else
+     (define bm1 (if (is-a? i1 image-snip%)
+                     (send i1 get-image)
+                     i2))
+     (define bm2 (if (is-a? i2 image-snip%)
+                     (send i2 get-image)
+                     i2))
+     (eq? bm1 bm2)]))
+
 (define (same-bb? bb1 bb2)
   (and (same-width/height? bb1 bb2)
        (= (round (bb-baseline bb1)) (round (bb-baseline bb2)))))
@@ -1383,7 +1399,9 @@ the mask bitmap and the original bitmap are all together in a single bytes!
          curve-segment->path
          mode-color->pen
          
-         snipclass-bytes->image)
+         snipclass-bytes->image
+         (contract-out
+          [definitely-same-image? (-> image? image? boolean?)]))
 
 ;; method names
 (provide get-shape get-bb get-pinhole get-normalized? get-normalized-shape)