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.1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 12687dd9 2023-08-04 jrmu ;;Data Definition
5 12687dd9 2023-08-04 jrmu ;;A traffic-light color (TL-color) is either
7 12687dd9 2023-08-04 jrmu ;;2. 'yellow, or
12 12687dd9 2023-08-04 jrmu (define WIDTH 1000)
13 12687dd9 2023-08-04 jrmu (define HEIGHT 340)
14 12687dd9 2023-08-04 jrmu (define RADIUS 40)
15 12687dd9 2023-08-04 jrmu (define INTERDIST 20)
16 12687dd9 2023-08-04 jrmu (define Y-RED (+ INTERDIST RADIUS))
17 12687dd9 2023-08-04 jrmu (define Y-YELLOW (+ Y-RED (* 2 RADIUS) INTERDIST))
18 12687dd9 2023-08-04 jrmu (define Y-GREEN (+ Y-YELLOW (* 2 RADIUS) INTERDIST))
20 12687dd9 2023-08-04 jrmu ;;op-bulb : (posn N symbol -> true) symbol number -> boolean
21 12687dd9 2023-08-04 jrmu ;;Perform op on a bulb given op, color, and x-posn.
23 12687dd9 2023-08-04 jrmu (define (op-bulb op color x-posn)
25 12687dd9 2023-08-04 jrmu [(symbol=? color 'red)
26 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-RED) RADIUS 'red)]
27 12687dd9 2023-08-04 jrmu [(symbol=? color 'yellow)
28 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-YELLOW) RADIUS 'yellow)]
29 12687dd9 2023-08-04 jrmu [(symbol=? color 'green)
30 12687dd9 2023-08-04 jrmu (op (make-posn x-posn Y-GREEN) RADIUS 'green)]))
32 12687dd9 2023-08-04 jrmu ;; fill-bulb : symbol number -> boolean
33 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.
35 12687dd9 2023-08-04 jrmu (define (fill-bulb color x-posn)
36 12687dd9 2023-08-04 jrmu (op-bulb draw-solid-disk color x-posn))
38 12687dd9 2023-08-04 jrmu ;; clear-bulb : symbol number -> boolean
39 12687dd9 2023-08-04 jrmu ;; Clears a bulb given color and x-posn; returns true if evaluation completes, false otherwise.
41 12687dd9 2023-08-04 jrmu (define (clear-bulb color x-posn)
42 12687dd9 2023-08-04 jrmu (op-bulb clear-solid-disk color x-posn))
44 12687dd9 2023-08-04 jrmu ;draw-border : number -> true
45 12687dd9 2023-08-04 jrmu ;Draws the borders for the 3 traffic lights given x-posn.
47 12687dd9 2023-08-04 jrmu (define (draw-border x-posn)
48 12687dd9 2023-08-04 jrmu (and (draw-circle (make-posn x-posn Y-RED) (+ RADIUS 1) 'black)
49 12687dd9 2023-08-04 jrmu (draw-circle (make-posn x-posn Y-YELLOW) (+ RADIUS 1) 'black)
50 12687dd9 2023-08-04 jrmu (draw-circle (make-posn x-posn Y-GREEN) (+ RADIUS 1) 'black)))
52 12687dd9 2023-08-04 jrmu ;switch : symbol symbol number -> true
53 12687dd9 2023-08-04 jrmu ;Switches clear to fill for the lightbulb given x-posn.
55 12687dd9 2023-08-04 jrmu (define (switch clear fill x-posn)
57 12687dd9 2023-08-04 jrmu (fill-bulb fill x-posn)
58 12687dd9 2023-08-04 jrmu (clear-bulb clear x-posn)))
62 12687dd9 2023-08-04 jrmu ;;make-traffic-light : symbol number -> (symbol -> true)
63 12687dd9 2023-08-04 jrmu ;;Consumes location and x-posn, which indicates the position of the traffic light.
64 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).
66 12687dd9 2023-08-04 jrmu (define (make-traffic-light location x-posn)
68 12687dd9 2023-08-04 jrmu (;;State Variable:
69 12687dd9 2023-08-04 jrmu ;;current-color : TL-color
70 12687dd9 2023-08-04 jrmu (define current-color 'red)
72 12687dd9 2023-08-04 jrmu ;;next : -> true
73 12687dd9 2023-08-04 jrmu ;;Effect: Changes current-color from 'red to 'green, 'green to 'yellow,
74 12687dd9 2023-08-04 jrmu ;;or 'yellow to 'red depending on what the current-color is. Returns true.
75 12687dd9 2023-08-04 jrmu (define (next)
76 12687dd9 2023-08-04 jrmu (local ((define previous-color current-color))
77 12687dd9 2023-08-04 jrmu (begin (set! current-color (next-color current-color))
78 12687dd9 2023-08-04 jrmu (switch previous-color current-color x-posn))))
80 12687dd9 2023-08-04 jrmu ;next-color : TL-color -> TL-color
81 12687dd9 2023-08-04 jrmu ;Given acolor, returns the next logical color.
82 12687dd9 2023-08-04 jrmu (define (next-color acolor)
84 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'red) 'green]
85 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'yellow) 'red]
86 12687dd9 2023-08-04 jrmu [(symbol=? acolor 'green) 'yellow]))
88 12687dd9 2023-08-04 jrmu ;;init-current-color : -> true
89 12687dd9 2023-08-04 jrmu ;;Opens the canvas and draws the outline of the 3 traffic light
90 12687dd9 2023-08-04 jrmu ;;bulbs as well as lighting up the red lightbulb.
91 12687dd9 2023-08-04 jrmu (define (init-traffic-light)
92 12687dd9 2023-08-04 jrmu (begin (draw-border x-posn)
93 12687dd9 2023-08-04 jrmu (clear-bulb current-color x-posn)
94 12687dd9 2023-08-04 jrmu (set! current-color 'red)
95 12687dd9 2023-08-04 jrmu (fill-bulb current-color x-posn)))
96 12687dd9 2023-08-04 jrmu (define (service-manager msg)
98 12687dd9 2023-08-04 jrmu [(symbol=? msg 'next) (next)]
99 12687dd9 2023-08-04 jrmu [(symbol=? msg 'reset) (init-traffic-light)]
100 12687dd9 2023-08-04 jrmu [else (error 'service-manager "message not understood")])))
101 12687dd9 2023-08-04 jrmu (begin (init-traffic-light)
102 12687dd9 2023-08-04 jrmu service-manager)))
104 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
105 12687dd9 2023-08-04 jrmu (define lights
106 12687dd9 2023-08-04 jrmu (list (make-traffic-light 'AdobeCircle 50)
107 12687dd9 2023-08-04 jrmu (make-traffic-light 'Pereira 200)
108 12687dd9 2023-08-04 jrmu (make-traffic-light 'CampusDr 350)
109 12687dd9 2023-08-04 jrmu (make-traffic-light 'HarvardSt 500)
110 12687dd9 2023-08-04 jrmu (make-traffic-light 'BrenRd 650)
111 12687dd9 2023-08-04 jrmu (make-traffic-light 'UniversityBlvd 800)))
114 12687dd9 2023-08-04 jrmu ;;Controller
116 12687dd9 2023-08-04 jrmu (define (next-callback event)
117 12687dd9 2023-08-04 jrmu (andmap (lambda (a-light) (a-light 'next)) lights))
119 12687dd9 2023-08-04 jrmu (define (reset-callback event)
120 12687dd9 2023-08-04 jrmu (andmap (lambda (a-light) (a-light 'reset)) lights))
122 12687dd9 2023-08-04 jrmu (define next-buttons
123 12687dd9 2023-08-04 jrmu (build-list (length lights)
124 12687dd9 2023-08-04 jrmu (lambda (n)
125 12687dd9 2023-08-04 jrmu (local ((define (next-indiv-callback event)
126 12687dd9 2023-08-04 jrmu ((list-ref lights n) 'next)))
127 12687dd9 2023-08-04 jrmu (make-button (number->string (add1 n)) next-indiv-callback)))))
129 12687dd9 2023-08-04 jrmu (create-window (list (list (make-button "Next" next-callback)
130 12687dd9 2023-08-04 jrmu (make-button "Reset" reset-callback))
131 12687dd9 2023-08-04 jrmu next-buttons))
