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

2htdp/image: added support for alpha as a mode? argument

Browse Source
This commit is contained in:
Robby Findler 2011-01-01 20:01:50 -06:00
parent 19b1df6586
commit 7716851cde
4 changed files with 80 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/2htdp/private/img-err.rkt
View File

@ -130,9 +130,16 @@
'mode
i
arg)
(if (string? arg)
(string->symbol arg)
arg)]
(cond
[(or (equal? arg "solid")
(equal? arg 'solid))
255]
[(equal? arg "outline")
'outline]
[(and (integer? arg)
(not (exact? arg)))
(inexact->exact arg)]
[else arg])]
[(width height radius radius1 radius2 side-length side-length1 side-length2
side-a side-b side-c)
(check-arg fn-name
@ -278,7 +285,9 @@
(define (x-place? arg)
(member arg '("left" left "right" right "middle" middle "center" center "pinhole" pinhole)))
(define (mode? arg)
(member arg '(solid outline "solid" "outline")))
(or (member arg '(solid outline "solid" "outline"))
(and (integer? arg)
(<= 0 arg 255))))
(define (angle? arg)
(and (real? arg)
(< -360 arg 360)))
@ -307,7 +316,8 @@
;; checks the dependent part of the 'color' specification
(define (check-mode/color-combination fn-name i mode color)
(cond
[(eq? mode 'solid)
[(or (eq? mode 'solid)
(number? mode))
(check-arg fn-name (image-color? color) 'image-color i color)]
[(eq? mode 'outline)
(void)]))

22
collects/2htdp/tests/test-image.rkt
View File

@ -688,7 +688,7 @@
(test (normalize-shape (image-shape (ellipse 50 100 'solid 'red)))
=>
(make-translate 25 50 (make-ellipse 50 100 0 'solid "red")))
(make-translate 25 50 (make-ellipse 50 100 0 255 "red")))
(test (normalize-shape (make-overlay (image-shape (ellipse 50 100 'solid 'red))
(image-shape (ellipse 50 100 'solid 'blue))))
@ -702,9 +702,9 @@
(image-shape (ellipse 50 100 'solid 'green))))
=>
(make-overlay
(make-overlay (make-translate 25 50 (make-ellipse 50 100 0 'solid "red"))
(make-translate 25 50 (make-ellipse 50 100 0 'solid "blue")))
(make-translate 25 50 (make-ellipse 50 100 0 'solid "green"))))
(make-overlay (make-translate 25 50 (make-ellipse 50 100 0 255 "red"))
(make-translate 25 50 (make-ellipse 50 100 0 255 "blue")))
(make-translate 25 50 (make-ellipse 50 100 0 255 "green"))))
(test (normalize-shape (make-overlay
(image-shape (ellipse 50 100 'solid 'green))
@ -712,17 +712,17 @@
(image-shape (ellipse 50 100 'solid 'blue)))))
=>
(make-overlay
(make-overlay (make-translate 25 50 (make-ellipse 50 100 0 'solid "green"))
(make-translate 25 50 (make-ellipse 50 100 0 'solid "red")))
(make-translate 25 50 (make-ellipse 50 100 0 'solid "blue"))))
(make-overlay (make-translate 25 50 (make-ellipse 50 100 0 255 "green"))
(make-translate 25 50 (make-ellipse 50 100 0 255 "red")))
(make-translate 25 50 (make-ellipse 50 100 0 255 "blue"))))
(test (normalize-shape (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue))))
=>
(make-translate 125 150 (make-ellipse 50 100 0 'solid "blue")))
(make-translate 125 150 (make-ellipse 50 100 0 255 "blue")))
(test (normalize-shape (make-translate 10 20 (make-translate 100 100 (image-shape (ellipse 50 100 'solid 'blue)))))
=>
(make-translate 135 170 (make-ellipse 50 100 0 'solid "blue")))
(make-translate 135 170 (make-ellipse 50 100 0 255 "blue")))
(test (normalize-shape (image-shape
(beside/align 'top
@ -735,7 +735,7 @@
(make-point 10 0)
(make-point 10 10)
(make-point 0 10))
'solid
255
"black")
(make-crop
(list (make-point 10 0)
@ -747,7 +747,7 @@
(make-point 20 0)
(make-point 20 10)
(make-point 10 10))
'solid
255
"green"))))

43
collects/mrlib/image-core.rkt
View File

@ -1042,31 +1042,44 @@ the mask bitmap and the original bitmap are all together in a single bytes!
[else 'smoothed]))
(define (mode-color->pen mode color)
(case mode
[(outline)
(cond
[(eq? mode 'outline)
(cond
[(pen? color)
(pen->pen-obj/cache color)]
[else
(send the-pen-list find-or-create-pen (get-color-arg color) 0 'solid 'round 'miter)])]
[(solid)
[else
(send the-pen-list find-or-create-pen "black" 1 'transparent)]))
(define (mode-color->brush mode color)
(case mode
[(outline)
(cond
[(eq? mode 'outline)
(send the-brush-list find-or-create-brush "black" 'transparent)]
[(solid)
(send the-brush-list find-or-create-brush (get-color-arg color) 'solid)]))
[else
;; this should only be 'solid if we have an old image from a save file somewhere
(define extra-alpha (if (eq? mode 'solid)
255
mode))
(send the-brush-list find-or-create-brush (get-color-arg color extra-alpha) 'solid)]))
(define (get-color-arg color)
(if (string? color)
color
(make-object color%
(color-red color)
(color-green color)
(color-blue color)
(/ (color-alpha color) 255))))
(define (get-color-arg color [extra-alpha 255])
(cond
[(string? color)
(define color-obj (or (send the-color-database find-color color)
(send the-color-database find-color "black")))
(make-object color%
(send color-obj red)
(send color-obj green)
(send color-obj blue)
(/ extra-alpha 255))]
[else
(make-object color%
(color-red color)
(color-green color)
(color-blue color)
(* (/ (color-alpha color) 255)
(/ extra-alpha 255)))]))
(define (pen->pen-obj/cache pen)

32
collects/teachpack/2htdp/scribblings/image.scrbl
View File

@ -53,7 +53,8 @@ Existing images can be rotated, scaled, flipped, and overlaid on top of each oth
@mode/color-text
@image-examples[(circle 30 "outline" "red")
(circle 20 "solid" "blue")]
(circle 20 "solid" "blue")
(circle 20 100 "blue")]
}
@ -71,8 +72,9 @@ Existing images can be rotated, scaled, flipped, and overlaid on top of each oth
@mode/color-text
@image-examples[(ellipse 40 20 "outline" "black")
(ellipse 20 40 "solid" "blue")]
@image-examples[(ellipse 60 30 "outline" "black")
(ellipse 30 60 "solid" "blue")
(ellipse 30 60 100 "blue")]
}
@defproc[(line [x1 real?] [y1 real?] [pen-or-color (or/c pen? image-color?)]) image?]{
@ -702,7 +704,13 @@ the @scheme[point-count] argument determines how many points the star has.
(ellipse 30 40 "solid" "red")
(ellipse 40 30 "solid" "black")
(ellipse 50 20 "solid" "red")
(ellipse 60 10 "solid" "black"))]
(ellipse 60 10 "solid" "black"))
(underlay (ellipse 10 60 40 "red")
(ellipse 20 50 40 "red")
(ellipse 30 40 40 "red")
(ellipse 40 30 40 "red")
(ellipse 50 20 40 "red")
(ellipse 60 10 40 "red"))]
}
@ -719,7 +727,12 @@ the @scheme[point-count] argument determines how many points the star has.
(rectangle 50 50 "solid" "seagreen")
(rectangle 40 40 "solid" "silver")
(rectangle 30 30 "solid" "seagreen")
(rectangle 20 20 "solid" "silver"))]
(rectangle 20 20 "solid" "silver"))
(underlay/align "left" "middle"
(rectangle 50 50 50 "seagreen")
(rectangle 40 40 50 "seagreen")
(rectangle 30 30 50 "seagreen")
(rectangle 20 20 50 "seagreen"))]
}
@ -1195,10 +1208,17 @@ This section lists predicates for the basic structures provided by the image lib
@defproc[(mode? [x any/c]) boolean?]{
Determines if @racket[x] is a mode suitable for
constructing images. It can be one of
constructing images.
It can be one of
@racket['solid], @racket["solid"], @racket['outline],
or @racket["outline"], indicating if the shape is
filled in or not.
It can also be an integer between @racket[0] and @racket[255] (inclusive)
indicating the transparency of the image. The integer @racket[255] is
fully opaque, and is the same as @racket["solid"] (or @racket['solid]).
The integer @racket[0] means fully transparent.
}
@defproc[(image-color? [x any/c]) boolean?]{