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-advanced-reader.ss" "lang")((modname |39.2|) (read-case-sensitive #t) (teachpacks ((lib "guess-gui.ss" "teachpack" "htdp") (lib "guess.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp") (lib "draw.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "guess-gui.ss" "teachpack" "htdp") (lib "guess.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp") (lib "draw.ss" "teachpack" "htdp")))))
6 12687dd9 2023-08-04 jrmu ;Fill in examples for make-city
7 12687dd9 2023-08-04 jrmu ;Abstract x-posn using absolute definitions
10 12687dd9 2023-08-04 jrmu Exercise 39.2.1. Develop the program make-city. It manages a collection of traffic lights. The program should provide four services:
12 12687dd9 2023-08-04 jrmu 1. adding a traffic light with a label (string);
13 12687dd9 2023-08-04 jrmu 2. removing a traffic light by label;
14 12687dd9 2023-08-04 jrmu 3. switching the state of a traffic light with some given label; and
15 12687dd9 2023-08-04 jrmu 4. resetting a traffic light to red with some given label.
17 12687dd9 2023-08-04 jrmu Hint: The first two services are provided directly; the last two are implemented by the simulated traffic lights.
19 12687dd9 2023-08-04 jrmu After the development of the program is completed, develop a graphical user interface. Solution
22 12687dd9 2023-08-04 jrmu ;;Data Definition
23 12687dd9 2023-08-04 jrmu ;;A traffic-light color (TL-color) is either
25 12687dd9 2023-08-04 jrmu ;;2. 'yellow, or
26 12687dd9 2023-08-04 jrmu ;;3. 'green.
28 12687dd9 2023-08-04 jrmu ;;A traffic-light is an interface
29 12687dd9 2023-08-04 jrmu ;;1. 'next : -> true
30 12687dd9 2023-08-04 jrmu ;;2. 'reset : -> true
32 12687dd9 2023-08-04 jrmu ;;A city is an interface
33 12687dd9 2023-08-04 jrmu ;;1.'add-light :: symbol -> void
34 12687dd9 2023-08-04 jrmu ;;2.'remove-light :: symbol -> void
35 12687dd9 2023-08-04 jrmu ;;3.'access-light :: symbol -> traffic-light
37 12687dd9 2023-08-04 jrmu ;make-city : symbol -> city
38 12687dd9 2023-08-04 jrmu ;;Consumes location. Produces a city interface, which can ultimately be used to perform 4 possible services:
40 12687dd9 2023-08-04 jrmu ;; 1. adding a traffic light with a label (string);
41 12687dd9 2023-08-04 jrmu ;; 2. removing a traffic light by label;
42 12687dd9 2023-08-04 jrmu ;; 3. switching the state of a traffic light with some given label; and
43 12687dd9 2023-08-04 jrmu ;; 4. resetting a traffic light to red with some given label.
47 12687dd9 2023-08-04 jrmu ;;((make-city) 'add-light 'Germany) should set city-lights to (list (list 'Germany (make-traffic-light 'Germany))). It should also draw the traffic-light on the canvas. Output should be true.
48 12687dd9 2023-08-04 jrmu ;;(define my-city (make-city "Los Angeles"))
49 12687dd9 2023-08-04 jrmu ;;((my-city 'add-light) 'Boulevard)
50 12687dd9 2023-08-04 jrmu ;;((my-city 'add-light) 'Street)
51 12687dd9 2023-08-04 jrmu ;;((my-city 'add-light) 'Drive)
52 12687dd9 2023-08-04 jrmu ;;((my-city 'add-light) 'Road)
53 12687dd9 2023-08-04 jrmu ;;Should give a city with 4 traffic-lights and should draw 4 traffic lights on a canvas.
55 12687dd9 2023-08-04 jrmu (define (make-city location)
57 12687dd9 2023-08-04 jrmu (;;State Variables:
58 12687dd9 2023-08-04 jrmu ;;city-lights : (listof (list symbol traffic-light))
59 12687dd9 2023-08-04 jrmu ;;Records the traffic-lights in the city, the first symbol represents the location
60 12687dd9 2023-08-04 jrmu (define city-lights empty)
62 12687dd9 2023-08-04 jrmu ;;add-light : symbol -> void
63 12687dd9 2023-08-04 jrmu ;;Effect: Adds (list symbol traffic-light) to the front of city-lights
64 12687dd9 2023-08-04 jrmu (define (add-light alocation)
65 12687dd9 2023-08-04 jrmu (local ((define x-posn (+ 200 (* 100 (sub1 (length city-lights))))))
66 12687dd9 2023-08-04 jrmu (set! city-lights
67 12687dd9 2023-08-04 jrmu (cons (list alocation (make-traffic-light alocation x-posn))
68 12687dd9 2023-08-04 jrmu city-lights))))
70 12687dd9 2023-08-04 jrmu ;;remove-light : symbol -> void
71 12687dd9 2023-08-04 jrmu ;;Effect: Removes a light from city-lights
72 12687dd9 2023-08-04 jrmu (define (remove-light alocation)
73 12687dd9 2023-08-04 jrmu (local ((define (remove-aux alox x)
74 12687dd9 2023-08-04 jrmu (filter (lambda (an-x) (not (equal? (first an-x) x))) alox))
75 12687dd9 2023-08-04 jrmu (define x-posn (+ 200 (* 100 (sub1 (sub1 (length city-lights)))))))
77 12687dd9 2023-08-04 jrmu (clear-bulb 'red x-posn)
78 12687dd9 2023-08-04 jrmu (clear-bulb 'yellow x-posn)
79 12687dd9 2023-08-04 jrmu (clear-bulb 'green x-posn)
80 12687dd9 2023-08-04 jrmu (clear-border x-posn)
81 12687dd9 2023-08-04 jrmu (set! city-lights (remove-aux city-lights alocation)))))
84 12687dd9 2023-08-04 jrmu (define (access-light alocation)
85 12687dd9 2023-08-04 jrmu (local ((define (access-aux alox x)
87 12687dd9 2023-08-04 jrmu [(empty? alox) false]
88 12687dd9 2023-08-04 jrmu [(equal? (first (first alox)) x) (second (first alox))]
89 12687dd9 2023-08-04 jrmu [else (access-aux (rest alox) x)])))
90 12687dd9 2023-08-04 jrmu (access-aux city-lights alocation)))
91 12687dd9 2023-08-04 jrmu (define (service-manager msg)
93 12687dd9 2023-08-04 jrmu [(equal? msg 'add-light) add-light]
94 12687dd9 2023-08-04 jrmu [(equal? msg 'remove-light) remove-light]
95 12687dd9 2023-08-04 jrmu [(equal? msg 'access-light) access-light]
96 12687dd9 2023-08-04 jrmu [else (error 'make-city "message not understood")])))
97 12687dd9 2023-08-04 jrmu service-manager))
101 12687dd9 2023-08-04 jrmu ;;make-traffic-light : symbol number -> (symbol -> true)
102 12687dd9 2023-08-04 jrmu ;;Consumes location and x-posn, which indicates the position of the traffic light.
103 12687dd9 2023-08-04 jrmu ;;Output: Creates a function that acts as a service manager, which has two functions. If the argument 'next is passed, a given traffic light will switch (effect: current-color will switch for the given light and the canvas will change accordingly). If the argument 'reset is passed, the traffic light will be reset to 'red (effect: current-color and canvas will change accordingly).
105 12687dd9 2023-08-04 jrmu (define (make-traffic-light location x-posn)
107 12687dd9 2023-08-04 jrmu (;;State Variable:
108 12687dd9 2023-08-04 jrmu ;;current-color : TL-color
109 12687dd9 2023-08-04 jrmu (define current-color 'red)
111 12687dd9 2023-08-04 jrmu ;;next : -> true
112 12687dd9 2023-08-04 jrmu ;;Effect: Changes current-color from 'red to 'green, 'green to 'yellow,
113 12687dd9 2023-08-04 jrmu ;;or 'yellow to 'red depending on what the current-color is. Returns true.
114 12687dd9 2023-08-04 jrmu (define (next)
115 12687dd9 2023-08-04 jrmu (local ((define previous-color current-color))
116 12687dd9 2023-08-04 jrmu (begin (set! current-color (next-color current-color))
117 12687dd9 2023-08-04 jrmu (switch previous-color current-color x-posn))))
119 12687dd9 2023-08-04 jrmu ;next-color : TL-color -> TL-color
120 12687dd9 2023-08-04 jrmu ;Given acolor, returns the next logical color.
121 12687dd9 2023-08-04 jrmu (define (next-color acolor)
123 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'red) 'green]
124 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'yellow) 'red]
125 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'green) 'yellow]))
127 12687dd9 2023-08-04 jrmu ;;init-current-color : -> true
128 12687dd9 2023-08-04 jrmu ;;Opens the canvas and draws the outline of the 3 traffic light
129 12687dd9 2023-08-04 jrmu ;;bulbs as well as lighting up the red lightbulb.
130 12687dd9 2023-08-04 jrmu (define (init-traffic-light)
131 12687dd9 2023-08-04 jrmu (begin (draw-border x-posn)
132 12687dd9 2023-08-04 jrmu (clear-bulb current-color x-posn)
133 12687dd9 2023-08-04 jrmu (set! current-color 'red)
134 12687dd9 2023-08-04 jrmu (fill-bulb current-color x-posn)))
135 12687dd9 2023-08-04 jrmu (define (service-manager msg)
137 12687dd9 2023-08-04 jrmu [(symbol=? msg 'next) (next)]
138 12687dd9 2023-08-04 jrmu [(symbol=? msg 'reset) (init-traffic-light)]
139 12687dd9 2023-08-04 jrmu [else (error 'service-manager "message not understood")])))
140 12687dd9 2023-08-04 jrmu (begin (init-traffic-light)
141 12687dd9 2023-08-04 jrmu service-manager)))
146 12687dd9 2023-08-04 jrmu (define WIDTH 1000)
147 12687dd9 2023-08-04 jrmu (define HEIGHT 340)
148 12687dd9 2023-08-04 jrmu (define RADIUS 40)
149 12687dd9 2023-08-04 jrmu (define INTERDIST 20)
150 12687dd9 2023-08-04 jrmu (define Y-RED (+ INTERDIST RADIUS))
151 12687dd9 2023-08-04 jrmu (define Y-YELLOW (+ Y-RED (* 2 RADIUS) INTERDIST))
152 12687dd9 2023-08-04 jrmu (define Y-GREEN (+ Y-YELLOW (* 2 RADIUS) INTERDIST))
154 12687dd9 2023-08-04 jrmu ;;op-bulb : (posn N symbol -> true) symbol number -> boolean
155 12687dd9 2023-08-04 jrmu ;;Perform op on a bulb given op, color, and x-posn.
157 12687dd9 2023-08-04 jrmu (define (op-bulb op color x-posn)
159 12687dd9 2023-08-04 jrmu [(symbol=? color 'red)
160 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-RED) RADIUS 'red)]
161 12687dd9 2023-08-04 jrmu [(symbol=? color 'yellow)
162 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-YELLOW) RADIUS 'yellow)]
163 12687dd9 2023-08-04 jrmu [(symbol=? color 'green)
164 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-GREEN) RADIUS 'green)]))
166 12687dd9 2023-08-04 jrmu ;; fill-bulb : symbol number -> boolean
167 12687dd9 2023-08-04 jrmu ;; Fills in a given bulb based on color and x-posn; returns true if the function evaluates properly, false otherwise.
169 12687dd9 2023-08-04 jrmu (define (fill-bulb color x-posn)
170 12687dd9 2023-08-04 jrmu (op-bulb draw-solid-disk color x-posn))
172 12687dd9 2023-08-04 jrmu ;; clear-bulb : symbol number -> boolean
173 12687dd9 2023-08-04 jrmu ;; Clears a bulb given color and x-posn; returns true if evaluation completes, false otherwise.
175 12687dd9 2023-08-04 jrmu (define (clear-bulb color x-posn)
176 12687dd9 2023-08-04 jrmu (op-bulb clear-solid-disk color x-posn))
178 12687dd9 2023-08-04 jrmu ;;op-border : (posn number symbol -> true) number -> true
179 12687dd9 2023-08-04 jrmu ;;Performs an operation on the borders of circles of a traffic light.
181 12687dd9 2023-08-04 jrmu (define (op-border op x-posn)
182 12687dd9 2023-08-04 jrmu (and (op (make-posn x-posn Y-RED) (+ RADIUS 1) 'black)
183 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-YELLOW) (+ RADIUS 1) 'black)
184 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-GREEN) (+ RADIUS 1) 'black)))
186 12687dd9 2023-08-04 jrmu ;;draw-border : number -> true
187 12687dd9 2023-08-04 jrmu ;;Draws the borders for the 3 traffic lights given x-posn.
189 12687dd9 2023-08-04 jrmu (define (draw-border x-posn)
190 12687dd9 2023-08-04 jrmu (op-border draw-circle x-posn))
192 12687dd9 2023-08-04 jrmu ;;clear-border : number -> true
193 12687dd9 2023-08-04 jrmu ;;Clears the borders for the 3 traffic lights given x-posn.
195 12687dd9 2023-08-04 jrmu (define (clear-border x-posn)
196 12687dd9 2023-08-04 jrmu (op-border clear-circle x-posn))
198 12687dd9 2023-08-04 jrmu ;switch : symbol symbol number -> true
199 12687dd9 2023-08-04 jrmu ;Switches clear to fill for the lightbulb given x-posn.
201 12687dd9 2023-08-04 jrmu (define (switch clear fill x-posn)
203 12687dd9 2023-08-04 jrmu (fill-bulb fill x-posn)
204 12687dd9 2023-08-04 jrmu (clear-bulb clear x-posn)))
210 12687dd9 2023-08-04 jrmu (define lights
211 12687dd9 2023-08-04 jrmu (list (make-traffic-light 'AdobeCircle 50)
212 12687dd9 2023-08-04 jrmu (make-traffic-light 'Pereira 200)
213 12687dd9 2023-08-04 jrmu (make-traffic-light 'CampusDr 350)
214 12687dd9 2023-08-04 jrmu (make-traffic-light 'HarvardSt 500)
215 12687dd9 2023-08-04 jrmu (make-traffic-light 'BrenRd 650)
216 12687dd9 2023-08-04 jrmu (make-traffic-light 'UniversityBlvd 800)))
218 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
220 12687dd9 2023-08-04 jrmu ;;Controller
222 12687dd9 2023-08-04 jrmu (define (next-callback event)
223 12687dd9 2023-08-04 jrmu (andmap (lambda (a-light) (a-light 'next)) lights))
225 12687dd9 2023-08-04 jrmu (define (reset-callback event)
226 12687dd9 2023-08-04 jrmu (andmap (lambda (a-light) (a-light 'reset)) lights))
228 12687dd9 2023-08-04 jrmu (define next-buttons
229 12687dd9 2023-08-04 jrmu (build-list (length lights)
230 12687dd9 2023-08-04 jrmu (lambda (n)
231 12687dd9 2023-08-04 jrmu (local ((define (next-indiv-callback event)
232 12687dd9 2023-08-04 jrmu ((list-ref lights n) 'next)))
233 12687dd9 2023-08-04 jrmu (make-button (number->string (add1 n)) next-indiv-callback)))))
235 12687dd9 2023-08-04 jrmu (create-window (list (list (make-button "Next" next-callback)
236 12687dd9 2023-08-04 jrmu (make-button "Reset" reset-callback))
237 12687dd9 2023-08-04 jrmu next-buttons))
241 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
243 12687dd9 2023-08-04 jrmu (define my-city (make-city "Los Angeles"))
244 12687dd9 2023-08-04 jrmu ((my-city 'add-light) 'Germany)
245 12687dd9 2023-08-04 jrmu ((my-city 'add-light) 'Naples)
246 12687dd9 2023-08-04 jrmu ((my-city 'add-light) 'Paris)
247 12687dd9 2023-08-04 jrmu ((my-city 'add-light) 'Italy)
