;; 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-beginner-reader.ss" "lang")((modname war-universe) (read-case-sensitive #t) (teachpacks ((lib "testing.ss" "teachpack" "htdp") (lib "universe.ss" "teachpack" "2htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "testing.ss" "teachpack" "htdp") (lib "universe.ss" "teachpack" "2htdp")))))
;; The War game admnistrator
;; There are two players - each receives a deck of cards on signing up
;; when both have send in the cards they play, compare the cards 
;; and send both cards to the winner

;; A Play is (make-play String String)
(define-struct play (card1 card2))

;; examples of play:
(define one-only (make-play "" "Kd"))
(define two-only (make-play "8h" ""))
(define none-yet (make-play "" ""))
(define one-wins (make-play "8h" "2d"))
(define two-wins (make-play "8h" "Jd"))

;; Universe state:
;; Number Number Play [Listof World]
;; Interpretation: number of cards each player has; the list of cards played by each
(define-struct war (p1 p2 played worlds))

;; initial universes
(define war-none (make-war 0 0 none-yet empty))
(define war-one (make-war 20 0 one-only (list iworld1)))
(define war-two (make-war 20 12 two-wins (list iworld1 iworld2)))

;; sample two decks to give to the players
(define deck1 (list "Kh" "Qd" "3s" "8c"))
(define deck2 (list "Jh" "Ad" "9s" "5c"))



;; if both players are in the game (have more than one card)
;; disconnect the incomming player
;; if-not-ok: UniverseState World -> [Listof World]
(define (if-not-ok a-war iw)
  (cond
    [(and (> (war-p1 a-war) 0) (> (war-p2 a-war) 0)) (list iw)]
    [else empty]))

;; test if-not-ok:
(check-expect (if-not-ok war-none iworld3) empty)
(check-expect (if-not-ok war-one iworld3) empty)
(check-expect (if-not-ok war-two iworld3) (list iworld3))


;; if there are not yet two players, add the new world to the list of worlds
;; add-if-ok: UniverseState World -> UniverseState
(define (add-if-ok a-war iw)
  (cond
    [(eq? (war-p2 a-war) 0) (make-war 0 4 none-yet (list iw))]
    [(eq? (war-p1 a-war) 0) (make-war 4 (war-p2 a-war) none-yet (cons iw (war-worlds a-war)))]
    [else a-war]))

;; an additional universe example:
(define war-one-on (make-war 0 20 one-only (list iworld1)))

;; test add-if-ok:
(check-expect (add-if-ok war-none iworld1)
              (make-war 0 4 none-yet (list iworld1)))
(check-expect (add-if-ok war-one-on iworld2)
              (make-war 4 20 none-yet (list iworld2 iworld1)))
(check-expect (add-if-ok war-two iworld1)
              war-two)

;; send the new workd its initial deck of cards
;; mail-to: UniverseState World -> Mail 
;; remember: Mail is (make-mail World SExp)
(define (mail-to a-war iw) 
  (cond 
    [(eq? (war-p2 a-war) 0) (list (make-mail iw deck2))]
    [(eq? (war-p1 a-war) 0) (list (make-mail iw deck1))]
    [else empty]))

;; test mail-to:
(check-expect (mail-to war-none iworld2)
              (list (make-mail iworld2 deck2)))
(check-expect (mail-to war-one-on iworld1)
              (list (make-mail iworld1 deck1)))
(check-expect (mail-to war-two iworld1)
              empty)

; Bundle is
;   (make-bundle UniverseState [Listof mail?] [Listof iworld?])
  
; add the given world to the universe, if appropriate
;     send a message to the given world if the request is denied
;     if accepted, send the world its inital deck of cards
; add-world: UniverseState World -> Bundle
;
; Bundle: [add iw to the list of worlds the universe keeps: 
;                             --- only two are allowed] 
;         [make a mail to iw with its deck]
;         [disconnect a world if it is not allowed to join]  
(define (add-world a-war iw)
  (make-bundle (add-if-ok a-war iw) 
               (mail-to a-war iw)
               (if-not-ok a-war iw)))

;; test add-world:
(check-expect (add-world war-none iworld2)
              (make-bundle (make-war 0 4 none-yet (list iworld2))
                           (list (make-mail iworld2 deck2))
                           empty))
(check-expect (add-world war-one-on iworld2)
              (make-bundle (make-war 4 20 none-yet (list iworld2 iworld1))
                           (list (make-mail iworld2 deck1))
                           empty))
(check-expect (add-world war-two iworld3)
              (make-bundle (make-war 20 12 two-wins (list iworld1 iworld2))
                           empty
                           (list iworld3)))

;; process a message
;; just send the card back to the player for now
;; process: UniverseState IWorld Message -> Bundle
(define (process a-war iw a-card)
  (make-bundle a-war
               (list (make-mail iw (list a-card)))
               empty))

;; test the fake process function:
(check-expect (process war-two iworld2 "Ks")
              (make-bundle war-two
                           (list (make-mail iworld2 (list "Ks")))
                           empty))



;; When a world wants to disconnect, just let it do so.
;; Remove it from the list of world the universe keeps
;; and send no messages 
;; disconnect-world: Universe World -> Bundle
(define (disconnect-world a-war iw)
  (make-bundle (make-war (war-p1 a-war) 
                         (war-p2 a-war) 
                         (war-played a-war) 
                         (remove-item (war-worlds a-war) iw))
               empty
               (list iw)))

;; test disconnect-world:
(check-expect 
 (disconnect-world war-two iworld1) 
 (make-bundle (make-war 20 12 two-wins (list iworld2)) 
              empty (list iworld1)))


;; remove-item the given item from the given list
(define (remove-item alist an-item)
  (cond
    [(empty? alist) empty]
    [(eq? an-item (first alist)) (rest alist)]
    [else (cons (first alist) (remove-item (rest alist) an-item))]))

;; test remove-item:
(check-expect (remove-item (list 4 5 6) 7) (list 4 5 6))
(check-expect (remove-item (list 4 5 6) 6) (list 4 5))
  

;;---------------------------------------------
;; Start the universe with no players signed up
(universe war-none
          (on-new add-world)
;          (check-with cons?)
          (on-disconnect disconnect-world)
          (on-msg process))