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")))))
  4 12687dd9 2023-08-04 jrmu 
  5 12687dd9 2023-08-04 jrmu (define-struct circle (center radius color))
  6 12687dd9 2023-08-04 jrmu #|
  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.
 10 12687dd9 2023-08-04 jrmu ;
 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.
 13 12687dd9 2023-08-04 jrmu 
 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)))
 18 12687dd9 2023-08-04 jrmu 
 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.
 21 12687dd9 2023-08-04 jrmu 
 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)))
 26 12687dd9 2023-08-04 jrmu |#
 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).
 29 12687dd9 2023-08-04 jrmu 
 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)))
 34 12687dd9 2023-08-04 jrmu 
 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.
 37 12687dd9 2023-08-04 jrmu 
 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))
 40 12687dd9 2023-08-04 jrmu 
 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.
 43 12687dd9 2023-08-04 jrmu 
 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))
 46 12687dd9 2023-08-04 jrmu 
 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.
 48 12687dd9 2023-08-04 jrmu ;
 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
 50 12687dd9 2023-08-04 jrmu 
 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.
 53 12687dd9 2023-08-04 jrmu ;
 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.
 56 12687dd9 2023-08-04 jrmu 
 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))
 61 12687dd9 2023-08-04 jrmu                          radius
 62 12687dd9 2023-08-04 jrmu                          color)))
 63 12687dd9 2023-08-04 jrmu     (process-circle translate-delta a-circle)))
 64 12687dd9 2023-08-04 jrmu 
 65 12687dd9 2023-08-04 jrmu (define-struct rectangle (upper-left width height color))
 66 12687dd9 2023-08-04 jrmu 
 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.
 70 12687dd9 2023-08-04 jrmu ;
 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.
 74 12687dd9 2023-08-04 jrmu 
 75 12687dd9 2023-08-04 jrmu #|
 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.
 77 12687dd9 2023-08-04 jrmu 
 78 12687dd9 2023-08-04 jrmu Define translate-rectangle using process-rectangle.    Solution
 79 12687dd9 2023-08-04 jrmu |#
 80 12687dd9 2023-08-04 jrmu 
 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.
 83 12687dd9 2023-08-04 jrmu 
 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)))
 89 12687dd9 2023-08-04 jrmu 
 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))
 93 12687dd9 2023-08-04 jrmu 
 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))
 97 12687dd9 2023-08-04 jrmu 
 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.
100 12687dd9 2023-08-04 jrmu 
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))
107 12687dd9 2023-08-04 jrmu                             width
108 12687dd9 2023-08-04 jrmu                             height
109 12687dd9 2023-08-04 jrmu                             color)))
110 12687dd9 2023-08-04 jrmu     (translate-rectangle a-rect)))
111 12687dd9 2023-08-04 jrmu 
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)
115 12687dd9 2023-08-04 jrmu   (cond
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)]))
118 12687dd9 2023-08-04 jrmu 
119 12687dd9 2023-08-04 jrmu (define (draw-shape a-shape)
120 12687dd9 2023-08-04 jrmu   (cond
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)]))
123 12687dd9 2023-08-04 jrmu 
124 12687dd9 2023-08-04 jrmu (define (clear-shape a-shape)
125 12687dd9 2023-08-04 jrmu   (cond
126 12687dd9 2023-08-04 jrmu     [(circle? a-shape) (process-shape clear-solid-disk a-shape)]
127 12687dd9 2023-08-04 jrmu     [(rectangle? a-shape) (process-shape clear-solid-rect a-shape)]))
128 12687dd9 2023-08-04 jrmu 
129 12687dd9 2023-08-04 jrmu (define (translate-shape a-shape delta)
130 12687dd9 2023-08-04 jrmu   (cond
131 12687dd9 2023-08-04 jrmu     [(circle? a-shape) (translate-circle a-shape delta)]
132 12687dd9 2023-08-04 jrmu     [(rectangle? a-shape) (translate-rectangle a-shape delta)]))
133 12687dd9 2023-08-04 jrmu 
134 12687dd9 2023-08-04 jrmu ;Exercise 21.4.4.   Use Scheme's map and andmap to define draw-losh, clear-losh, and translate-losh.    Solution
135 12687dd9 2023-08-04 jrmu 
136 12687dd9 2023-08-04 jrmu 
137 12687dd9 2023-08-04 jrmu ;draw-losh : (listof shapes) -> boolean 
138 12687dd9 2023-08-04 jrmu ;Draws a (listof shapes) and return true.
139 12687dd9 2023-08-04 jrmu (define (draw-losh alosh)
140 12687dd9 2023-08-04 jrmu   (andmap draw-shape alosh))
141 12687dd9 2023-08-04 jrmu 
142 12687dd9 2023-08-04 jrmu ;clear-losh : (listof shapes) -> boolean 
143 12687dd9 2023-08-04 jrmu ;Clears a (listof shapes) and return true.
144 12687dd9 2023-08-04 jrmu (define (clear-losh alosh)
145 12687dd9 2023-08-04 jrmu   (andmap clear-shape alosh))
146 12687dd9 2023-08-04 jrmu 
147 12687dd9 2023-08-04 jrmu ;translate-losh : number (listof shapes) -> (listof shapes)
148 12687dd9 2023-08-04 jrmu ;Translates alosh delta to the right and returns a new (listof shapes).
149 12687dd9 2023-08-04 jrmu 
150 12687dd9 2023-08-04 jrmu (define (translate-losh alosh delta)
151 12687dd9 2023-08-04 jrmu   (local ((define (translate-shape a-shape)
152 12687dd9 2023-08-04 jrmu             (cond
153 12687dd9 2023-08-04 jrmu               [(circle? a-shape) (translate-circle a-shape delta)]
154 12687dd9 2023-08-04 jrmu               [(rectangle? a-shape) (translate-rectangle a-shape delta)])))
155 12687dd9 2023-08-04 jrmu     (map translate-shape alosh)))
156 12687dd9 2023-08-04 jrmu 
157 12687dd9 2023-08-04 jrmu (define SQUIDWARD
158 12687dd9 2023-08-04 jrmu   (list (make-circle (make-posn 100 100)
159 12687dd9 2023-08-04 jrmu                      80
160 12687dd9 2023-08-04 jrmu                      'blue)
161 12687dd9 2023-08-04 jrmu         (make-circle (make-posn 60 60)
162 12687dd9 2023-08-04 jrmu                      10
163 12687dd9 2023-08-04 jrmu                      'red)
164 12687dd9 2023-08-04 jrmu         (make-circle (make-posn 140 60)
165 12687dd9 2023-08-04 jrmu                      10
166 12687dd9 2023-08-04 jrmu                      'red)
167 12687dd9 2023-08-04 jrmu         (make-rectangle (make-posn 90 80)
168 12687dd9 2023-08-04 jrmu                         20
169 12687dd9 2023-08-04 jrmu                         50
170 12687dd9 2023-08-04 jrmu                         'yellow)
171 12687dd9 2023-08-04 jrmu         (make-rectangle (make-posn 60 140)
172 12687dd9 2023-08-04 jrmu                         80
173 12687dd9 2023-08-04 jrmu                         20
174 12687dd9 2023-08-04 jrmu                         'green)))
175 12687dd9 2023-08-04 jrmu 
176 12687dd9 2023-08-04 jrmu (translate-losh SQUIDWARD 50)
177 12687dd9 2023-08-04 jrmu 
178 12687dd9 2023-08-04 jrmu #|
179 12687dd9 2023-08-04 jrmu ;; map : (X  ->  Y) (listof X)  ->  (listof Y)
180 12687dd9 2023-08-04 jrmu ;; to construct a list by applying f to each item on alox
181 12687dd9 2023-08-04 jrmu ;; that is, (map f (list x-1 ... x-n)) = (list (f x-1) ... (f x-n))
182 12687dd9 2023-08-04 jrmu (define (map f alox) ...)
183 12687dd9 2023-08-04 jrmu 
184 12687dd9 2023-08-04 jrmu ;; andmap : (X  ->  boolean) (listof X)  ->  boolean
185 12687dd9 2023-08-04 jrmu ;; to determine whether p holds for every item on alox
186 12687dd9 2023-08-04 jrmu ;; that is, (andmap p (list x-1 ... x-n)) = (and (p x-1) (and ... (p x-n)))
187 12687dd9 2023-08-04 jrmu (define (andmap p alox) ...)
188 12687dd9 2023-08-04 jrmu 
189 12687dd9 2023-08-04 jrmu ;; ormap : (X  ->  boolean) (listof X)  ->  boolean
190 12687dd9 2023-08-04 jrmu ;; to determine whether p holds for at least one item on alox
191 12687dd9 2023-08-04 jrmu ;; that is, (ormap p (list x-1 ... x-n)) = (or (p x-1) (or ... (p x-n)))
192 12687dd9 2023-08-04 jrmu (define (ormap p alox) ...)
193 12687dd9 2023-08-04 jrmu |#