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") (lib "arrow.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp")))))
  4 12687dd9 2023-08-04 jrmu ;A circle is a structure
  5 12687dd9 2023-08-04 jrmu ;(make-circle ce ra co)
  6 12687dd9 2023-08-04 jrmu ;where ce is a posn, ra is a number, and co is a symbol.
  7 12687dd9 2023-08-04 jrmu 
  8 12687dd9 2023-08-04 jrmu ;A rectangle is a structure
  9 12687dd9 2023-08-04 jrmu ;(make-rectangle u w h c)
 10 12687dd9 2023-08-04 jrmu ;where u is a posn, w, h are numbers, and color is a symbol.
 11 12687dd9 2023-08-04 jrmu 
 12 12687dd9 2023-08-04 jrmu ;A line is a structure
 13 12687dd9 2023-08-04 jrmu ;(make-line s e c)
 14 12687dd9 2023-08-04 jrmu ;where s, e are posn and c is a symbol.
 15 12687dd9 2023-08-04 jrmu 
 16 12687dd9 2023-08-04 jrmu ;A shape is either
 17 12687dd9 2023-08-04 jrmu ;1. a circle,
 18 12687dd9 2023-08-04 jrmu ;2. a rectangle, or
 19 12687dd9 2023-08-04 jrmu ;3. a line.
 20 12687dd9 2023-08-04 jrmu 
 21 12687dd9 2023-08-04 jrmu ;translate-posn : posn number number -> posn
 22 12687dd9 2023-08-04 jrmu ;Given a-posn, down, and right, translate the posn down and right.
 23 12687dd9 2023-08-04 jrmu 
 24 12687dd9 2023-08-04 jrmu ;process-circle : (circle -> X) circle -> X
 25 12687dd9 2023-08-04 jrmu ;Given operation and a-circle, process the circle according to operation (draw-solid-disk or clear-solid-disk).
 26 12687dd9 2023-08-04 jrmu 
 27 12687dd9 2023-08-04 jrmu ;process-rectangle : (posn number number symbol -> X) rectangle -> X
 28 12687dd9 2023-08-04 jrmu ;Perform operation on a-rectangle.
 29 12687dd9 2023-08-04 jrmu 
 30 12687dd9 2023-08-04 jrmu ;process-line : (posn posn symbol -> X) line -> X
 31 12687dd9 2023-08-04 jrmu 
 32 12687dd9 2023-08-04 jrmu ;draw-a-circle : circle -> boolean
 33 12687dd9 2023-08-04 jrmu ;Given a-circle, draw it and return true.
 34 12687dd9 2023-08-04 jrmu 
 35 12687dd9 2023-08-04 jrmu ;draw-a-rectangle : rectangle -> boolean
 36 12687dd9 2023-08-04 jrmu ;clear-a-rectangle : rectangle -> boolean
 37 12687dd9 2023-08-04 jrmu 
 38 12687dd9 2023-08-04 jrmu ;clear-a-circle : circle -> boolean
 39 12687dd9 2023-08-04 jrmu ;Given a-circle, clear it and return true.
 40 12687dd9 2023-08-04 jrmu 
 41 12687dd9 2023-08-04 jrmu ;translate-circle : circle number number -> circle
 42 12687dd9 2023-08-04 jrmu 
 43 12687dd9 2023-08-04 jrmu ;translate-rectangle : rectangle number number -> rectangle
 44 12687dd9 2023-08-04 jrmu ;Given a-rect, right, and down, return a rectangle structure translated right to the right and down.
 45 12687dd9 2023-08-04 jrmu 
 46 12687dd9 2023-08-04 jrmu ;Given a-circle and right, return a circle structure moved right towards the x-axis and down towards the y-axis.
 47 12687dd9 2023-08-04 jrmu 
 48 12687dd9 2023-08-04 jrmu ;translate-right : number posn number symbol -> circle
 49 12687dd9 2023-08-04 jrmu ;Given right, center, radius, and color, return a circle structure translated right units towards the x-axis.
 50 12687dd9 2023-08-04 jrmu 
 51 12687dd9 2023-08-04 jrmu ;translate-down : number posn number symbol -> circle
 52 12687dd9 2023-08-04 jrmu ;Given down, center, radius, and color, return a circle structure translated down units towards the y-axis.
 53 12687dd9 2023-08-04 jrmu 
 54 12687dd9 2023-08-04 jrmu ;translate-line : line number number -> line
 55 12687dd9 2023-08-04 jrmu ;Given a-line, right, and down, return a new line translated right and down.
 56 12687dd9 2023-08-04 jrmu 
 57 12687dd9 2023-08-04 jrmu ;process-shape : (shape -> X) shape -> X
 58 12687dd9 2023-08-04 jrmu 
 59 12687dd9 2023-08-04 jrmu ;draw-shape : (shape -> X) shape -> X
 60 12687dd9 2023-08-04 jrmu 
 61 12687dd9 2023-08-04 jrmu ;clear-shape : (shape -> X) shape -> X
 62 12687dd9 2023-08-04 jrmu 
 63 12687dd9 2023-08-04 jrmu ;translate-shape : (shape -> shape) shape number number -> shape
 64 12687dd9 2023-08-04 jrmu 
 65 12687dd9 2023-08-04 jrmu ;draw-losh : (listof shapes) -> boolean 
 66 12687dd9 2023-08-04 jrmu ;Draws a (listof shapes) and return true.
 67 12687dd9 2023-08-04 jrmu 
 68 12687dd9 2023-08-04 jrmu ;clear-losh : (listof shapes) -> boolean 
 69 12687dd9 2023-08-04 jrmu ;Clears a (listof shapes) and return true.
 70 12687dd9 2023-08-04 jrmu 
 71 12687dd9 2023-08-04 jrmu ;translate-losh : (listof shapes) number number -> (listof shapes)
 72 12687dd9 2023-08-04 jrmu ;Translates alosh right and down and returns a new (listof shapes).
 73 12687dd9 2023-08-04 jrmu 
 74 12687dd9 2023-08-04 jrmu (define-struct circle (center radius color))
 75 12687dd9 2023-08-04 jrmu 
 76 12687dd9 2023-08-04 jrmu (define-struct rectangle (upper-left width height color))
 77 12687dd9 2023-08-04 jrmu 
 78 12687dd9 2023-08-04 jrmu (define-struct line (start end color))
 79 12687dd9 2023-08-04 jrmu 
 80 12687dd9 2023-08-04 jrmu (define (translate-posn a-posn right down)
 81 12687dd9 2023-08-04 jrmu   (make-posn (+ right (posn-x a-posn))
 82 12687dd9 2023-08-04 jrmu              (+ down (posn-y a-posn))))
 83 12687dd9 2023-08-04 jrmu 
 84 12687dd9 2023-08-04 jrmu (define (process-circle operation a-circle)
 85 12687dd9 2023-08-04 jrmu   (operation (circle-center a-circle)
 86 12687dd9 2023-08-04 jrmu              (circle-radius a-circle)
 87 12687dd9 2023-08-04 jrmu              (circle-color a-circle)))
 88 12687dd9 2023-08-04 jrmu 
 89 12687dd9 2023-08-04 jrmu (define (process-rectangle operation a-rect)
 90 12687dd9 2023-08-04 jrmu   (operation (rectangle-upper-left a-rect)
 91 12687dd9 2023-08-04 jrmu              (rectangle-width a-rect)
 92 12687dd9 2023-08-04 jrmu              (rectangle-height a-rect)
 93 12687dd9 2023-08-04 jrmu              (rectangle-color a-rect)))
 94 12687dd9 2023-08-04 jrmu 
 95 12687dd9 2023-08-04 jrmu (define (process-line operation a-line)
 96 12687dd9 2023-08-04 jrmu   (operation (line-start a-line)
 97 12687dd9 2023-08-04 jrmu              (line-end a-line)
 98 12687dd9 2023-08-04 jrmu              (line-color a-line)))
 99 12687dd9 2023-08-04 jrmu 
100 12687dd9 2023-08-04 jrmu (define (draw-a-circle a-circle)
101 12687dd9 2023-08-04 jrmu   (process-circle draw-solid-disk a-circle))
102 12687dd9 2023-08-04 jrmu 
103 12687dd9 2023-08-04 jrmu (define (draw-a-rectangle a-rect)
104 12687dd9 2023-08-04 jrmu   (process-rectangle draw-solid-rect a-rect))
105 12687dd9 2023-08-04 jrmu 
106 12687dd9 2023-08-04 jrmu (define (draw-a-line a-line)
107 12687dd9 2023-08-04 jrmu   (process-line draw-solid-line a-line))
108 12687dd9 2023-08-04 jrmu 
109 12687dd9 2023-08-04 jrmu (define (clear-a-circle a-circle)
110 12687dd9 2023-08-04 jrmu   (process-circle clear-solid-disk a-circle))
111 12687dd9 2023-08-04 jrmu 
112 12687dd9 2023-08-04 jrmu (define (clear-a-rectangle a-rect)
113 12687dd9 2023-08-04 jrmu   (process-rectangle clear-solid-rect a-rect))
114 12687dd9 2023-08-04 jrmu 
115 12687dd9 2023-08-04 jrmu (define (clear-a-line a-line)
116 12687dd9 2023-08-04 jrmu   (process-line clear-solid-line a-line))
117 12687dd9 2023-08-04 jrmu 
118 12687dd9 2023-08-04 jrmu (define (translate-circle a-circle right down)
119 12687dd9 2023-08-04 jrmu   (local ((define (translate-right-down center radius color)
120 12687dd9 2023-08-04 jrmu             (make-circle (translate-posn center right down)
121 12687dd9 2023-08-04 jrmu                          radius
122 12687dd9 2023-08-04 jrmu                          color)))
123 12687dd9 2023-08-04 jrmu     (process-circle translate-right-down a-circle)))
124 12687dd9 2023-08-04 jrmu 
125 12687dd9 2023-08-04 jrmu (define (translate-rectangle a-rect right down)
126 12687dd9 2023-08-04 jrmu   (local ((define (translate-right-down upper-left width height color)
127 12687dd9 2023-08-04 jrmu             (make-rectangle (translate-posn upper-left right down)
128 12687dd9 2023-08-04 jrmu                             width
129 12687dd9 2023-08-04 jrmu                             height
130 12687dd9 2023-08-04 jrmu                             color)))
131 12687dd9 2023-08-04 jrmu     (process-rectangle translate-right-down a-rect)))
132 12687dd9 2023-08-04 jrmu 
133 12687dd9 2023-08-04 jrmu 
134 12687dd9 2023-08-04 jrmu (define (translate-line a-line right down)
135 12687dd9 2023-08-04 jrmu   (local ((define (translate-right-down start end color)
136 12687dd9 2023-08-04 jrmu             (make-line (translate-posn start right down)
137 12687dd9 2023-08-04 jrmu                        (translate-posn end right down)
138 12687dd9 2023-08-04 jrmu                        color)))
139 12687dd9 2023-08-04 jrmu     (process-line translate-right-down a-line)))
140 12687dd9 2023-08-04 jrmu 
141 12687dd9 2023-08-04 jrmu (define (process-shape operation a-shape)
142 12687dd9 2023-08-04 jrmu   (operation a-shape))
143 12687dd9 2023-08-04 jrmu 
144 12687dd9 2023-08-04 jrmu (define (draw-shape a-shape)
145 12687dd9 2023-08-04 jrmu   (cond
146 12687dd9 2023-08-04 jrmu     [(circle? a-shape) (process-shape draw-a-circle a-shape)]
147 12687dd9 2023-08-04 jrmu     [(rectangle? a-shape) (process-shape draw-a-rectangle a-shape)]
148 12687dd9 2023-08-04 jrmu     [(line? a-shape) (process-shape draw-a-line a-shape)]))
149 12687dd9 2023-08-04 jrmu 
150 12687dd9 2023-08-04 jrmu (define (clear-shape a-shape)
151 12687dd9 2023-08-04 jrmu   (cond
152 12687dd9 2023-08-04 jrmu     [(circle? a-shape) (process-shape clear-a-circle a-shape)]
153 12687dd9 2023-08-04 jrmu     [(rectangle? a-shape) (process-shape clear-a-rectangle a-shape)]
154 12687dd9 2023-08-04 jrmu     [(line? a-shape) (process-shape clear-a-line a-shape)]))
155 12687dd9 2023-08-04 jrmu 
156 12687dd9 2023-08-04 jrmu (define (translate-shape a-shape right down)
157 12687dd9 2023-08-04 jrmu   (local ((define (translate-shape-right-down a-shape)
158 12687dd9 2023-08-04 jrmu             (cond
159 12687dd9 2023-08-04 jrmu               [(circle? a-shape) (translate-circle a-shape right down)]
160 12687dd9 2023-08-04 jrmu               [(rectangle? a-shape) (translate-rectangle a-shape right down)]
161 12687dd9 2023-08-04 jrmu               [(line? a-shape) (translate-line a-shape right down)])))
162 12687dd9 2023-08-04 jrmu     (process-shape translate-shape-right-down a-shape)))
163 12687dd9 2023-08-04 jrmu 
164 12687dd9 2023-08-04 jrmu (define (draw-losh alosh)
165 12687dd9 2023-08-04 jrmu   (andmap draw-shape alosh))
166 12687dd9 2023-08-04 jrmu 
167 12687dd9 2023-08-04 jrmu (define (clear-losh alosh)
168 12687dd9 2023-08-04 jrmu   (andmap clear-shape alosh))
169 12687dd9 2023-08-04 jrmu 
170 12687dd9 2023-08-04 jrmu (define (translate-losh alosh right down)
171 12687dd9 2023-08-04 jrmu   (local ((define (translate-shape-right-down a-shape)
172 12687dd9 2023-08-04 jrmu             (translate-shape a-shape right down)))
173 12687dd9 2023-08-04 jrmu     (map translate-shape-right-down alosh)))
174 12687dd9 2023-08-04 jrmu 
175 12687dd9 2023-08-04 jrmu (define SQUIDWARD
176 12687dd9 2023-08-04 jrmu   (list (make-circle (make-posn 100 100)
177 12687dd9 2023-08-04 jrmu                      80
178 12687dd9 2023-08-04 jrmu                      'blue)
179 12687dd9 2023-08-04 jrmu         (make-circle (make-posn 60 60)
180 12687dd9 2023-08-04 jrmu                      10
181 12687dd9 2023-08-04 jrmu                      'red)
182 12687dd9 2023-08-04 jrmu         (make-circle (make-posn 140 60)
183 12687dd9 2023-08-04 jrmu                      10
184 12687dd9 2023-08-04 jrmu                      'red)
185 12687dd9 2023-08-04 jrmu         (make-rectangle (make-posn 90 80)
186 12687dd9 2023-08-04 jrmu                         20
187 12687dd9 2023-08-04 jrmu                         50
188 12687dd9 2023-08-04 jrmu                         'yellow)
189 12687dd9 2023-08-04 jrmu         (make-rectangle (make-posn 60 140)
190 12687dd9 2023-08-04 jrmu                         80
191 12687dd9 2023-08-04 jrmu                         20
192 12687dd9 2023-08-04 jrmu                         'green)
193 12687dd9 2023-08-04 jrmu         (make-line (make-posn 60 150)
194 12687dd9 2023-08-04 jrmu                    (make-posn 140 150)
195 12687dd9 2023-08-04 jrmu                    'brown)
196 12687dd9 2023-08-04 jrmu         (make-line (make-posn 60 200)
197 12687dd9 2023-08-04 jrmu                    (make-posn 140 200)
198 12687dd9 2023-08-04 jrmu                    'brown)))
199 12687dd9 2023-08-04 jrmu 
200 12687dd9 2023-08-04 jrmu ;(start 500 500)
201 12687dd9 2023-08-04 jrmu ;(translate-losh SQUIDWARD 15 25)
202 12687dd9 2023-08-04 jrmu ;(draw-losh SQUIDWARD)
203 12687dd9 2023-08-04 jrmu 
204 12687dd9 2023-08-04 jrmu (define LUNAR (list (make-circle (make-posn 375
205 12687dd9 2023-08-04 jrmu                                             375)
206 12687dd9 2023-08-04 jrmu                                  100 'blue)
207 12687dd9 2023-08-04 jrmu                     (make-line (make-posn (- 375 (* 50 (sqrt 2))) (+ 375 (* 50 (sqrt 2))))
208 12687dd9 2023-08-04 jrmu                                (make-posn 150 600)
209 12687dd9 2023-08-04 jrmu                                'black)
210 12687dd9 2023-08-04 jrmu                     (make-line (make-posn (+ 375 (* 50 (sqrt 2))) (+ 375 (* 50 (sqrt 2))))
211 12687dd9 2023-08-04 jrmu                                (make-posn 600 600)
212 12687dd9 2023-08-04 jrmu                                'black)
213 12687dd9 2023-08-04 jrmu                     (make-rectangle (make-posn 400 300) 100 75 'gray)))
214 12687dd9 2023-08-04 jrmu 
215 12687dd9 2023-08-04 jrmu 
216 12687dd9 2023-08-04 jrmu ;move-lr : number (listof shape) -> (listof shape)
217 12687dd9 2023-08-04 jrmu ;Given right and alosh, moves the (listof shapes) right.
218 12687dd9 2023-08-04 jrmu 
219 12687dd9 2023-08-04 jrmu (define (move-lr right alosh)
220 12687dd9 2023-08-04 jrmu   (translate-losh alosh right 0))
221 12687dd9 2023-08-04 jrmu 
222 12687dd9 2023-08-04 jrmu ;move-ud : number (listof shape) -> (listof shape)
223 12687dd9 2023-08-04 jrmu ;Given down and alosh, moves the (listof shapes) down.
224 12687dd9 2023-08-04 jrmu 
225 12687dd9 2023-08-04 jrmu (define (move-ud down alosh)
226 12687dd9 2023-08-04 jrmu   (translate-losh alosh 0 down))
227 12687dd9 2023-08-04 jrmu 
228 12687dd9 2023-08-04 jrmu ;clear-and-draw-losh : (listof shapes) -> boolean
229 12687dd9 2023-08-04 jrmu ;Clears and draws alosh.
230 12687dd9 2023-08-04 jrmu (define (clear-and-draw-losh alosh)
231 12687dd9 2023-08-04 jrmu   (and (clear-losh alosh)
232 12687dd9 2023-08-04 jrmu        (draw-losh alosh)))
233 12687dd9 2023-08-04 jrmu 
234 12687dd9 2023-08-04 jrmu ;lunar-lander : (listof shapes) number -> boolean
235 12687dd9 2023-08-04 jrmu ;Given alosh and delta, moves alosh using a GUI controller.
236 12687dd9 2023-08-04 jrmu 
237 12687dd9 2023-08-04 jrmu (start 750 750)
238 12687dd9 2023-08-04 jrmu (draw-losh LUNAR)
239 12687dd9 2023-08-04 jrmu (control LUNAR 5 move-lr move-ud clear-and-draw-losh)