1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #reader(lib "htdp-intermediate-reader.ss" "lang")((modname |21.4|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp")))))
5 12687dd9 2023-08-04 jrmu (define-struct circle (center radius color))
7 12687dd9 2023-08-04 jrmu ;A circle is a structure
8 12687dd9 2023-08-04 jrmu ;(make-circle ce ra co)
9 12687dd9 2023-08-04 jrmu ;where ce is a posn, ra is a number, and co is a symbol.
11 12687dd9 2023-08-04 jrmu ;draw-a-circle : circle -> boolean
12 12687dd9 2023-08-04 jrmu ;Given a-circle, draw it and return true.
14 12687dd9 2023-08-04 jrmu (define (draw-a-circle a-circle)
15 12687dd9 2023-08-04 jrmu (draw-solid-disk (circle-center a-circle)
16 12687dd9 2023-08-04 jrmu (circle-radius a-circle)
17 12687dd9 2023-08-04 jrmu (circle-color a-circle)))
19 12687dd9 2023-08-04 jrmu ;clear-a-circle : circle -> boolean
20 12687dd9 2023-08-04 jrmu ;Given a-circle, clear it and return true.
22 12687dd9 2023-08-04 jrmu (define (clear-a-circle a-circle)
23 12687dd9 2023-08-04 jrmu (clear-solid-disk (circle-center a-circle)
24 12687dd9 2023-08-04 jrmu (circle-radius a-circle)
25 12687dd9 2023-08-04 jrmu (circle-color a-circle)))
27 12687dd9 2023-08-04 jrmu ;process-circle : (circle -> X) circle -> X
28 12687dd9 2023-08-04 jrmu ;Given operation and a-circle, process the circle according to operation (draw-solid-disk or clear-solid-disk).
30 12687dd9 2023-08-04 jrmu (define (process-circle operation a-circle)
31 12687dd9 2023-08-04 jrmu (operation (circle-center a-circle)
32 12687dd9 2023-08-04 jrmu (circle-radius a-circle)
33 12687dd9 2023-08-04 jrmu (circle-color a-circle)))
35 12687dd9 2023-08-04 jrmu ;draw-a-circle : circle -> boolean
36 12687dd9 2023-08-04 jrmu ;Given a-circle, draw it and return true.
38 12687dd9 2023-08-04 jrmu (define (draw-a-circle a-circle)
39 12687dd9 2023-08-04 jrmu (process-circle draw-solid-disk a-circle))
41 12687dd9 2023-08-04 jrmu ;clear-a-circle : circle -> boolean
42 12687dd9 2023-08-04 jrmu ;Given a-circle, clear it and return true.
44 12687dd9 2023-08-04 jrmu (define (clear-a-circle a-circle)
45 12687dd9 2023-08-04 jrmu (process-circle clear-solid-disk a-circle))
47 12687dd9 2023-08-04 jrmu ;Exercise 21.4.1. Abstract the functions draw-a-circle and clear-a-circle into a single function process-circle.
49 12687dd9 2023-08-04 jrmu ;Define translate-circle using process-circle. Hint: If a primitive function doesn't quite fit an abstraction, we have to define auxiliary functions. For now, use define to do so. Intermezzo 4 introduces a handy and important short-hand for that purpose. Solution
51 12687dd9 2023-08-04 jrmu ;translate-circle : circle number -> circle
52 12687dd9 2023-08-04 jrmu ;Given a-circle and delta, return a circle structure moved delta to the right.
54 12687dd9 2023-08-04 jrmu ;translate-delta : posn number symbol -> circle
55 12687dd9 2023-08-04 jrmu ;Given delta, center, radius, and color, return a circle structure translated delta to the right.
57 12687dd9 2023-08-04 jrmu (define (translate-circle a-circle delta)
58 12687dd9 2023-08-04 jrmu (local ((define (translate-delta center radius color)
59 12687dd9 2023-08-04 jrmu (make-circle (make-posn (+ delta (posn-x center))
60 12687dd9 2023-08-04 jrmu (posn-y center))
63 12687dd9 2023-08-04 jrmu (process-circle translate-delta a-circle)))
65 12687dd9 2023-08-04 jrmu (define-struct rectangle (upper-left width height color))
67 12687dd9 2023-08-04 jrmu ;A rectangle is a structure
68 12687dd9 2023-08-04 jrmu ;(make-rectangle u w h c)
69 12687dd9 2023-08-04 jrmu ;where u is a posn, w, h are numbers, and color is a symbol.
71 12687dd9 2023-08-04 jrmu ;A shape is either
72 12687dd9 2023-08-04 jrmu ;1. a circle or
73 12687dd9 2023-08-04 jrmu ;2. a rectangle.
76 12687dd9 2023-08-04 jrmu Exercise 21.4.2. Abstract the functions draw-a-rectangle and clear-a-rectangle into a single function process-rectangle.
78 12687dd9 2023-08-04 jrmu Define translate-rectangle using process-rectangle. Solution
81 12687dd9 2023-08-04 jrmu ;process-rectangle : (posn number number symbol -> X) rectangle -> X
82 12687dd9 2023-08-04 jrmu ;Perform operation on a-rectangle.
84 12687dd9 2023-08-04 jrmu (define (process-rectangle operation a-rect)
85 12687dd9 2023-08-04 jrmu (operation (rectangle-upper-left a-rect)
86 12687dd9 2023-08-04 jrmu (rectangle-width a-rect)
87 12687dd9 2023-08-04 jrmu (rectangle-height a-rect)
88 12687dd9 2023-08-04 jrmu (rectangle-color a-rect)))
90 12687dd9 2023-08-04 jrmu ;draw-a-rectangle : (posn number number symbol -> boolean) rectangle -> boolean
91 12687dd9 2023-08-04 jrmu (define (draw-a-rectangle a-rect)
92 12687dd9 2023-08-04 jrmu (process-rectangle draw-solid-rect a-rect))
94 12687dd9 2023-08-04 jrmu ;clear-a-rectangle : (posn number number symbol -> boolean) rectangle -> boolean
95 12687dd9 2023-08-04 jrmu (define (clear-a-rectangle a-rect)
96 12687dd9 2023-08-04 jrmu (process-rectangle clear-solid-rect a-rect))
98 12687dd9 2023-08-04 jrmu ;translate-rectangle : (posn number number symbol -> boolean) rectangle number -> rectangle
99 12687dd9 2023-08-04 jrmu ;Given a-rect and delta, return a rectangle structure translated delta to the right.
101 12687dd9 2023-08-04 jrmu (define (translate-rectangle a-rect delta)
102 12687dd9 2023-08-04 jrmu (local ((define (translate-rectangle a-rect)
103 12687dd9 2023-08-04 jrmu (process-rectangle translate-delta a-rect))
104 12687dd9 2023-08-04 jrmu (define (translate-delta upper-left width height color)
105 12687dd9 2023-08-04 jrmu (make-rectangle (make-posn (+ delta (posn-x upper-left))
106 12687dd9 2023-08-04 jrmu (posn-y upper-left))
110 12687dd9 2023-08-04 jrmu (translate-rectangle a-rect)))
112 12687dd9 2023-08-04 jrmu ;process-shape : (posn number symbol -> X) or
113 12687dd9 2023-08-04 jrmu ; (posn number number symbol -> X) shape -> X
114 12687dd9 2023-08-04 jrmu (define (process-shape operation a-shape)
116 12687dd9 2023-08-04 jrmu [(circle? a-shape) (process-circle operation a-shape)]
117 12687dd9 2023-08-04 jrmu [(rectangle? a-shape) (process-rectangle operation a-shape)]))
119 12687dd9 2023-08-04 jrmu (define (draw-shape a-shape)
121 12687dd9 2023-08-04 jrmu [(circle? a-shape) (process-shape draw-solid-disk a-shape)]
122 12687dd9 2023-08-04 jrmu [(rectangle? a-shape) (process-shape draw-solid-rect a-shape)]))
