1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #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")))))
4 
5 (define-struct circle (center radius color))
6 #|
7 ;A circle is a structure
8 ;(make-circle ce ra co)
9 ;where ce is a posn, ra is a number, and co is a symbol.
10 ;
11 ;draw-a-circle : circle -> boolean
12 ;Given a-circle, draw it and return true.
13 
14 (define (draw-a-circle a-circle)
15   (draw-solid-disk (circle-center a-circle)
16                    (circle-radius a-circle)
17                    (circle-color a-circle)))
18 
19 ;clear-a-circle : circle -> boolean
20 ;Given a-circle, clear it and return true.
21 
22 (define (clear-a-circle a-circle)
23   (clear-solid-disk (circle-center a-circle)
24                     (circle-radius a-circle)
25                     (circle-color a-circle)))
26 |#
27 ;process-circle : (circle -> X) circle -> X
28 ;Given operation and a-circle, process the circle according to operation (draw-solid-disk or clear-solid-disk).
29 
30 (define (process-circle operation a-circle)
31   (operation (circle-center a-circle)
32              (circle-radius a-circle)
33              (circle-color a-circle)))
34 
35 ;draw-a-circle : circle -> boolean
36 ;Given a-circle, draw it and return true.
37 
38 (define (draw-a-circle a-circle)
39   (process-circle draw-solid-disk a-circle))
40 
41 ;clear-a-circle : circle -> boolean
42 ;Given a-circle, clear it and return true.
43 
44 (define (clear-a-circle a-circle)
45   (process-circle clear-solid-disk a-circle))
46 
47 ;Exercise 21.4.1.   Abstract the functions draw-a-circle and clear-a-circle into a single function process-circle.
48 ;
49 ;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
50 
51 ;translate-circle : circle number -> circle
52 ;Given a-circle and delta, return a circle structure moved delta to the right.
53 ;
54 ;translate-delta : posn number symbol -> circle
55 ;Given delta, center, radius, and color, return a circle structure translated delta to the right.
56 
57 (define (translate-circle a-circle delta)
58   (local ((define (translate-delta center radius color)
59             (make-circle (make-posn (+ delta (posn-x center))
60                                     (posn-y center))
61                          radius
62                          color)))
63     (process-circle translate-delta a-circle)))
64 
65 (define-struct rectangle (upper-left width height color))
66 
67 ;A rectangle is a structure
68 ;(make-rectangle u w h c)
69 ;where u is a posn, w, h are numbers, and color is a symbol.
70 ;
71 ;A shape is either
72 ;1. a circle or
73 ;2. a rectangle.
74 
75 #|
76 Exercise 21.4.2.   Abstract the functions draw-a-rectangle and clear-a-rectangle into a single function process-rectangle.
77 
78 Define translate-rectangle using process-rectangle.    Solution
79 |#
80 
81 ;process-rectangle : (posn number number symbol -> X) rectangle -> X
82 ;Perform operation on a-rectangle.
83 
84 (define (process-rectangle operation a-rect)
85   (operation (rectangle-upper-left a-rect)
86              (rectangle-width a-rect)
87              (rectangle-height a-rect)
88              (rectangle-color a-rect)))
89 
90 ;draw-a-rectangle : (posn number number symbol -> boolean) rectangle -> boolean
91 (define (draw-a-rectangle a-rect)
92   (process-rectangle draw-solid-rect a-rect))
93 
94 ;clear-a-rectangle : (posn number number symbol -> boolean) rectangle -> boolean
95 (define (clear-a-rectangle a-rect)
96   (process-rectangle clear-solid-rect a-rect))
97 
98 ;translate-rectangle : (posn number number symbol -> boolean) rectangle number -> rectangle
99 ;Given a-rect and delta, return a rectangle structure translated delta to the right.
100 
101 (define (translate-rectangle a-rect delta)
102   (local ((define (translate-rectangle a-rect)
103             (process-rectangle translate-delta a-rect))
104           (define (translate-delta upper-left width height color)
105             (make-rectangle (make-posn (+ delta (posn-x upper-left))
106                                        (posn-y upper-left))
107                             width
108                             height
109                             color)))
110     (translate-rectangle a-rect)))
111 
112 ;process-shape : (posn number symbol -> X) or
113 ;                (posn number number symbol -> X) shape -> X
114 (define (process-shape operation a-shape)
115   (cond
116     [(circle? a-shape) process-circle operation a-shape]
117     [(rectangle? a-shape) process-rectangle operation a-shape]))
118 
119 (define (draw-shape a-shape)
120   (cond
121     [(circle? a-shape) (process-shape draw-solid-disk a-shape)]
122     [(rectangle? a-shape) (process-shape draw-solid-rect a-shape)]))