;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname lab9) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require 2htdp/universe)
(require 2htdp/image)

;; -----------------------------------------------------------------------------
;; This program consists of a central universe server and any number of worlds. 

;; The universe server sends a Server2World message to a world when it is 
;; its turn to display a blue spot. When a world sends a message back, the server 
;; rotates its list of worlds and hands the token to the next world in line. 

;; When a world receives a Server2World messagae from the universe server, it
;; may display a blue dot until the clock ticks. When the clock ticks, the world
;; sends the universe server a World2Universe message, signaling that it is 
;; returning the token. 

;; Server2World is 'go. 
;; World2Server is 'next. 

;; -----------------------------------------------------------------------------
;; WORLDs 

;; TokenState is Boolean. 
;; interpretation: true if the world has the token and may display a blue dot. 

(define BACKGROUND (empty-scene 200 200))
(define DOT (circle 99 'solid 'blue))

;; String[Name] String[IP] -> Boolean
;; create a world with name n that communicates with server at IP  
(define (make-world n ip-address)
  (big-bang false
            [to-draw render]
            [on-tick flip-and-send-token 3]
            [on-receive receive-token]
            [name n]
            [register ip-address]))

;; TokenState Server2World -> TokenState 
;; receive a message (ignore content) and set state to true 

(check-expect (receive-token true 'any-stupid-sumbol) true)
(check-expect (receive-token false 'any-stupid-sumbol) true)

(define (receive-token _ts _msg)
  true)

;; TokenState -> [Package TokenState World2Server]
;; if this world has the token, it gives it up with a message to the Universe

(check-expect (flip-and-send-token true) (make-package false 'next))
(check-expect (flip-and-send-token false) false)

(define (flip-and-send-token ts)
  (if ts (make-package false 'next) ts))

;; TokenState -> Image 
;; render true (possession of token) as blue dot, otherwise blank

(check-expect (render false) BACKGROUND)
(check-expect (render true) (overlay DOT BACKGROUND))

(define (render ts)
  (if ts (overlay DOT BACKGROUND) BACKGROUND))

;; -----------------------------------------------------------------------------
;; UNIVERSE 

;; UniverseState is [List-of IWorld]. 
;; interpretation: the universe tracks the worlds that have joined it so far; 
;; the first world in the list is the one that currently holds the token. 

(define us1 (list iworld1))
(define us1-2 (list iworld1 iworld2))
(define us2-1 (list iworld2 iworld1))

;; UniverseBundle is
;;     [Bundle UniverseState Server2World]
;; interpretation: a bundle contains the current state of the universe, 
;; the mails that should be sent to the worlds, and a list of worlds to be
;; thrown out (say for bad behavior)

;; Nat -> UniverseState 
;; create a universe hub that runs for n clock ticks and then shuts down 
(define (make-universe seconds-per-tick)
  (universe '()
            [on-tick do-nothing 1 seconds-per-tick]
            [on-new add-world]
            [on-msg switch-token]))

;; UniverseState IWorld World2Server -> UniverseBundle
;; move the current first world to the end of the list of participating worlds, 
;; and send token to the first world on the resulting list 
;; ASSUME: list of worlds is not empty 
;; (holds because a world is sending a message and 
;; the Universe must have added it to its state)

(check-expect (switch-token us1 iworld1 'next)
              (make-bundle us1 (list (make-mail iworld1 'go)) '()))
(check-expect (switch-token us2-1 iworld2 'next)
              (make-bundle us1-2 (list (make-mail iworld1 'go)) '()))

(define (switch-token us iw _msg) 
  (local ((define new-us (append (rest us) (list (first us)))))
    (make-bundle new-us (list (make-mail (first new-us) 'go)) '())))

;; UniverseState IWorld -> UniverseBundle 
;; add the new world to the end of the universe's list of participating worlds
;; and send token to the first world on the resulting list

(check-expect (add-world '() iworld1) 
              (make-bundle us1 (list (make-mail iworld1 'go)) '()))

(check-expect (add-world us1 iworld2) 
              (make-bundle us1-2 (list (make-mail iworld1 'go)) '()))

(define (add-world us iw)
  (local ((define new-us (append us (list iw))))
    (make-bundle new-us (list (make-mail (first new-us) 'go)) '())))

;; UniverseState -> UniverseBundle
;; create a bundle from the current state, empty list of mail, 
;; and an empty list of worlds to be destroyed 

(define us-random (random 1000))
(check-expect (do-nothing us-random) (make-bundle us-random '() '()))

(define (do-nothing us)
  (make-bundle us '() '()))

;; -----------------------------------------------------------------------------
;; RUN SAMPLE PROGRAM RUN

;; Nat -> [List-of IWorld] Boolean Boolean 
;; run three worlds that hand over a token every so often [NOT TESTABLE]
(define (token-ring n)
  (launch-many-worlds (make-universe n) 
                      (make-world "kathleen" LOCALHOST)
                      (make-world "becca" LOCALHOST)
                      (make-world "claire" LOCALHOST)))