Exercise 6.2.5: (back)
;; dimensions of traffic light (define WIDTH 50) (define HEIGHT 160) (define BULB-RADIUS 20) (define BULB-DISTANCE 10) ;; the positions of the bulb (define X-BULBS (quotient WIDTH 2)) (define Y-RED (+ BULB-DISTANCE BULB-RADIUS)) (define Y-YELLOW (+ Y-RED BULB-DISTANCE (* 2 BULB-RADIUS))) (define Y-GREEN (+ Y-YELLOW BULB-DISTANCE (* 2 BULB-RADIUS))) ;; clear-bulb: symbol -> symbol (define (clear-bulb bulb) (cond [(symbol=? bulb 'red) (and (hide-disk bulb) (show-circle bulb))] [(symbol=? bulb 'yellow) (and (hide-disk bulb) (show-circle bulb))] [(symbol=? bulb 'green) (and (hide-disk bulb) (show-circle bulb))])) ;; draw-bulb: symbol -> symbol (define (draw-bulb bulb) (cond [(symbol=? bulb 'red) (and (hide-circle bulb) (show-disk bulb))] [(symbol=? bulb 'yellow) (and (hide-circle bulb) (show-disk bulb))] [(symbol=? bulb 'green) (and (hide-circle bulb) (show-disk bulb))])) ;; switch: symbol symbol -> symbol (define (switch bulb1 bulb2) (and (clear-bulb bulb1) (draw-bulb bulb2))) ;; hide-disk: symbol -> symbol (define (hide-disk bulb) (cond [(symbol=? bulb 'red) (clear-solid-disk (make-posn X-BULBS Y-RED) BULB-RADIUS 'red)] [(symbol=? bulb 'yellow) (clear-solid-disk (make-posn X-BULBS Y-YELLOW) BULB-RADIUS 'yellow)] [(symbol=? bulb 'green) (clear-solid-disk (make-posn X-BULBS Y-GREEN) BULB-RADIUS 'green)])) ;; show-circle: symbol -> symbol (define (show-circle bulb) (cond [(symbol=? bulb 'red) (draw-circle (make-posn X-BULBS Y-RED) BULB-RADIUS 'red)] [(symbol=? bulb 'yellow) (draw-circle (make-posn X-BULBS Y-YELLOW) BULB-RADIUS 'yellow)] [(symbol=? bulb 'green) (draw-circle (make-posn X-BULBS Y-GREEN) BULB-RADIUS 'green)])) ;; hide-cicle: symbol -> symbol (define (hide-circle bulb) (cond [(symbol=? bulb 'red) (clear-circle (make-posn X-BULBS Y-RED) BULB-RADIUS 'red)] [(symbol=? bulb 'yellow) (clear-circle (make-posn X-BULBS Y-YELLOW) BULB-RADIUS 'yellow)] [(symbol=? bulb 'green) (clear-circle (make-posn X-BULBS Y-GREEN) BULB-RADIUS 'green)])) ;; show-circle: symbol -> symbol (define (show-disk bulb) (cond [(symbol=? bulb 'red) (draw-solid-disk (make-posn X-BULBS Y-RED) BULB-RADIUS 'red)] [(symbol=? bulb 'yellow) (draw-solid-disk (make-posn X-BULBS Y-YELLOW) BULB-RADIUS 'yellow)] [(symbol=? bulb 'green) (draw-solid-disk (make-posn X-BULBS Y-GREEN) BULB-RADIUS 'green)])) ;; next : symbol -> symbol ;; to switch a traffic light's current color and to return the next one (define (next current-color) (cond [(and (symbol=? current-color 'red) (switch 'red 'green)) 'green] [(and (symbol=? current-color 'yellow) (switch 'yellow 'red)) 'red] [(and (symbol=? current-color 'green) (switch 'green 'yellow)) 'yellow])) ;; draw the light with the red bulb turned on (start WIDTH HEIGHT) (draw-bulb 'red) (next 'red) (next 'green) (next 'yellow) (next 'red)