;; The Traffic Light Problem, with Emergency Switch 
;; -----------------------------------------------------------------------------
;; DATA DEFINITION
;; ---------------
;; TLState is one of: 
;; -- 'red
;; -- 'yellow
;; -- 'green 
;; --------- for the extension ---------
;; -- 'red-on
;; -- 'red-off 

;; CONSTANTS
;; ---------
(define WIDTH   60)
(define RADIUS  (quotient WIDTH 2)) ;; <--- note computed constant
(define CENTER  RADIUS)
(define HEIGHT  (* 6 RADIUS))
(define YRED    RADIUS)
(define YYELLOW (* 3 RADIUS))
(define YGREEN  (* 5 RADIUS))

;; visual constants 
(define PLAIN (nw:rectangle WIDTH HEIGHT 'solid 'white))

(define LIGHT 
  (place-image
   (circle RADIUS 'outline 'red) CENTER YRED
   (place-image 
    (circle RADIUS 'outline 'yellow) CENTER YYELLOW
    (place-image
     (circle RADIUS 'outline 'green) CENTER YGREEN
     PLAIN))))

;; -----------------------------------------------------------------------------
;; next : TLState -> TLState 
;; switch to the next state of the traffic light 

(check-expect (next 'red) 'green)
(check-expect (next 'green) 'yellow)
(check-expect (next 'yellow) 'red)
;; --------- for the extension ---------
(check-expect (next 'red-on) 'red-off)
(check-expect (next 'red-off) 'red-on)

(define (next s)
  (cond
    [(symbol=? s 'red) 'green]
    [(symbol=? s 'green) 'yellow]
    [(symbol=? s 'yellow) 'red]
    ;; --------- for the extension ---------
    [(symbol=? s 'red-on) 'red-off]
    [(symbol=? s 'red-off) 'red-on]))

;; -----------------------------------------------------------------------------
;; render : TLState -> Scene
;; render the traffic light as a scene 

(check-expect (render 'yellow) (turn-on 'yellow YYELLOW))
(check-expect (render 'red) (turn-on 'red YRED))
(check-expect (render 'green) (turn-on 'green YGREEN))
;; --------- for the extension --------- 
(check-expect (render 'red-off) LIGHT)
(check-expect (render 'red-on) (turn-on 'red YRED))


(check-expect (render 'red-off) LIGHT)

(define (render s)
  (cond
    [(symbol=? s 'red) (turn-on 'red YRED)]
    [(symbol=? s 'green) (turn-on 'green YGREEN)]
    [(symbol=? s 'yellow) (turn-on 'yellow YYELLOW)]
    ;; --------- for the extension ---------
    [(symbol=? s 'red-on)  (turn-on 'red YRED)]
    [(symbol=? s 'red-off) LIGHT]))

;; an auxiliary function: 
;; turn-on : ColorSymbol Number -> Scene
;; add the specified color disk at the given height to the scene

(check-expect
  (turn-on 'yellow YYELLOW)
  (place-image (circle RADIUS 'solid 'yellow) CENTER YYELLOW LIGHT))

(define (turn-on c y)
  (place-image (circle RADIUS 'solid c) CENTER y LIGHT))

;; -----------------------------------------------------------------------------
;; TLState KeyEvent -> TLState 
;; turn on failure state or off, if space bar is pressed 

(check-expect (failure-switch 'green #\space) 'red-on)
(check-expect (failure-switch 'yellow #\space) 'red-on)
(check-expect (failure-switch 'red #\space) 'red-on)
(check-expect (failure-switch 'red-on #\space) 'red)
(check-expect (failure-switch 'red-off #\space) 'red)
(check-expect (failure-switch 'red 'release) 'red)
(check-expect (failure-switch 'green 'release) 'green)

(define (failure-switch s ke)
  (cond
    [(key=? ke #\space)
     (cond
       [(symbol=? s 'red) 'red-on]
       [(symbol=? s 'green) 'red-on]
       [(symbol=? s 'yellow) 'red-on]
       ;; --------- for the extension ---------
       [(symbol=? s 'red-on)  'red]
       [(symbol=? s 'red-off) 'red])]
    [else s]))

;; -----------------------------------------------------------------------------
;; RUN 
(define (run state0)
  (and (big-bang WIDTH HEIGHT 1 state0)
       (on-redraw render)
       (on-key-event failure-switch)
       (on-tick-event next)))