;; 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-intermediate-lambda-reader.ss" "lang")((modname universe) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "htdp")))))

;; rotate through a bunch of players with the ball until nobody is left 

;; -----------------------------------------------------------------------------
;; Universe = '*

;; Result is (make-bundle [Listof World] '* [Listof (make-mail World SMessage)])
;; SMessage is 'go 

;; -----------------------------------------------------------------------------
;; [Listof World] Universe World -> Result
;; add w to the list of worlds; get the first one to play 
(define (add-world univ x wrld)
  (local ((define univ* (append univ (list wrld))))
    (make-bundle univ* x (list (make-mail (first univ*) 'go)))))

(check-expect (add-world '() '* world1) 
              (make-bundle (list world1) '* (list (make-mail world1 'go))))

;; -----------------------------------------------------------------------------
;; [Listof World] Universe World Sexp -> Result
;; w sent message m in universe u 
(define (switch u x w m)
  (local ((define fst (first u))
          (define nxt (append (rest u) (list fst))))
    (cond
      [(and (world=? fst w) (symbol=? m 'go))
       (make-bundle nxt x (list (make-mail (first nxt) 'go)))]
      [(world=? fst w) 
       (error 'switch (string-append "bad message: " (symbol->string m)))]
      [else (error 'switch "wrong world sent message")])))

(check-expect
 (switch (list world1 world2) '* world1 'go)
 (make-bundle (list world2 world1) '* (list (make-mail world2 'go))))

(check-error 
 (switch (list world1 world2) '* world2 'go) "switch: wrong world sent message")

(check-error 
 (switch (list world2 world1) '* world2 'stop) "switch: bad message: stop")

;; -----------------------------------------------------------------------------
;; [Listof World] Universe World -> Result
;; w disconnected from the universe 
(define (disconnect u x w)
  (local ((define nxt (remq w u)))
    (if (empty? nxt)
        (make-bundle '() '* empty)
        (make-bundle nxt '* (list (make-mail (first nxt) 'go))))))

(check-expect (disconnect (list world1 world2 world3) '* world2)
              (make-bundle (list world1 world3) '* (list (make-mail world1 'go))))
(check-expect (disconnect '() '* world2) (make-bundle '() '* '()))

;; World [Listof World] -> [Listof World]
;; remove w from low
(define (remq w low)
  (cond
    [(empty? low) '()]
    [else (local ((define fst (first low))
                  (define rst (remq w (rest low))))
            (if (eq? fst w) rst (cons fst rst)))]))

(check-expect (remq 'a '(a b c)) '(b c))
(check-expect (remq 'a '(a b a c)) '(b c))
(check-expect (remq 'b '(a b a c)) '(a a c))

;; -- run program run 

(universe '() 
          (on-new add-world)
          (on-msg switch)
          (on-disconnect disconnect)
          (to-string 
           (lambda (low u)
             (string-append 
              (string-append "there are " (number->string (length low)) " world(s)")
              (apply string-append (map symbol->string (map world-name low)))))))