make 2htdp/image's equality function ignore baselines
also some Rackety and spelling related to PR 14760
This commit is contained in:
parent
0f058d8cf2
commit
0c8834d567
|
@ -134,7 +134,8 @@ has been moved out).
|
||||||
(define-struct/reg-mk ellipse (width height angle mode color) #:transparent #:omit-define-syntaxes)
|
(define-struct/reg-mk ellipse (width height angle mode color) #:transparent #:omit-define-syntaxes)
|
||||||
;;
|
;;
|
||||||
;; - (make-text string angle number color
|
;; - (make-text string angle number color
|
||||||
;; number (or/c #f string) family (or/c 'normal 'italic) (or/c 'normal 'light 'bold) boolean)
|
;; number (or/c #f string) family
|
||||||
|
;; (or/c 'normal 'italic) (or/c 'normal 'light 'bold) boolean)
|
||||||
;; NOTE: font can't be the raw mred font or else copy & paste won't work
|
;; NOTE: font can't be the raw mred font or else copy & paste won't work
|
||||||
(define-struct/reg-mk text (string angle y-scale color size face family style weight underline)
|
(define-struct/reg-mk text (string angle y-scale color size face family style weight underline)
|
||||||
#:omit-define-syntaxes #:transparent)
|
#:omit-define-syntaxes #:transparent)
|
||||||
|
@ -144,7 +145,8 @@ has been moved out).
|
||||||
;; a bitmap is:
|
;; a bitmap is:
|
||||||
;; - (make-ibitmap (and/c (is-a?/c bitmap%) (lambda (x) (send x has-alpha-channel?)))
|
;; - (make-ibitmap (and/c (is-a?/c bitmap%) (lambda (x) (send x has-alpha-channel?)))
|
||||||
;; angle positive-real
|
;; angle positive-real
|
||||||
;; hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle]) -o> (is-a?/c bitmap%)])
|
;; hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle])
|
||||||
|
;; -o> (is-a?/c bitmap%)])
|
||||||
;; NOTE: bitmap copying needs to happen in 'write' and 'read' methods
|
;; NOTE: bitmap copying needs to happen in 'write' and 'read' methods
|
||||||
(define-struct/reg-mk ibitmap #:reflect-id bitmap (raw-bitmap angle x-scale y-scale cache)
|
(define-struct/reg-mk ibitmap #:reflect-id bitmap (raw-bitmap angle x-scale y-scale cache)
|
||||||
#:omit-define-syntaxes #:transparent
|
#:omit-define-syntaxes #:transparent
|
||||||
|
@ -152,7 +154,8 @@ has been moved out).
|
||||||
|
|
||||||
;; a flip is:
|
;; a flip is:
|
||||||
;; - (make-flip boolean bitmap)
|
;; - (make-flip boolean bitmap)
|
||||||
;; * the boolean is #t if the bitmap should be flipped vertically (after applying whatever rotation is in there)
|
;; * the boolean is #t if the bitmap should be flipped vertically
|
||||||
|
;; (after applying whatever rotation is in there)
|
||||||
;; * this struct is here to avoid adding a field to bitmaps, so that old save files
|
;; * this struct is here to avoid adding a field to bitmaps, so that old save files
|
||||||
;; from when the library did not support flipping still load
|
;; from when the library did not support flipping still load
|
||||||
;; (since normalization will add a flip structure if necessary)
|
;; (since normalization will add a flip structure if necessary)
|
||||||
|
@ -171,7 +174,8 @@ has been moved out).
|
||||||
;; a curve-segment is
|
;; a curve-segment is
|
||||||
;;
|
;;
|
||||||
;; - (make-curve-segment point real real point real real color)
|
;; - (make-curve-segment point real real point real real color)
|
||||||
(define-struct/reg-mk curve-segment (start s-angle s-pull end e-angle e-pull color) #:transparent #:omit-define-syntaxes)
|
(define-struct/reg-mk curve-segment (start s-angle s-pull end e-angle e-pull color)
|
||||||
|
#:transparent #:omit-define-syntaxes)
|
||||||
|
|
||||||
;; a normalized-shape (subtype of shape) is either
|
;; a normalized-shape (subtype of shape) is either
|
||||||
;; - (make-overlay normalized-shape cn-or-simple-shape)
|
;; - (make-overlay normalized-shape cn-or-simple-shape)
|
||||||
|
@ -300,9 +304,9 @@ has been moved out).
|
||||||
[(is-a? that bitmap%) (bitmap->image that)]
|
[(is-a? that bitmap%) (bitmap->image that)]
|
||||||
[else that])])
|
[else that])])
|
||||||
(and (is-a? that image%)
|
(and (is-a? that image%)
|
||||||
(same-bb? bb (send that get-bb))
|
(same-width/height? bb (send that get-bb))
|
||||||
(equal? pinhole (send that get-pinhole))
|
(equal? pinhole (send that get-pinhole))
|
||||||
(or (and (not (skip-image-equality-fast-path)) ;; this is here to make testing more effective
|
(or (and (not (skip-image-equality-fast-path)) ;; this makes testing more effective
|
||||||
(equal? (get-normalized-shape) (send that get-normalized-shape)))
|
(equal? (get-normalized-shape) (send that get-normalized-shape)))
|
||||||
|
|
||||||
;; some shapes (ie, rectangles) draw 1 outside the bounding box
|
;; some shapes (ie, rectangles) draw 1 outside the bounding box
|
||||||
|
@ -388,7 +392,8 @@ has been moved out).
|
||||||
(define/public (compute-cached-bitmap)
|
(define/public (compute-cached-bitmap)
|
||||||
(when use-cached-bitmap?
|
(when use-cached-bitmap?
|
||||||
(unless cached-bitmap
|
(unless cached-bitmap
|
||||||
(set! cached-bitmap (make-bitmap (min (+ (inexact->exact (round (bb-right bb))) 1) maximum-width)
|
(set! cached-bitmap
|
||||||
|
(make-bitmap (min (+ (inexact->exact (round (bb-right bb))) 1) maximum-width)
|
||||||
(min (+ (inexact->exact (round (bb-bottom bb))) 1) maximum-height)))
|
(min (+ (inexact->exact (round (bb-bottom bb))) 1) maximum-height)))
|
||||||
(define bdc (make-object bitmap-dc% cached-bitmap))
|
(define bdc (make-object bitmap-dc% cached-bitmap))
|
||||||
(send bdc erase)
|
(send bdc erase)
|
||||||
|
@ -432,10 +437,13 @@ has been moved out).
|
||||||
(set-snipclass snip-class)))
|
(set-snipclass snip-class)))
|
||||||
|
|
||||||
(define (same-bb? bb1 bb2)
|
(define (same-bb? bb1 bb2)
|
||||||
(and (= (round (bb-right bb1)) (round (bb-right bb2)))
|
(and (same-width/height? bb1 bb2)
|
||||||
(= (round (bb-bottom bb1)) (round (bb-bottom bb2)))
|
|
||||||
(= (round (bb-baseline bb1)) (round (bb-baseline bb2)))))
|
(= (round (bb-baseline bb1)) (round (bb-baseline bb2)))))
|
||||||
|
|
||||||
|
(define (same-width/height? bb1 bb2)
|
||||||
|
(and (= (round (bb-right bb1)) (round (bb-right bb2)))
|
||||||
|
(= (round (bb-bottom bb1)) (round (bb-bottom bb2)))))
|
||||||
|
|
||||||
(define racket/base:read read)
|
(define racket/base:read read)
|
||||||
(define image-snipclass%
|
(define image-snipclass%
|
||||||
(class snip-class%
|
(class snip-class%
|
||||||
|
@ -500,10 +508,10 @@ has been moved out).
|
||||||
[(and (eq? tag 'struct:bitmap)
|
[(and (eq? tag 'struct:bitmap)
|
||||||
(= arg-count 6))
|
(= arg-count 6))
|
||||||
;; we changed the arity of the bitmap constructor from old versions,
|
;; we changed the arity of the bitmap constructor from old versions,
|
||||||
;; so fix it up here.
|
;; so fix it up here. it used to have these fields:
|
||||||
;; it used to have these fields: (raw-bitmap raw-mask angle x-scale y-scale cache)
|
;; (raw-bitmap raw-mask angle x-scale y-scale cache)
|
||||||
;; and the mask field was dropped in favor of always having an alpha bitmap in the
|
;; and the mask field was dropped in favor of always having an alpha bitmap in
|
||||||
;; raw-bitmap field. The bytes that were written out always had the mask
|
;; the raw-bitmap field. The bytes that were written out always had the mask
|
||||||
;; factored in, tho (which led to a bug) so we can just ignore the mask here
|
;; factored in, tho (which led to a bug) so we can just ignore the mask here
|
||||||
(make-ibitmap (list-ref parsed-args 0)
|
(make-ibitmap (list-ref parsed-args 0)
|
||||||
(list-ref parsed-args 2)
|
(list-ref parsed-args 2)
|
||||||
|
|
|
@ -236,17 +236,8 @@ Unlike @racket[scene+curve], if the line passes outside of @racket[image], the i
|
||||||
(rectangle 10 10 "solid" "red")))]
|
(rectangle 10 10 "solid" "red")))]
|
||||||
|
|
||||||
|
|
||||||
In most cases, combining an image with @racket[empty-image] produces the
|
Combining an image with @racket[empty-image] produces the
|
||||||
original image (as shown in the above example). In some situations,
|
original image (as shown in the above example).
|
||||||
however, the combination can cause the resulting pict to have a different
|
|
||||||
baseline (see @racket[image-baseline]) and thus not
|
|
||||||
be equal.
|
|
||||||
|
|
||||||
@image-examples[(image-baseline (above (text "Hello" 24 "olive") empty-image))
|
|
||||||
(image-baseline (text "Hello" 24 "olive"))
|
|
||||||
(equal? (above (text "Hello" 24 "olive") empty-image)
|
|
||||||
(text "Hello" 24 "olive"))]
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
@section{Polygons}
|
@section{Polygons}
|
||||||
|
@ -584,8 +575,8 @@ and the left and right are @racket[(- 180 angle)].
|
||||||
Constructs an arbitrary regular star polygon (a generalization of the regular polygons).
|
Constructs an arbitrary regular star polygon (a generalization of the regular polygons).
|
||||||
The polygon is enclosed by a regular polygon with @racket[side-count] sides each
|
The polygon is enclosed by a regular polygon with @racket[side-count] sides each
|
||||||
@racket[side-length] long. The polygon is actually constructed by going from vertex to
|
@racket[side-length] long. The polygon is actually constructed by going from vertex to
|
||||||
vertex around the regular polgon, but connecting every @racket[step-count]-th vertex
|
vertex around the regular polygon, but connecting every @racket[step-count]-th vertex
|
||||||
(i.e., skipping every @racket[(- step-count 1)] verticies).
|
(i.e., skipping every @racket[(- step-count 1)] vertices).
|
||||||
|
|
||||||
For example, if @racket[side-count] is @racket[5] and @racket[step-count] is @racket[2],
|
For example, if @racket[side-count] is @racket[5] and @racket[step-count] is @racket[2],
|
||||||
then this function produces a shape just like @racket[star].
|
then this function produces a shape just like @racket[star].
|
||||||
|
|
|
@ -310,6 +310,17 @@
|
||||||
=>
|
=>
|
||||||
#f)
|
#f)
|
||||||
|
|
||||||
|
;; make sure equality doesn't compare baselines;
|
||||||
|
;; these two images have different baselines but
|
||||||
|
;; draw the same way (they draw nothing because their
|
||||||
|
;; widths are 0)
|
||||||
|
(test (equal?
|
||||||
|
(crop 0 0 0 1
|
||||||
|
(rectangle 0 0 'solid "red"))
|
||||||
|
(crop 0 0 0 1
|
||||||
|
(rectangle 20 20 'solid "red")))
|
||||||
|
=> #t)
|
||||||
|
|
||||||
;; make sure 'white and black match up with color structs
|
;; make sure 'white and black match up with color structs
|
||||||
(test (rectangle 10 10 'solid (make-color 255 255 255))
|
(test (rectangle 10 10 'solid (make-color 255 255 255))
|
||||||
=>
|
=>
|
||||||
|
|
Loading…
Reference in New Issue
Block a user