Player

  (define player/c (flat-named-contract "Player" player?))
  
  (provide/contract
   ...
   [player-take-turn   (-> player/c turn/c done/c)]
   ;; grant this player a turn with at least one card on either deck or stack
   ;; EXERCISE (TASK 4): what must hold true for the cards in player/c and turn/c?
   ;; what can you express? what can't you express?
   ...

Turn, ProxyTurn

  (define turn/c (flat-named-contract "Turn" turn?))
  
  ;; Turn -> Contract
  ;; ... is the given value a natural number in (0,N]
  ;; where N is the depth of this turn's stack
  (define (in-range t)
    (and/c natural-number/c (>/c 0) (<=/c (stack-depth (turn-stack-inspect t)))))
  
  ;; Alliance -> (Squadron -> Boolean)
  (define (anti? a)
    (lambda (bs)
      (alliance=? (enemy (squadron-alliance bs)) a)))

  (provide/contract
     ...
     ;; --- ADMINISTRATOR INTERFACE ---
     [create-turn (-> string? deck/c stack/c (listof discard-bomber/c) turn/c)]
     ;; create a turn that assumes the player isn't cheating
     ;; EXERCISE: what must hold true for the deck, stack, and the discards?

     [turn-end    (-> turn/c from/c)]
     ;; did the turn use the top-most card on the deck or some number of stack cards
     ;; TIME: must take place after get-cards-from-stack or
     ;; get-a-card-from-deck has been called [otherwise player is incorrect]

     ;; --- PLAYER INTERFACE ---
     [turn-card-on-deck?        (-> turn/c boolean?)]
     ;; is there are a card on the deck?

     [turn-get-a-card-from-deck (-> turn/c card?)]
     ;; what cards are available from this turn's stack
     ;; TIME: neither get-card-from-stack nor this function has been called

     [turn-stack-inspect        (-> turn/c (listof card?))]
     ;; what cards are available from this turn's stack?

     [turn-get-cards-from-stack (->r ([t turn/c][n (in-range t)]) 
				     (and/c (listof card?) 
					    (lambda (c) (= (length c) n))))]
     ;; take a bunch of cards from the stack during this turn
     ;; TIME: neither get-a-card-from-deck nor this function has been called

     [turn-can-attack?          (->r ([t turn/c]
				      [a alliance?])
				     (listof (and/c discard-bomber/c (anti? a))))]
     ;; which players/bombers can you attack in this turn given an A fighter?
     ...

Turn Results

  (define from/c (or/c from-deck? from-stack?))
  
  (define done/c (flat-named-contract "Done" done?))
  
  (define discard/c (flat-named-contract "Discard" squadron-complete?))
  
  (define discard-bomber/c (and/c discard/c squadron-bomber?))
  
  (define discard-fighter/c (and/c discard/c squadron-fighter?))
  
  (define discard*/c (and/c (listof discard/c) (setof discard/c)))

  (define attack/c (flat-named-contract "Attack" attack?))

  ;; Squadron -> (Squadron -> Boolean)
  ;; does b belong to the alliance ooposing f?
  (define (opposed? f)
    (define alliance (squadron-alliance f))
    (flat-named-contract 
     `(opposed-to: ,alliance)
     (lambda (b)
       (alliance=? (enemy alliance) (squadron-alliance b)))))
  
  (define attack*/c 
    (and/c (listof attack/c) 
           (setof attack/c)
           (flat-named-contract '(setof fighters)
            (lambda (x) (set? (map attack-fighters x))))
           (flat-named-contract '(setof bombers)
            (lambda (x) (set? (map attack-bombers x))))))

  (provide/contract
   ;; results for turn-end:
   [struct from-deck  ()]
   [struct from-stack ([count natural-number/c])]

   ...
   
   [struct done       ((attacks attack*/c) (discards discard*/c))]
   [struct (end done) ((attacks attack*/c) (discards discard*/c) (card borc/c))]
   [struct (ret done) ((attacks attack*/c) (discards discard*/c) (card card?))]
   
   [make-attack       (->r ([f discard-fighter/c][b (and/c discard-bomber/c (opposed? f))]) attack/c)]
   [attack-fighters   (-> attack/c discard-fighter/c)]
   [attack-bombers    (-> attack/c discard-bomber/c)]
   ...

Squadrons

  ;; -> (Card -> Boolean)
  ;; is this a card
  (define (all-same-name-or-wild-card squad)
    (define name "")
    (andmap (lambda (crd)
	      (or (wild-card? crd) 
		  (let ([a (aircraft-name crd)])
		    (when (string=? name "") (set! name a))
		    (string=? a name))))
            squad))

  ;; Any -> Boolean
  ;; is this list of cards a true squadron?
  (define (squadron? squad)
    (and (list? squad) 
         (andmap card? squad)
         (pair? (filter aircraft? squad))
	 (all-same-name-or-wild-card squad)))

  (define squadron/c (flat-named-contract "Squadron" squadron?))

  (provide/contract 
    [squadron/c  contract?]
    ...

For a brief tutorial on PLT Scheme's contract system, see Findler and Felleisen's FAQ .

Last modified: Monday, March 12th, 2007 7:13:38pm