(module cards mzscheme 
  (require (lib "class.ss")
           (lib "etc.ss")
           (lib "list.ss")
           (lib "mred.ss" "mred")
           (lib "xml.ss" "xml"))
  
  (require "basic-syntax.scm")
  
  #| A card reveals three pieces of information: 
     -- the name of the aircraft
     -- the alliance to which it belongs
     -- its category 
     -- For visual purposes, the card also includes a bitmap of the airplane.
  |#
  
  ;; The Card Setv contains
  ;; -- 3 cards per aircraft type,
  ;; -- plus one Victory card and
  ;; -- six Keep'em Flying cards
  (define KEEPEM 6)
  
  ;; The images for the cards are located in IMAGES
  (define IMAGES "aircrafts")
  
  ;; Card = (make-aircraft String Nat BF AA Bitmap%)
  ;;      | (make-victory Bitmap%)
  ;;      | (make-keepem Nat Bitmap%)
  ;; AA  = AXIS | ALLIES
  ;; BF  = BOMBER | FIGHTER
  
  (define-enumerate alliance? AXIS ALLIES)  
  (define alliance=? string=?)
  (define (enemy a) (if (string=? a ALLIES) AXIS ALLIES))
  
  (define-enumerate category? BOMBER FIGHTER)
  (define category=? string=?)
  
  ;                                    
  ;                                    
  ;    ;;;;                   ;;       
  ;   ;   ;                    ;       
  ;   ;       ;;;   ;; ;;   ;; ;   ;;;;
  ;   ;      ;   ;   ;;    ;  ;;  ;   ;
  ;   ;       ;;;;   ;     ;   ;   ;;; 
  ;   ;      ;   ;   ;     ;   ;      ;
  ;   ;   ;  ;   ;   ;     ;   ;  ;   ;
  ;    ;;;    ;;;;; ;;;;;   ;;;;; ;;;; 
  ;                                    
  ;                                    
  ;                                    
  ;                                    
  
  (define-struct card (image) (make-inspector))
  
  (define-struct (aircraft card) (name tag category nation) (make-inspector))
  (define-struct (wild-card card) () (make-inspector))
  (define-struct (victory wild-card) () (make-inspector))
  (define-struct (keepem wild-card) (tag) (make-inspector))
  
  (define (card-value c)
    (cond
      [(wild-card? c) 0]
      [(category=? (aircraft-category c) BOMBER) BOMBER-VALUE]
      [(category=? (aircraft-category c) FIGHTER) FIGHTER-VALUE]))
  
  (def/prov BOMBER-VALUE 10)  
  (def/prov FIGHTER-VALUE 5)
  
  ;; lexicographic sorting of aircraft cards, plus wild-cards are lower
  (define (card<=? c1 c2) 
    (cond
      [(victory? c1) #t]
      [(and (keepem? c1) (aircraft? c2)) #t]
      [(and (keepem? c1) (keepem? c2)) (<= (keepem-tag c1) (keepem-tag c2))]
      [(and (aircraft? c1) (aircraft? c2))
       (cond
         [(string<? (aircraft-name c1) (aircraft-name c2)) #t]
         [(string=? (aircraft-name c1) (aircraft-name c2)) 
          (<= (aircraft-tag c1) (aircraft-tag c2))]
         [else #f])]
      [else #f]))
  
  ;; if they are aircrafts, they must have the same name
  (define (card-same-name? c1 c2)
    (cond
      [(and (aircraft? c1) (aircraft? c2))
       (string=? (aircraft-name c1) (aircraft-name c2))]
      [(and (wild-card? c1) (wild-card? c2)) #t]
      [else #f]))
  
  (define (create-all-cards)
    ;; Symbol Xexpr -> (union String false)
    (define (aircraft-attr att acrft)
      (define r (assq att (cadr acrft)))
      (if r (cadr r) #f))
    (define (to-alliance s)
      (cond [(string=? "US AF" s) ALLIES]
            [(string=? "US Navy" s) ALLIES]
            [(string=? "UK" s) ALLIES]
            [(string=? "Soviet Union" s) ALLIES]
            [(string=? "Italy" s) AXIS]
            [(string=? "Germany" s) AXIS]
            [(string=? "Japan" s) AXIS]
            [else (error 'create-all-cards "not a valid nation: ~e" s)]))
    (define (to-category s)
      (cond
        [(string=? "fighter" s) FIGHTER]
        [(string=? "bomber" s) BOMBER]
        [else (error 'create-all-cards "not a valid category: ~e" s)]))
    ;; Xexpr -> [List Aircraft Aircraft Aircraft]
    (define (to-craft a)
      (define nam (aircraft-attr 'name a))
      (define nat (to-alliance (aircraft-attr 'nation a)))
      (define cat (to-category (aircraft-attr 'category a)))
      (define res (aircraft-attr "image" a))
      (define img (if res (string-append nam res) "question.jpg"))
      (define fil (build-path IMAGES img))
      (list (make-aircraft (create-bitmap 1 nam fil) nam 1 cat nat)
            (make-aircraft (create-bitmap 2 nam fil) nam 2 cat nat)
            (make-aircraft (create-bitmap 3 nam fil) nam 3 cat nat)))
    (define idx:doc 
      (with-input-from-file (build-path IMAGES "index.xml") read-xml))
    (define idx:ele (document-element idx:doc))
    (define idx:lst (filter pair? (xml->xexpr idx:ele)))
    (define keep:bm 
      (make-object bitmap%  (build-path IMAGES "keepem.jpg") 'jpeg))
    (define keepem* (build-list KEEPEM (lambda (i) (make-keepem keep:bm i))))
    (define vict:bm 
      (make-object bitmap% (build-path IMAGES "victory.jpg") 'jpeg))
    (define victory (make-victory vict:bm))
    (apply append (list victory) keepem* (map to-craft idx:lst)))
  
  (define (create-bitmap tag txt fil)
    (define bm (make-object bitmap% fil 'jpeg))
    (define dc (new bitmap-dc% [bitmap bm]))    
    (send dc set-text-foreground (make-object color% "red"))
    (send dc draw-text txt 1 -1)
    #;
    (send dc draw-text (number->string tag) 1 20)
    (send dc set-bitmap #f)
    bm)
  
  (define all-cards (create-all-cards))
  
  ;                                                         
  ;                                                         
  ;  ;;;;;;                               ;;                
  ;   ;   ;                                ;                
  ;   ; ;   ;;  ;;   ;;;  ;;; ;  ;; ;;     ;     ;;;    ;;;;
  ;   ;;;    ;  ;   ;   ;  ; ; ;  ;;  ;    ;    ;   ;  ;   ;
  ;   ; ;     ;;     ;;;;  ; ; ;  ;   ;    ;    ;;;;;   ;;; 
  ;   ;       ;;    ;   ;  ; ; ;  ;   ;    ;    ;          ;
  ;   ;   ;  ;  ;   ;   ;  ; ; ;  ;   ;    ;    ;      ;   ;
  ;  ;;;;;; ;;  ;;   ;;;;;;;;;;;; ;;;;   ;;;;;   ;;;;  ;;;; 
  ;                               ;                         
  ;                              ;;;                        
  ;                                                         
  ;                                                         
  
  (def/prov VICTORY (make-victory "image"))
  (def/prov KEEPEM1 (make-keepem "image" 1))
  (def/prov KEEPEM2 (make-keepem "image" 2))
  (def/prov KEEPEM3 (make-keepem "image" 3))
  
  (def/prov AXIS-FIGHTER1 (make-aircraft "image" "e" 1 FIGHTER AXIS))
  (def/prov AXIS-FIGHTER2 (make-aircraft "image" "e" 2 FIGHTER AXIS))
  (def/prov AXIS-FIGHTER3 (make-aircraft "image" "e" 3 FIGHTER AXIS))
  
  (def/prov AXIS-BOMBER1 (make-aircraft "image" "f" 1 BOMBER AXIS))
  (def/prov AXIS-BOMBER2 (make-aircraft "image" "f" 2 BOMBER AXIS))
  (def/prov AXIS-BOMBER3 (make-aircraft "image" "f" 3 BOMBER AXIS))
  
  (def/prov ALLIES-BOMBER1 (make-aircraft "image" "b" 1 BOMBER ALLIES))
  (def/prov ALLIES-BOMBER2 (make-aircraft "image" "b" 2 BOMBER ALLIES))
  (def/prov ALLIES-BOMBER3 (make-aircraft "image" "b" 3 BOMBER ALLIES))
  
  (def/prov ALLIES-FIGHTER1 (make-aircraft "image" "c" 1 FIGHTER ALLIES))
  (def/prov ALLIES-FIGHTER2 (make-aircraft "image" "c" 2 FIGHTER ALLIES))
  (def/prov ALLIES-FIGHTER3 (make-aircraft "image" "c" 3 FIGHTER ALLIES))
  
  (def/prov ALLIED-BOMBER1 (make-aircraft 'ima "x" 1 BOMBER ALLIES))
  
  (def/prov ANOTHER-ALFI (make-aircraft "image" "a" 3 FIGHTER ALLIES))
  (def/prov ANOTHER-AXBO (make-aircraft "image" "a" 1 BOMBER AXIS))
  
  (def/prov A-RANDOM-LIST-OF-CARDS
    (list KEEPEM1 VICTORY ALLIES-FIGHTER1 ALLIES-FIGHTER2 ALLIES-FIGHTER3))
  
  ;                                                  
  ;                                                  
  ;   ;;;;;                                          
  ;   ;                                    ;         
  ;   ;                                    ;         
  ;   ;      ;  ;   ; ;;    ;;;   ; ;;;  ;;;;;   ;;; 
  ;   ;;;;;  ;  ;   ;;  ;  ;   ;  ;;  ;    ;    ;   ;
  ;   ;       ;;    ;   ;  ;   ;  ;        ;     ;;  
  ;   ;       ;;    ;   ;  ;   ;  ;        ;       ; 
  ;   ;      ;  ;   ;   ;  ;   ;  ;        ;    ;   ;
  ;   ;;;;;  ;  ;   ;;;;    ;;;   ;         ;;   ;;; 
  ;                 ;                                
  ;                 ;                                
  ;                                                  
  
  (require (lib "contract.ss"))
  
  (provide/contract
   ;; --- general properties
   [alliance?          (-> any/c boolean?)]
   [alliance=?         (-> alliance? alliance? boolean?)]
   [enemy              (-> alliance? alliance?)]
   [category?          (-> any/c boolean?)]
   [category=?         (-> category? category? boolean?)]
   [BOMBER             any/c]
   [FIGHTER            any/c]
   [AXIS               any/c]
   [ALLIES             any/c]
   ;; --- cards: the representation
   [struct card ((image any/c))]
   [struct (victory card)  ((image any/c))]
   [struct (keepem card)   ((image any/c) (tag natural-number/c))]
   [struct (aircraft card) ((image any/c) 
                            (name string?)
                            (tag natural-number/c)
                            (category string?)
                            (nation string?))]
   ;; --- useful functions
   [wild-card?         (-> any/c boolean?)]
   ;; is this a wild card?
   [card<=?            (-> card? card? boolean?)]
   ;; use this to sort a bunch of cards into a "hand"
   [card-same-name?    (-> card? card? boolean?)]
   ;; do these two cards belong to the same set of aircrafts?
   [card-value         (-> card? natural-number/c)]
   ;; what is the point value of this card?
   [all-cards          (listof card?)]
   ;; the list of all cards
   )
  
  )