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

added zero size rectangles, ellipses, circles, and strings

Browse Source 
svn: r10610
This commit is contained in:
Robby Findler 2008-07-05 01:58:36 +00:00
parent 39f14130e9
commit 7be05fcf8b
5 changed files with 209 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
collects/htdp/image.ss
View File

@ -391,48 +391,53 @@ plt/collects/tests/mzscheme/htdp-image.ss
y2)))))) y2))))))
(define (text str size color-in) (define (text str size color-in)
(check 'text (lambda (x) (and (string? x) (not (equal? "" x)))) str "non-empty string" "first") (check 'text string? str "string" "first")
(check 'text (lambda (x) (and (integer? x) (<= 1 x 255))) size "integer between 1 and 255" "second") (check 'text (lambda (x) (and (integer? x) (<= 1 x 255))) size "integer between 1 and 255" "second")
(check-image-color 'text color-in "third") (check-image-color 'text color-in "third")
(let ([color (make-color% color-in)]) (cond
(let-values ([(tw th) (get-text-size size str)]) [(string=? str "")
(let ([draw-proc (let-values ([(tw th) (get-text-size size "dummyX")])
(lambda (txt-color mode dc dx dy) (rectangle 0 th 'solid 'black))]
(let ([old-mode (send dc get-text-mode)] [else
[old-fore (send dc get-text-foreground)] (let ([color (make-color% color-in)])
[old-font (send dc get-font)]) (let-values ([(tw th) (get-text-size size str)])
(send dc set-text-mode mode) (let ([draw-proc
(send dc set-text-foreground txt-color) (lambda (txt-color mode dc dx dy)
(send dc set-font (get-font size)) (let ([old-mode (send dc get-text-mode)]
(send dc draw-text str dx dy) [old-fore (send dc get-text-foreground)]
(send dc set-text-mode old-mode) [old-font (send dc get-font)])
(send dc set-text-foreground old-fore) (send dc set-text-mode mode)
(send dc set-font old-font)))]) (send dc set-text-foreground txt-color)
(new cache-image-snip% (send dc set-font (get-font size))
[dc-proc (lambda (dc dx dy) (draw-proc color 'transparent dc dx dy))] (send dc draw-text str dx dy)
[argb-proc (send dc set-text-mode old-mode)
(lambda (argb dx dy) (send dc set-text-foreground old-fore)
(let ([bm-color (send dc set-font old-font)))])
(build-bitmap (new cache-image-snip%
(lambda (dc) [dc-proc (lambda (dc dx dy) (draw-proc color 'transparent dc dx dy))]
(send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent)) [argb-proc
(send dc set-brush (send the-brush-list find-or-create-brush color 'solid)) (lambda (argb dx dy)
(send dc draw-rectangle 0 0 tw th)) (let ([bm-color
tw (build-bitmap
th)] (lambda (dc)
[bm-mask (send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
(build-bitmap (send dc set-brush (send the-brush-list find-or-create-brush color 'solid))
(lambda (dc) (send dc draw-rectangle 0 0 tw th))
(draw-proc tw
(send the-color-database find-color "black") th)]
'solid dc 0 0)) [bm-mask
tw (build-bitmap
th)]) (lambda (dc)
(overlay-bitmap argb dx dy bm-color bm-mask)))] (draw-proc
[width tw] (send the-color-database find-color "black")
[height th] 'solid dc 0 0))
[px 0] tw
[py 0]))))) th)])
(overlay-bitmap argb dx dy bm-color bm-mask)))]
[width tw]
[height th]
[px 0]
[py 0]))))]))
(define cached-bdc-for-text-size (make-thread-cell #f)) (define cached-bdc-for-text-size (make-thread-cell #f))
(define (get-text-size size string) (define (get-text-size size string)
@ -452,41 +457,37 @@ plt/collects/tests/mzscheme/htdp-image.ss
[(macosx) 'partly-smoothed] [(macosx) 'partly-smoothed]
[else 'smoothed]))) [else 'smoothed])))
(define (a-rect/circ who do-draw w h color brush pen) (define (a-rect/circ do-draw w h color brush pen)
(check-sizes who w h)
(let* ([dc-proc (make-color-wrapper color brush pen do-draw)] (let* ([dc-proc (make-color-wrapper color brush pen do-draw)]
[mask-proc (make-color-wrapper 'black brush pen do-draw)]) [mask-proc (make-color-wrapper 'black brush pen do-draw)])
(make-simple-cache-image-snip w h (floor (/ w 2)) (floor (/ h 2)) dc-proc mask-proc))) (make-simple-cache-image-snip w h (floor (/ w 2)) (floor (/ h 2)) dc-proc mask-proc)))
(define (rectangle in-w in-h mode color) (define (rectangle in-w in-h mode color)
(check-size 'rectangle in-w "first") (check-size/0 'rectangle in-w "first")
(check-size 'rectangle in-h "second") (check-size/0 'rectangle in-h "second")
(check-mode 'rectangle mode "third") (check-mode 'rectangle mode "third")
(check-image-color 'rectangle color "fourth") (check-image-color 'rectangle color "fourth")
(let ([w (inexact->exact (floor in-w))] (let ([w (inexact->exact (floor in-w))]
[h (inexact->exact (floor in-h))]) [h (inexact->exact (floor in-h))])
(a-rect/circ 'rectangle (a-rect/circ (lambda (dc dx dy) (send dc draw-rectangle dx dy w h))
(lambda (dc dx dy) (send dc draw-rectangle dx dy w h))
w h color (mode->brush-symbol mode) (mode->pen-symbol mode)))) w h color (mode->brush-symbol mode) (mode->pen-symbol mode))))
(define (ellipse in-w in-h mode color) (define (ellipse in-w in-h mode color)
(check-size 'ellipse in-w "first") (check-size/0 'ellipse in-w "first")
(check-size 'ellipse in-h "second") (check-size/0 'ellipse in-h "second")
(check-mode 'ellipse mode "third") (check-mode 'ellipse mode "third")
(check-image-color 'ellipse color "fourth") (check-image-color 'ellipse color "fourth")
(let ([w (inexact->exact (floor in-w))] (let ([w (inexact->exact (floor in-w))]
[h (inexact->exact (floor in-h))]) [h (inexact->exact (floor in-h))])
(a-rect/circ 'ellipse (a-rect/circ (lambda (dc dx dy) (send dc draw-ellipse dx dy w h))
(lambda (dc dx dy) (send dc draw-ellipse dx dy w h))
w h color (mode->brush-symbol mode) (mode->pen-symbol mode)))) w h color (mode->brush-symbol mode) (mode->pen-symbol mode))))
(define (circle in-r mode color) (define (circle in-r mode color)
(check-size 'circle in-r "first") (check-size/0 'circle in-r "first")
(check-mode 'circle mode "second") (check-mode 'circle mode "second")
(check-image-color 'circle color "third") (check-image-color 'circle color "third")
(let ([r (inexact->exact (floor in-r))]) (let ([r (inexact->exact (floor in-r))])
(a-rect/circ 'circle (a-rect/circ (lambda (dc dx dy) (send dc draw-ellipse dx dy (* 2 r) (* 2 r)))
(lambda (dc dx dy) (send dc draw-ellipse dx dy (* 2 r) (* 2 r)))
(* 2 r) (* 2 r) color (mode->brush-symbol mode) (mode->pen-symbol mode)))) (* 2 r) (* 2 r) color (mode->brush-symbol mode) (mode->pen-symbol mode))))
(define (triangle in-size mode color) (define (triangle in-size mode color)
@ -629,10 +630,12 @@ plt/collects/tests/mzscheme/htdp-image.ss
(let ([w (inexact->exact (ceiling w))] (let ([w (inexact->exact (ceiling w))]
[h (inexact->exact (ceiling h))]) [h (inexact->exact (ceiling h))])
(let ([argb-proc (let ([argb-proc
(lambda (argb-vector dx dy) (if (or (zero? w) (zero? h))
(let ([c-bm (build-bitmap (lambda (dc) (dc-proc dc 0 0)) w h)] void
[m-bm (build-bitmap (lambda (dc) (mask-proc dc 0 0)) w h)]) (lambda (argb-vector dx dy)
(overlay-bitmap argb-vector dx dy c-bm m-bm)))]) (let ([c-bm (build-bitmap (lambda (dc) (dc-proc dc 0 0)) w h)]
[m-bm (build-bitmap (lambda (dc) (mask-proc dc 0 0)) w h)])
(overlay-bitmap argb-vector dx dy c-bm m-bm))))])
(new cache-image-snip% (new cache-image-snip%
[dc-proc dc-proc] [dc-proc dc-proc]
[argb-proc argb-proc] [argb-proc argb-proc]
@ -986,7 +989,7 @@ converting from the computer's coordinates, we get:
"given width times given height is ~a, but the given color list has ~a items" "given width times given height is ~a, but the given color list has ~a items"
(* w h) (length cl))) (* w h) (length cl)))
(let ([index-list (alpha-colors->ent-list cl)]) (let ([index-list (alpha-colors->ent-list cl)])
(argb->cache-image-snip (make-argb (list->vector index-list) w) px py)))) (argb->cache-image-snip (make-argb (list->vector index-list) w h) px py))))
;; alpha-colors->ent-list : (listof alpha-color) -> (listof number) ;; alpha-colors->ent-list : (listof alpha-color) -> (listof number)
(define (alpha-colors->ent-list cl) (define (alpha-colors->ent-list cl)

136
collects/mrlib/cache-image-snip.ss
View File

@ -9,8 +9,8 @@
cache-image-snip-class% cache-image-snip-class%
snip-class) snip-class)
;; type argb = (make-argb (vectorof rational[between 0 & 255]) int) ;; type argb = (make-argb (vectorof rational[between 0 & 255]) int int)
(define-struct argb (vector width)) (define-struct argb (vector width height))
#| #|
@ -64,7 +64,6 @@
;; argb : (union #f argb) ;; argb : (union #f argb)
(init-field [argb #f]) (init-field [argb #f])
;; bitmap : (union #f (is-a?/c bitmap%)) ;; bitmap : (union #f (is-a?/c bitmap%))
;; the way that this image is be drawn, on its own ;; the way that this image is be drawn, on its own
(define bitmap #f) (define bitmap #f)
@ -79,18 +78,22 @@
(px px) (px px)
(py py))) (py py)))
;; get-bitmap : -> bitmap ;; get-bitmap : -> bitmap or false
;; returns a bitmap showing what the image would look like, ;; returns a bitmap showing what the image would look like,
;; if it were drawn ;; if it were drawn
(define/public (get-bitmap) (define/public (get-bitmap)
(unless bitmap (cond
(set! bitmap (argb->bitmap (get-argb)))) [(or (zero? width) (zero? height))
bitmap) #f]
[else
(unless bitmap
(set! bitmap (argb->bitmap (get-argb))))
bitmap]))
;; get-argb : -> argb ;; get-argb : -> argb
(define/public (get-argb) (define/public (get-argb)
(unless argb (unless argb
(set! argb (make-argb (make-vector (* 4 width height) 255) width)) (set! argb (make-argb (make-vector (* 4 width height) 255) width height))
(argb-proc argb 0 0)) (argb-proc argb 0 0))
argb) argb)
@ -108,10 +111,12 @@
(define/override (draw dc x y left top right bottom dx dy draw-caret) (define/override (draw dc x y left top right bottom dx dy draw-caret)
(cond (cond
[argb (let ([bitmap (get-bitmap)]) [argb
(send dc draw-bitmap bitmap x y 'solid (let ([bitmap (get-bitmap)])
(send the-color-database find-color "black") (when bitmap
(send bitmap get-loaded-mask)))] (send dc draw-bitmap bitmap x y 'solid
(send the-color-database find-color "black")
(send bitmap get-loaded-mask))))]
[dc-proc [dc-proc
(let ([smoothing (send dc get-smoothing)]) (let ([smoothing (send dc get-smoothing)])
(send dc set-smoothing 'aligned) (send dc set-smoothing 'aligned)
@ -124,6 +129,7 @@
(format "~s" (format "~s"
(list (argb-vector (get-argb)) (list (argb-vector (get-argb))
width width
height
px px
py)))]) py)))])
(send f put str))) (send f put str)))
@ -146,11 +152,31 @@
(define/override (read f) (define/override (read f)
(data->snip (read-from-string (send f get-bytes) (lambda () #f)))) (data->snip (read-from-string (send f get-bytes) (lambda () #f))))
(define/public (data->snip data) (define/public (data->snip data)
(if data (cond
(argb->cache-image-snip (make-argb (first data) (second data)) [(not (list? data)) (make-null-cache-image-snip)]
(third data) [(= (length data 4))
(fourth data)) ;; this is the case for old save files
(make-null-cache-image-snip))) ;; if the width is zero, the height
;; will automatically also be zero
(let ([argb-vec (list-ref data 0)]
[width (list-ref data 1)]
[px (list-ref data 2)]
[py (list-ref data 3)])
(argb->cache-image-snip (make-argb argb-vec
width
(if (zero? width)
0
(/ (vector-length argb-vec) width 4)))
px
py))]
[(= (length data) 5)
;; this is the new saved data and it has the width and the height separately.
(let ([argb-vec (list-ref data 0)]
[width (list-ref data 1)]
[height (list-ref data 2)]
[px (list-ref data 3)]
[py (list-ref data 4)])
(argb->cache-image-snip (make-argb argb-vec width height) px py))]))
(super-new))) (super-new)))
(define snip-class (new cache-image-snip-class%)) (define snip-class (new cache-image-snip-class%))
@ -236,8 +262,8 @@
;; argb->cache-image-snip : argb number number -> cache-image-snip ;; argb->cache-image-snip : argb number number -> cache-image-snip
(define (argb->cache-image-snip argb px py) (define (argb->cache-image-snip argb px py)
(let* ([width (argb-width argb)] (let* ([width (argb-width argb)]
[height (argb-height argb)]
[argb-vector (argb-vector argb)] [argb-vector (argb-vector argb)]
[height (quotient (vector-length argb-vector) (* 4 width))]
[bitmap (argb->bitmap argb)] [bitmap (argb->bitmap argb)]
[mask (send bitmap get-loaded-mask)]) [mask (send bitmap get-loaded-mask)])
(new cache-image-snip% (new cache-image-snip%
@ -246,42 +272,47 @@
(argb argb) (argb argb)
(px px) (px px)
(py py) (py py)
(argb-proc (argb-proc (if (or (zero? width) (zero? height))
(lambda (argb dx dy) void
(overlay-bitmap argb dx dy bitmap mask))) (lambda (argb dx dy) (overlay-bitmap argb dx dy bitmap mask))))
(dc-proc (lambda (dc dx dy) (dc-proc (if (or (zero? width) (zero? height))
(send dc draw-bitmap bitmap dx dy 'solid void
(send the-color-database find-color "black") (lambda (dc dx dy)
mask)))))) (send dc draw-bitmap bitmap dx dy 'solid
(send the-color-database find-color "black")
mask)))))))
;; argb-vector->bitmap : argb -> bitmap ;; argb-vector->bitmap : argb -> bitmap or false
;; flattens the argb vector into a bitmap ;; flattens the argb vector into a bitmap
(define (argb->bitmap argb) (define (argb->bitmap argb)
(let* ([argb-vector (argb-vector argb)] (let* ([argb-vector (argb-vector argb)]
[w (argb-width argb)] [w (argb-width argb)]
[h (quotient (vector-length argb-vector) (* w 4))] [h (argb-height argb)])
[bm (make-object bitmap% w h)] (cond
[mask-bm (make-object bitmap% w h)] [(or (zero? w) (zero? h)) #f]
[bdc (new bitmap-dc% (bitmap bm))] [else
[bytes (make-bytes (vector-length argb-vector) 255)] (let* ([bm (make-object bitmap% w h)]
[mask-bytes (make-bytes (vector-length argb-vector) 255)]) [mask-bm (make-object bitmap% w h)]
(let loop ([i (- (vector-length argb-vector) 1)]) [bdc (new bitmap-dc% (bitmap bm))]
(cond [bytes (make-bytes (vector-length argb-vector) 255)]
[(zero? (modulo i 4)) [mask-bytes (make-bytes (vector-length argb-vector) 255)])
(let ([av (round (vector-ref argb-vector i))]) (let loop ([i (- (vector-length argb-vector) 1)])
(bytes-set! mask-bytes (+ i 1) av) (cond
(bytes-set! mask-bytes (+ i 2) av) [(zero? (modulo i 4))
(bytes-set! mask-bytes (+ i 3) av))] (let ([av (round (vector-ref argb-vector i))])
[else (bytes-set! mask-bytes (+ i 1) av)
(bytes-set! bytes i (round (vector-ref argb-vector i)))]) (bytes-set! mask-bytes (+ i 2) av)
(unless (zero? i) (bytes-set! mask-bytes (+ i 3) av))]
(loop (- i 1)))) [else
(send bdc set-argb-pixels 0 0 w h bytes) (bytes-set! bytes i (round (vector-ref argb-vector i)))])
(send bdc set-bitmap mask-bm) (unless (zero? i)
(send bdc set-argb-pixels 0 0 w h mask-bytes) (loop (- i 1))))
(send bdc set-bitmap #f) (send bdc set-argb-pixels 0 0 w h bytes)
(send bm set-loaded-mask mask-bm) (send bdc set-bitmap mask-bm)
bm)) (send bdc set-argb-pixels 0 0 w h mask-bytes)
(send bdc set-bitmap #f)
(send bm set-loaded-mask mask-bm)
bm)])))
;; overlay-bitmap : argb int int bitmap bitmap -> void ;; overlay-bitmap : argb int int bitmap bitmap -> void
;; assumes that the mask bitmap only has greyscale in it ;; assumes that the mask bitmap only has greyscale in it
@ -656,9 +687,10 @@ for b3, we have:
[flatten-bitmap ((is-a?/c bitmap%) . -> . (is-a?/c bitmap%))] [flatten-bitmap ((is-a?/c bitmap%) . -> . (is-a?/c bitmap%))]
[argb->cache-image-snip (argb? number? number? . -> . (is-a?/c cache-image-snip%))] [argb->cache-image-snip (argb? number? number? . -> . (is-a?/c cache-image-snip%))]
[argb->bitmap (argb? . -> . (is-a?/c bitmap%))] [argb->bitmap (argb? . -> . (or/c false/c (is-a?/c bitmap%)))]
[argb? (any/c . -> . boolean?)] [argb? (any/c . -> . boolean?)]
[make-argb ((vectorof (integer-in 0 255)) integer? . -> . argb?)] [make-argb ((vectorof (integer-in 0 255)) exact-nonnegative-integer? exact-nonnegative-integer? . -> . argb?)]
[argb-vector (argb? . -> . (vectorof (integer-in 0 255)))] [argb-vector (argb? . -> . (vectorof (integer-in 0 255)))]
[argb-width (argb? . -> . integer?)])) [argb-width (argb? . -> . exact-nonnegative-integer?)]
[argb-height (argb? . -> . exact-nonnegative-integer?)]))

22
collects/mrlib/scribblings/cache-image-snip.scrbl
View File

@ -44,13 +44,13 @@ predicate.
} }
@defmethod[(get-bitmap) @defmethod[(get-bitmap) (or/c false/c (is-a?/c bitmap%))]{
(is-a?/c bitmap%)]{
Builds (if not yet built) a bitmap corresponding to Builds (if not yet built) a bitmap corresponding to
this snip and returns it. this snip and returns it.
If the width or the height of the snip is @scheme[0],
this method return @scheme[#f].
} }
@defmethod[(get-dc-proc) @defmethod[(get-dc-proc)
@ -83,7 +83,9 @@ predicate.
This snipclass is used for saved cache image snips.} This snipclass is used for saved cache image snips.}
@defproc[(make-argb [vectorof (integer-in 0 255)] [width exact-nonnegative-integer?]) @defproc[(make-argb [vectorof (integer-in 0 255)]
[width exact-nonnegative-integer?]
[height exact-nonnegative-integer?])
argb?]{ argb?]{
Constructs a new argb value. The vector has four entries Constructs a new argb value. The vector has four entries
@ -99,6 +101,10 @@ This snipclass is used for saved cache image snips.}
Extracts the width from @scheme[argb].} Extracts the width from @scheme[argb].}
@defproc[(argb-height [argb argb?]) exact-nonnegative-integer?]{
Extracts the height from @scheme[argb].}
@defproc[(argb? [v any/c]) boolean?]{ @defproc[(argb? [v any/c]) boolean?]{
@ -142,9 +148,13 @@ procedure @scheme[draw] to render the bitmap content into the given
@scheme[argb], using @scheme[dx] and @scheme[dy] as the pinhole.} @scheme[argb], using @scheme[dx] and @scheme[dy] as the pinhole.}
@defproc[(argb->bitmap [argb argb?]) (is-a?/c bitmap%)]{ @defproc[(argb->bitmap [argb argb?]) (or/c false/c (is-a?/c bitmap%))]{
Builds a bitmap that draws the same way as @scheme[argb]; the alpha Builds a bitmap that draws the same way as @scheme[argb]; the alpha
pixels are put into the bitmap's @method[bitmap% get-loaded-mask] pixels are put into the bitmap's @method[bitmap% get-loaded-mask]
bitmap.} bitmap.
If the width or height of @scheme[argb] is @scheme[0],
this returns @scheme[#f].
}

6
collects/teachpack/htdp/scribblings/image.scrbl
View File

@ -91,11 +91,9 @@ angle.
See @scheme[add-line] below. See @scheme[add-line] below.
} }
@defproc[(text [s (and/c string? (lambda (s) (not (string=? s ""))))] [f (and/c number? positive?)] [c (unsyntax @tech{Color})]) Image]{ @defproc[(text [s string?] [f (and/c number? positive?)] [c (unsyntax @tech{Color})]) Image]{
Creates an image of the text @scheme[s] at point size @scheme[f] Creates an image of the text @scheme[s] at point size @scheme[f]
and painted in color @scheme[c]. and painted in color @scheme[c].}
The string @scheme[s] must have at least one character.}
@;----------------------------------------------------------------------------- @;-----------------------------------------------------------------------------
@section[#:tag "properties"]{Basic Image Properties} @section[#:tag "properties"]{Basic Image Properties}

55
collects/tests/mzscheme/htdp-image.ss
View File

@ -49,10 +49,15 @@
(let ([bdc (make-object bitmap-dc%)] (let ([bdc (make-object bitmap-dc%)]
[max-difference [max-difference
(lambda (s1 s2) (lambda (s1 s2)
(apply max (cond
(map (lambda (x y) (abs (- x y))) [(and (zero? (bytes-length s1))
(bytes->list s1) (zero? (bytes-length s2)))
(bytes->list s1))))]) 0]
[else
(apply max
(map (lambda (x y) (abs (- x y)))
(bytes->list s1)
(bytes->list s1)))]))])
;; test that no drawing is outside the snip's drawing claimed drawing area ;; test that no drawing is outside the snip's drawing claimed drawing area
(let* ([extra-space 100] (let* ([extra-space 100]
@ -89,8 +94,8 @@
(test (list 'bmtrunc name #t) (lambda () (list 'bmtrunc name (equal? s-noclip s-trunc))))) (test (list 'bmtrunc name #t) (lambda () (list 'bmtrunc name (equal? s-noclip s-trunc)))))
(let ([bm-normal (make-object bitmap% width height)] (let ([bm-normal (make-object bitmap% (max 1 width) (max 1 height))]
[bm-bitmap (make-object bitmap% width height)] [bm-bitmap (make-object bitmap% (max 1 width) (max 1 height))]
[s-normal (make-bytes (* width height 4))] [s-normal (make-bytes (* width height 4))]
[s-bitmap (make-bytes (* width height 4))]) [s-bitmap (make-bytes (* width height 4))])
@ -393,6 +398,19 @@
1 0 1 0
(p00 (rectangle 1 2 'solid 'blue))))) (p00 (rectangle 1 2 'solid 'blue)))))
(test #t
'image=?-zero1
(image=? (rectangle 0 10 'solid 'red)
(rectangle 0 10 'solid 'red)))
(test #t
'image=?-zero2
(image=? (rectangle 0 10 'solid 'red)
(rectangle 0 10 'solid 'blue)))
(test #f
'image=?-zero3
(image=? (rectangle 0 5 'solid 'red)
(rectangle 0 4'solid 'blue)))
(test #t (test #t
'image-inside?1 'image-inside?1
(image-inside? (overlay/xy (p00 (rectangle 3 2 'solid 'red)) (image-inside? (overlay/xy (p00 (rectangle 3 2 'solid 'red))
@ -485,6 +503,14 @@
'image-height 'image-height
(image-height (rectangle 5 7 'solid 'red))) (image-height (rectangle 5 7 'solid 'red)))
(test 10 image-width (rectangle 10 0 'solid 'red))
(test 0 image-height (rectangle 10 0 'solid 'red))
(test 0 image-width (rectangle 0 10 'solid 'red))
(test 10 image-height (rectangle 0 10 'solid 'red))
(test 0 image-width (text "" 12 'black))
(test #t 'not-zero-empty-string-height (not (zero? (image-height (text "" 12 'black)))))
(test 1 'color-red (color-red (make-color 1 2 3))) (test 1 'color-red (color-red (make-color 1 2 3)))
(test 2 'color-green (color-green (make-color 1 2 3))) (test 2 'color-green (color-green (make-color 1 2 3)))
(test 3 'color-blue (color-blue (make-color 1 2 3))) (test 3 'color-blue (color-blue (make-color 1 2 3)))
@ -797,8 +823,20 @@
(check-on-bitmap 'outline-rect (rectangle 2 2 'outline 'red)) (check-on-bitmap 'outline-rect (rectangle 2 2 'outline 'red))
(check-on-bitmap 'solid-ellipse (ellipse 2 4 'solid 'red)) (check-on-bitmap 'solid-ellipse (ellipse 2 4 'solid 'red))
(check-on-bitmap 'outline-ellipse (ellipse 2 4 'outline 'red)) (check-on-bitmap 'outline-ellipse (ellipse 2 4 'outline 'red))
(check-on-bitmap 'solid-ellipse (circle 4 'solid 'red)) (check-on-bitmap 'solid-circle (circle 4 'solid 'red))
(check-on-bitmap 'outline-ellipse (circle 4 'outline 'red)) (check-on-bitmap 'outline-circle (circle 4 'outline 'red))
(check-on-bitmap '0solid-rect1 (rectangle 0 2 'solid 'red))
(check-on-bitmap '0solid-rect2 (rectangle 2 0 'solid 'red))
(check-on-bitmap '0outline-rect1 (rectangle 2 0 'outline 'red))
(check-on-bitmap '0outline-rect2 (rectangle 0 0 'outline 'red))
(check-on-bitmap '0solid-ellipse1 (ellipse 0 3 'solid 'red))
(check-on-bitmap '0solid-ellipse2 (ellipse 3 0 'solid 'red))
(check-on-bitmap '0outline-ellipse1 (ellipse 0 4 'outline 'red))
(check-on-bitmap '0outline-ellipse2 (ellipse 2 0 'outline 'red))
(check-on-bitmap '0solid-circle (circle 0 'solid 'red))
(check-on-bitmap '0outline-circle (circle 0 'outline 'red))
(check-on-bitmap 'solid-triangle (triangle 10 'solid 'red)) (check-on-bitmap 'solid-triangle (triangle 10 'solid 'red))
(check-on-bitmap 'outline-triangle (triangle 10 'outline 'red)) (check-on-bitmap 'outline-triangle (triangle 10 'outline 'red))
(check-on-bitmap 'solid-star (star 4 10 20 'solid 'red)) (check-on-bitmap 'solid-star (star 4 10 20 'solid 'red))
@ -1158,7 +1196,6 @@
(err/rt-name-test (add-line image-snip1 10 10 #f #f #f) "fourth") (err/rt-name-test (add-line image-snip1 10 10 #f #f #f) "fourth")
(err/rt-name-test (add-line image-snip1 10 10 11 #f #f) "fifth") (err/rt-name-test (add-line image-snip1 10 10 11 #f #f) "fifth")
(err/rt-name-test (add-line image-snip1 10 10 11 11 #f) "sixth") (err/rt-name-test (add-line image-snip1 10 10 11 11 #f) "sixth")
(err/rt-name-test (text "" 12 'red) "first")
(err/rt-name-test (text #f #f #f) "first") (err/rt-name-test (text #f #f #f) "first")
(err/rt-name-test (text "abc" #f #f) "second") (err/rt-name-test (text "abc" #f #f) "second")
(err/rt-name-test (text "abc" 10 #f) "third") (err/rt-name-test (text "abc" 10 #f) "third")