;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#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")))))
;TODO:
;
;Fill in examples for make-city
;Abstract x-posn using absolute definitions

#|
Exercise 39.2.1.   Develop the program make-city. It manages a collection of traffic lights. The program should provide four services:

   1. adding a traffic light with a label (string);
   2. removing a traffic light by label;
   3. switching the state of a traffic light with some given label; and
   4. resetting a traffic light to red with some given label.

Hint: The first two services are provided directly; the last two are implemented by the simulated traffic lights.

After the development of the program is completed, develop a graphical user interface.    Solution
|#

;;Data Definition
;;A traffic-light color (TL-color) is either
;;1. 'red,
;;2. 'yellow, or
;;3. 'green.

;;A traffic-light is an interface
;;1. 'next : -> true
;;2. 'reset : -> true

;;A city is an interface
;;1.'add-light :: symbol -> void
;;2.'remove-light :: symbol -> void
;;3.'access-light :: symbol -> traffic-light

;make-city : symbol -> city
;;Consumes location.  Produces a city interface, which can ultimately be used to perform 4 possible services: 

;;   1. adding a traffic light with a label (string);
;;   2. removing a traffic light by label;
;;   3. switching the state of a traffic light with some given label; and
;;   4. resetting a traffic light to red with some given label.

;;Examples

;;((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.
;;(define my-city (make-city "Los Angeles"))
;;((my-city 'add-light) 'Boulevard)
;;((my-city 'add-light) 'Street)
;;((my-city 'add-light) 'Drive)
;;((my-city 'add-light) 'Road)
;;Should give a city with 4 traffic-lights and should draw 4 traffic lights on a canvas.

(define (make-city location)
  (local
    (;;State Variables:
     ;;city-lights : (listof (list symbol traffic-light))
     ;;Records the traffic-lights in the city, the first symbol represents the location
     (define city-lights empty)
     
     ;;add-light : symbol -> void
     ;;Effect: Adds (list symbol traffic-light) to the front of city-lights
     (define (add-light alocation) 
       (local ((define x-posn (+ 200 (* 100 (sub1 (length city-lights))))))
         (set! city-lights
               (cons (list alocation (make-traffic-light alocation x-posn))
                     city-lights))))
     
     ;;remove-light : symbol -> void
     ;;Effect: Removes a light from city-lights
     (define (remove-light alocation)
       (local ((define (remove-aux alox x)
                 (filter (lambda (an-x) (not (equal? (first an-x) x))) alox))
               (define x-posn (+ 200 (* 100 (sub1 (sub1 (length city-lights)))))))
         (begin 
           (clear-bulb 'red x-posn) 
           (clear-bulb 'yellow x-posn)
           (clear-bulb 'green x-posn)
           (clear-border x-posn)
           (set! city-lights (remove-aux city-lights alocation)))))
     
     
     (define (access-light alocation)
       (local ((define (access-aux alox x)
                 (cond
                   [(empty? alox) false]
                   [(equal? (first (first alox)) x) (second (first alox))]
                   [else (access-aux (rest alox) x)])))
         (access-aux city-lights alocation)))
     (define (service-manager msg) 
       (cond
         [(equal? msg 'add-light) add-light]
         [(equal? msg 'remove-light) remove-light]
         [(equal? msg 'access-light) access-light]
         [else (error 'make-city "message not understood")])))
    service-manager))

;;Model

;;make-traffic-light : symbol number -> (symbol -> true)
;;Consumes location and x-posn, which indicates the position of the traffic light.
;;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).

(define (make-traffic-light location x-posn)
  (local
    (;;State Variable:
     ;;current-color : TL-color
     (define current-color 'red)
     
     ;;next : -> true
     ;;Effect: Changes current-color from 'red to 'green, 'green to 'yellow,
     ;;or 'yellow to 'red depending on what the current-color is.  Returns true.
     (define (next)
       (local ((define previous-color current-color))
         (begin (set! current-color (next-color current-color))
                (switch previous-color current-color x-posn))))
     
     ;next-color : TL-color -> TL-color
     ;Given acolor, returns the next logical color.
     (define (next-color acolor)
       (cond
         [(symbol=? acolor 'red) 'green]
         [(symbol=? acolor 'yellow) 'red]
         [(symbol=? acolor 'green) 'yellow]))
     
     ;;init-current-color : -> true
     ;;Opens the canvas and draws the outline of the 3 traffic light
     ;;bulbs as well as lighting up the red lightbulb.
     (define (init-traffic-light)
       (begin (draw-border x-posn)
              (clear-bulb current-color x-posn)
              (set! current-color 'red)
              (fill-bulb current-color x-posn)))
     (define (service-manager msg)
       (cond
         [(symbol=? msg 'next) (next)]
         [(symbol=? msg 'reset) (init-traffic-light)]
         [else (error 'service-manager "message not understood")])))
    (begin (init-traffic-light)
           service-manager)))


;;View

(define WIDTH 1000)
(define HEIGHT 340)
(define RADIUS 40)
(define INTERDIST 20)
(define Y-RED (+ INTERDIST RADIUS))
(define Y-YELLOW (+ Y-RED (* 2 RADIUS) INTERDIST))
(define Y-GREEN (+ Y-YELLOW (* 2 RADIUS) INTERDIST))

;;op-bulb : (posn N symbol -> true) symbol number -> boolean
;;Perform op on a bulb given op, color, and x-posn.

(define (op-bulb op color x-posn)
  (cond
    [(symbol=? color 'red)
     (op (make-posn x-posn Y-RED) RADIUS 'red)]
    [(symbol=? color 'yellow)
     (op (make-posn x-posn Y-YELLOW) RADIUS 'yellow)]
    [(symbol=? color 'green)
     (op (make-posn x-posn Y-GREEN) RADIUS 'green)]))

;; fill-bulb : symbol number -> boolean
;; Fills in a given bulb based on color and x-posn; returns true if the function evaluates properly, false otherwise.

(define (fill-bulb color x-posn)
  (op-bulb draw-solid-disk color x-posn))

;; clear-bulb : symbol number -> boolean
;; Clears a bulb given color and x-posn; returns true if evaluation completes, false otherwise.

(define (clear-bulb color x-posn)
  (op-bulb clear-solid-disk color x-posn))

;;op-border : (posn number symbol -> true) number -> true
;;Performs an operation on the borders of circles of a traffic light.

(define (op-border op x-posn)
  (and (op (make-posn x-posn Y-RED) (+ RADIUS 1) 'black)
       (op (make-posn x-posn Y-YELLOW) (+ RADIUS 1) 'black)
       (op (make-posn x-posn Y-GREEN) (+ RADIUS 1) 'black)))

;;draw-border : number -> true
;;Draws the borders for the 3 traffic lights given x-posn.

(define (draw-border x-posn)
  (op-border draw-circle x-posn))

;;clear-border : number -> true
;;Clears the borders for the 3 traffic lights given x-posn.

(define (clear-border x-posn)
  (op-border clear-circle x-posn))

;switch : symbol symbol number -> true
;Switches clear to fill for the lightbulb given x-posn.

(define (switch clear fill x-posn)
  (and
   (fill-bulb fill x-posn)
   (clear-bulb clear x-posn)))




#|
(define lights
  (list (make-traffic-light 'AdobeCircle 50)
        (make-traffic-light 'Pereira 200)
        (make-traffic-light 'CampusDr 350)
        (make-traffic-light 'HarvardSt 500)
        (make-traffic-light 'BrenRd 650)
        (make-traffic-light 'UniversityBlvd 800)))

(start WIDTH HEIGHT)

;;Controller

(define (next-callback event)
  (andmap (lambda (a-light) (a-light 'next)) lights))

(define (reset-callback event)
  (andmap (lambda (a-light) (a-light 'reset)) lights))

(define next-buttons
(build-list (length lights)
            (lambda (n)
              (local ((define (next-indiv-callback event)
                        ((list-ref lights n) 'next)))
                (make-button (number->string (add1 n)) next-indiv-callback)))))

(create-window (list (list (make-button "Next" next-callback)
                           (make-button "Reset" reset-callback))
                     next-buttons))

|#

(start WIDTH HEIGHT)

(define my-city (make-city "Los Angeles"))
((my-city 'add-light) 'Germany)
((my-city 'add-light) 'Naples)
((my-city 'add-light) 'Paris)
((my-city 'add-light) 'Italy)