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)