;; 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-demo) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
;; Collaboration worlds take turns moving a ball

;                                                          
;                                                          
;                                                    ;;;   
;                                                      ;   
;                         ;                            ;   
;   ; ;;   ; ;;;   ;;;   ;;;;;   ;;;    ;;;;   ;;;     ;   
;   ;;  ;  ;;  ;  ;   ;   ;     ;   ;  ;      ;   ;    ;   
;   ;   ;  ;      ;   ;   ;     ;   ;  ;      ;   ;    ;   
;   ;   ;  ;      ;   ;   ;     ;   ;  ;      ;   ;    ;   
;   ;;  ;  ;      ;   ;   ;     ;   ;  ;      ;   ;    ;   
;   ; ;;   ;       ;;;     ;;;   ;;;    ;;;;   ;;;     ;   
;   ;                                                      
;   ;                                                      

#|


   server 
     *         sam         carl 
     |          *           * 
     | i'm here |           |
     | <======= |           |
     |          | i'm here  |
     | <=================== |           actors can register anytime 
     |          |           |
     |    go!   |           |
     | -------> |           |           actors get 'go!' messages 
     |          | i'm here  |     mitch in order of registration 
     | <=========================== *
     |   done   |           |       |
     | <------- |           |       |   only one actor is active 
     |          |   go!     |       |
     | -------------------> |       |
     |          |  done     |       |
     | <------------------- |       |
     |          |           |  go! |
     | ---------------------------> |
     |          |           |       |               
     |          +           |       |   actors can leave anytime 
     |                      | done  |
     | <--------------------------- |
     |              go!     |       |
     | -------------------> |       |
     |                      +       |   ... including when active 
     |                        go!   |
     | ---------------------------> |   but the band plays on 

 World and Messages: 
 ;; World    = Number | 'resting 
 ;; ReceivedMessage = 'go
 ;; SendMessages    = 'done 

 Server and Messages: 
 ;; ReceivedMessages = 'done
 ;; SendMessages     = 'go 

 For data representations of the Server and Client states, see below. 
|#

(require 2htdp/universe)

;                                            
;                                            
;                                            
;                                            
;                                            
;    ;;;;   ;;;   ; ;;;  ;   ;   ;;;   ; ;;; 
;   ;      ;   ;  ;;  ;  ;   ;  ;   ;  ;;  ; 
;    ;;    ;;;;;  ;       ; ;   ;;;;;  ;     
;      ;   ;      ;       ; ;   ;      ;     
;       ;  ;      ;       ; ;   ;      ;     
;   ;;;;    ;;;;  ;        ;     ;;;;  ;     
;                                            
;                                            

;; -----------------------------------------------------------------------------
;; Universe = [Listof IWorld]
;; BallMail = (make-mail IWorld 'go)
;; Result   = (make-bundle [Listof IWorld] [Listof BallMail] '())

(define Result0 (make-bundle '() '() '()))

;; -----------------------------------------------------------------------------
;; [Listof IWorld] -> Result
;; create bundle with a singleton list of mails to the first world on the list 
(define (mail2 lw)
  (make-bundle lw (list (make-mail (first lw) 'go)) '()))

;; -----------------------------------------------------------------------------
;; Universe IWorld -> Result
;; add w to the list of worlds; get the first one to play 

(check-expect (add-world '() iworld1) (mail2 (list iworld1)))

(define (add-world univ wrld)
  (mail2 (append univ (list wrld))))

;; -----------------------------------------------------------------------------
;; Universe IWorld Sexp -> Result
;; w sent message m in universe u 

(check-expect
 (switch (list iworld1 iworld2) iworld1 'go) (mail2 (list iworld2 iworld1)))

(check-error 
 (switch (list iworld1 iworld2) iworld2 'go) "switch: wrong world sent message")

(check-error 
 (switch (list iworld2 iworld1) iworld2 'stop) "switch: bad message")

(define (switch u w m)
  (local ((define fst (first u))
          (define nxt (append (rest u) (list fst))))
    (cond
      [(and (iworld=? fst w) (symbol=? m 'go)) (mail2 nxt)]
      [(iworld=? fst w) (error "switch: bad message")]
      [else (error "switch: wrong world sent message")])))

;; -----------------------------------------------------------------------------
;; [Listof IWorld] Universe IWorld -> Result
;; w disconnected from the universe 

(check-expect (disconnect (list iworld1 iworld2 iworld3) iworld2) 
              (mail2 (list iworld1 iworld3)))
(check-expect (disconnect '() iworld2) Result0)

(define (disconnect u w)
  (local ((define nxt (remq w u)))
    (if (empty? nxt) Result0  (mail2 nxt))))

;; IWorld [Listof IWorld] -> [Listof IWorld]
;; remove w from low

(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))

(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)))]))

;; -- run program run 

;; Any -> Universe
;; launch a univers server 
(define (run _)
  (universe '() 
            (on-new add-world)
            (on-msg switch)
            (on-disconnect disconnect)))

;                                            
;                                            
;          ;;;                               
;            ;       ;                       
;            ;                          ;    
;    ;;;;    ;     ;;;    ;;;   ; ;;   ;;;;; 
;   ;        ;       ;   ;   ;  ;;  ;   ;    
;   ;        ;       ;   ;;;;;  ;   ;   ;    
;   ;        ;       ;   ;      ;   ;   ;    
;   ;        ;       ;   ;      ;   ;   ;    
;    ;;;;    ;       ;    ;;;;  ;   ;    ;;; 
;                                            
;                                            

;; World   = Number | 'resting 
(define WORLD0 'resting)

;; constants 
(define HEIGHT 100)
(define DefWidth 50)

;; visual constants 
(define BALL (circle 3 'solid 'red))

(define mt (nw:rectangle DefWidth HEIGHT 'solid 'gray))

;; -----------------------------------------------------------------------------
;; Number (U String Symbol) -> true
;; create and hook up a player with the localhost server 
(define (make-player width t)
  (local ((define mt (place-image (text (format "~a" t) 11 'black) 
                                  5 85 
                                  (empty-scene width HEIGHT)))
          
          ;; ----------------------------------------------------------------
          ;; World Number -> Message 
          ;; on receiving a message from server, place the ball at lower end or stop
          #|
          (check-expect (receive 'resting 'go) HEIGHT)
          (check-expect (receive HEIGHT 'go) HEIGHT)
          (check-expect (receive (- HEIGHT 1) 'go) (- HEIGHT 1))
          (check-expect (receive 0 'go) 0)
          |#
          (define (receive w n) 
            (cond
              [(number? w) w]
              [else HEIGHT]))
          ;; World -> World 
          #|
          (check-expect (move 'resting) 'resting)
          (check-expect (move HEIGHT) (- HEIGHT 1))
          (check-expect (move 0) (make-package 'resting 'go))
          |#
          (define (move x)
            (cond
              [(symbol? x) x]
              [(number? x) (if (<= x 0) (make-package 'resting 'go) (sub1 x))]))
          
          ;; World -> Scene 
          ;; render the world 
          
          ; (check-expect (draw 100) (place-image BALL 50 100 mt))
          
          (define (draw w)
            (cond
              [(symbol? w) (place-image (text "resting" 11 'red) 10 10 mt)]
              [(number? w) (place-image BALL 50 w mt)])))
    (big-bang WORLD0 
              (on-draw draw)
              (on-receive receive)
              (on-tick move .01)
              (name t)
              (check-with (lambda (w) (or (symbol? w) (number? w))))
              (state true)
              (register LOCALHOST))))


;; Number Number ->* World World
;; launch two players with screens of specified width 
(define (run-players w1 w2)
  (launch-many-worlds (make-player w1 "sam")
                      (make-player w2 "carl")))