Picturing Programs Teachpack
(require picturing-programs) |
1 About This Teachpack
Provides a variety of functions for combining and manipulating images and running interactive animations. It’s intended to be used with the textbook Picturing Programs.
2 Installation
This package should be bundled with DrRacket version 5.1 and later, so there should be no installation procedure.
3 Functions from 2htdp/image and 2htdp/universe
This package includes all of the image teachpack and and the universe teachpack, so if you’re using this teachpack, don’t also load either of those. See the above links for how to use those teachpacks.
It also supersedes the older tiles and sb-world teachpacks, so if you have those, don’t load them either; use this instead.
This package also provides the following additional functions:
4 Animation support
Since the Picturing Programs textbook introduces animations with image models before other model types, we provide a draw handler for the simple case in which the model is exactly what should be displayed in the animation window:
5 New image functions
procedure
(rotate-ccw img) → image?
img : image?
procedure
(rotate-180 img) → image?
img : image?
procedure
img : image? pixels : natural-number/c
procedure
(crop-bottom img pixels) → image?
img : image? pixels : natural-number/c
procedure
img : image? pixels : natural-number/c
procedure
(crop-right img pixels) → image?
img : image? pixels : natural-number/c
procedure
(flip-other img) → image?
img : image?
procedure
(reflect-vert img) → image?
img : image?
procedure
(reflect-horiz img) → image?
img : image?
procedure
(reflect-main-diag img) → image?
img : image?
procedure
(reflect-other-diag img) → image?
img : image?
6 Variables
This teachpack also defines variable names for some of the pictures used in the textbook.
value
value
value
value
value
Note that these seven variable names happen to start with "pic:", to distinguish them from anything you might define that happens to be named "calendar" or "book", but you can name a variable anything you want; in particular, there’s no requirement that your names start with "pic:".
7 Pixel functions
The above functions allow you to operate on a picture as a whole, but sometimes you want to manipulate a picture pixel-by-pixel.
7.1 Colors and pixels
Each pixel of a bitmap image has a color, a built-in structure with four components – red, green, blue, and alpha – each represented by an integer from 0 to 255. Larger alpha values are "more opaque": an image with alpha=255 is completely opaque, and one with alpha=0 is completely transparent.
Even if you’re not trying to get transparency effects, alpha is also used for dithering to smooth out jagged edges. In (circle 50 "solid" "red"), the pixels inside the circle are pure red, with alpha=255; the pixels outside the circle are transparent (alpha=0); and the pixels on the boundary are red with various alpha values (for example, if one quarter of a pixel’s area is inside the mathematical boundary of the circle, that pixel’s alpha value will be 63).
procedure
(get-pixel-color x y pic) → color?
x : natural-number/c y : natural-number/c pic : image?
7.2 Specifying the color of each pixel of an image
procedure
(build-image width height f) → image?
width : natural-number/c height : natural-number/c f : (-> natural-number/c natural-number/c color?)
; fuzz : image -> image (define (fuzz pic) (local [; near-pixel : num(x) num(y) -> color (define (near-pixel x y) (get-pixel-color (+ x -3 (random 7)) (+ y -3 (random 7)) pic))] (build-image (image-width pic) (image-height pic) near-pixel)))
procedure
(build-image/extra width height f extra) → image?
width : natural-number/c height : natural-number/c f : (-> natural-number/c natural-number/c any/c color?) extra : any/c
; near-pixel : number(x) number(y) image -> color (define (near-pixel x y pic) (get-pixel-color (+ x -3 (random 7)) (+ y -3 (random 7)) pic)) ; fuzz : image -> image (define (fuzz pic) (build-image/extra (image-width pic) (image-height pic) near-pixel pic))
procedure
(build4-image width height red-function green-function blue-function alpha-function) → image? width : natural-number/c height : natural-number/c red-function : (-> natural-number/c natural-number/c natural-number/c) green-function : (-> natural-number/c natural-number/c natural-number/c) blue-function : (-> natural-number/c natural-number/c natural-number/c)
alpha-function :
(-> natural-number/c natural-number/c natural-number/c)
procedure
(build3-image width height red-function green-function blue-function) → image? width : natural-number/c height : natural-number/c red-function : (-> natural-number/c natural-number/c natural-number/c) green-function : (-> natural-number/c natural-number/c natural-number/c) blue-function : (-> natural-number/c natural-number/c natural-number/c)
procedure
f : (-> color? color?) img : image? (map-image f img) → image? f : (-> natural-number/c natural-number/c color? color?) img : image?
; lose-red : color -> color (define (lose-red old-color) (make-color 0 (color-green old-color) (color-blue old-color))) (map-image lose-red my-picture)
(define (lose-red-but-not-alpha old-color) (make-color 0 (color-green old-color) (color-blue old-color) (color-alpha old-color)))
; apply-gradient : num(x) num(y) color -> color (define (apply-gradient x y old-color) (make-color (min (* 3 x) 255) (color-green old-color) (color-blue old-color))) (map-image apply-gradient my-picture)
procedure
(map-image/extra f img extra) → image?
f : (-> color? any/c color?) img : image? extra : any/c (map-image/extra f img extra) → image? f : (-> natural-number/c natural-number/c color? any/c color?) img : image? extra : any/c
; clip-color : color number -> color (check-expect (clip-color (make-color 30 60 90) 100) (make-color 30 60 90)) (check-expect (clip-color (make-color 30 60 90) 50) (make-color 30 50 50)) (define (clip-color c limit) (make-color (min limit (color-red c)) (min limit (color-green c)) (min limit (color-blue c)))) ; clip-picture-colors : number(limit) image -> image (define (clip-picture-colors limit pic) (map-image/extra clip-color pic limit))
This clip-picture-colors function clips each of the color components at most to the specified limit.
; new-pixel : number(x) number(y) color height -> color (check-expect (new-pixel 36 100 (make-color 30 60 90) 100) (make-color 30 60 255)) (check-expect (new-pixel 58 40 (make-color 30 60 90) 100) (make-color 30 60 102)) (define (new-pixel x y c h) (make-color (color-red c) (color-green c) (real->int (* 255 (/ y h))))) ; apply-blue-gradient : image -> image (define (apply-blue-gradient pic) (map-image/extra new-pixel pic (image-height pic)))
procedure
(map4-image red-func green-func blue-func alpha-func img) → image? red-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) green-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) blue-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) alpha-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) img : image?
num(x) num(y) num(r) num(g) num(b) num(alpha) -> num
; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num (define (zero x y r g b a) 0) (define (same-g x y r g b a) g) (define (same-b x y r g b a) b) (define (same-alpha x y r g b a) a) (map4-image zero same-g same-b same-alpha my-picture)
; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num (define (3x x y r g b a) (min (* 3 x) 255)) (define (3y x y r g b a) (min (* 3 y) 255)) (define (return-255 x y r g b a) 255) (map4-image 3x zero 3y return-255 my-picture)
procedure
(map3-image red-func green-func blue-func img) → image? red-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) green-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) blue-func : (-> natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c natural-number/c) img : image?
num(x) num(y) num(r) num(g) num(b) -> num
; each function : num(x) num(y) num(r) num(g) num(b) -> num (define (zero x y r g b) 0) (define (same-g x y r g b) g) (define (same-b x y r g b) b) (map3-image zero same-g same-b my-picture)
; each function : num(x) num(y) num(r) num(g) num(b) num(a) -> num (define (3x x y r g b a) (min (* 3 x) 255)) (define (3y x y r g b a) (min (* 3 y) 255)) (map3-image zero 3x 3y my-picture)
procedure
(fold-image f init img) → any/c
f : (-> color? any/c any/c) init : any/c img : image? (fold-image f init img) → any/c f : (-> natural-number/c natural-number/c color? any/c any/c) init : any/c img : image?
; another-white : color number -> number (define (another-white c old-total) (+ old (if (color=? c "white") 1 0))) ; count-white-pixels : image -> number (define (count-white-pixels pic) (fold-image another-white 0 pic))
Note that the accumulator isn’t restricted to be a number: it could be a structure or a list, enabling you to compute the average color, or a histogram of colors, etc.
procedure
(fold-image/extra f init img extra) → any/c
f : (-> color? any/c any/c any/c) init : any/c img : image? extra : any/c (fold-image/extra f init img extra) → any/c f : (-> natural-number/c natural-number/c color? any/c any/c any/c) init : any/c img : image? extra : any/c
; another-of-color : color number color -> number (define (another-of-color c old color-to-count) (+ old (if (color=? c color-to-count) 1 0))) ; count-pixels-of-color : image color -> number (define (count-pixels-of-color pic color-to-count) (fold-image/extra count-pixels-of-color 0 pic))
; bad-gradient : num(x) num(y) -> color (define (bad-gradient x y) (make-color (* 2.5 x) (* 1.6 y) 0)) (build-image 50 30 bad-gradient) ; good-gradient : num(x) num(y) -> color (define (good-gradient x y) (make-color (real->int (* 2.5 x)) (real->int (* 1.6 y)) 0)) (build-image 50 30 good-gradient)
8 Input and Output
This teachpack also provides several functions to help in testing I/O functions (in Advanced Student language; ignore this section if you’re in a Beginner or Intermediate language):
procedure
(with-input-from-string input thunk) → any/c
input : string? thunk : (-> any/c)
procedure
(with-output-to-string thunk) → string?
thunk : (-> any/c)
procedure
(with-input-from-file filename thunk) → any/c
filename : string? thunk : (-> any/c)
procedure
(with-output-to-file filename thunk) → any/c
filename : string? thunk : (-> any/c)
procedure
(with-input-from-url url thunk) → any/c
url : string? thunk : (-> any/c)
procedure
(with-io-strings input thunk) → string?
input : string? thunk : (-> any/c)
; ask : string -> prints output, waits for text input, returns it (define (ask question) (begin (display question) (read))) ; greet : nothing -> prints output, waits for text input, prints output (define (greet) (local [(define name (ask "What is your name?"))] (printf "Hello, ~a!" name))) (check-expect (with-io-strings "Steve" greet) "What is your name?Hello, Steve!")