; This module contains the game world of SET
(module SET mzscheme
  (require (lib "plt-match.ss")
           (lib "list.ss")
           (lib "struct.ss"))
  (require (planet "list.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "permute.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "maybe.ss" ("jaymccarthy" "mmss.plt" 1)))
  (provide (all-defined))
  
  ; Card attributes
  (define fillings `(filled striped empty))
  (define shapes `(squiggle diamond oval))
  (define colors `(red purple green))
  (define numbers `(one two three))
  
  (define ((make-test? lst) x)
    (member? x lst))
  (define card:filling? (make-test? fillings))
  (define card:shape? (make-test? shapes))
  (define card:color? (make-test? colors))
  (define card:number? (make-test? numbers))
  
  ; Cards
  (define-struct card (filling shape color number))
  (define card->number 
    (match-lambda
      [(struct card (f s c n))
       (add1
        (+ (* (expt 3 3) (just-value (elem-ref f fillings)))
           (* (expt 3 2) (just-value (elem-ref s shapes)))
           (* (expt 3 1) (just-value (elem-ref c colors)))
           (* (expt 3 0) (just-value (elem-ref n numbers)))))]))
  
  (define (number->card* cs ns)
    (map (lambda (n)
           (first (filter (lambda (c) (equal? n (card->number c))) cs)))
         ns))
  
  ; Deck
  (define all-cards
    (for-all (make-card f s c n)
             [f fillings]
             [s shapes]
             [c colors]
             [n numbers]))
  
  (define (shuffle-deck)
    (random-list all-cards))
  
  ; SET testing
  (define (all-same/different s1 s2 s3)
    (or (and (eq? s1 s2)
             (eq? s2 s3)
             (eq? s3 s1))
        (and (not (eq? s1 s2))
             (not (eq? s2 s3))
             (not (eq? s3 s1)))))
  
  (define set?
    (match-lambda*
      [(list (struct card (f1 s1 c1 n1))
             (struct card (f2 s2 c2 n2))
             (struct card (f3 s3 c3 n3)))
       (and (all-same/different f1 f2 f3)
            (all-same/different s1 s2 s3)
            (all-same/different c1 c2 c3)
            (all-same/different n1 n2 n3))]))
  
  (define (available-sets board)
    (let* ([combs (for-all (let ([n1 (card->number c1)]
                                 [n2 (card->number c2)]
                                 [n3 (card->number c3)])
                             (if (and (< n1 n2)
                                      (< n2 n3)
                                      (set? c1 c2 c3))
                                 (make-just (list c1 c2 c3))
                                 (make-nothing)))
                           [c1 board]
                           [c2 board]
                           [c3 board])]
           [sets (map just-value (filter just? combs))])
      sets))
  
  ; Game Stats
  (define-struct stats (start-time find-times end-time
                                   useless-gives hasty-sets
                                   non-sets))  
  (define stats-find-times/diff
    (match-lambda
      [(struct stats (st fts et ugs hs ns))
       (let ([abs-diffs
              (map (lambda (x)
                     (- x st))
                   (reverse fts))])
         (if (empty? abs-diffs)
             empty
             (second
              (foldl (match-lambda*
                       [(list elem (list last-elem return))
                        (list elem
                              (list* (- elem last-elem)
                                     return))])
                     (list (first abs-diffs)
                           (list (first abs-diffs)))
                     (rest abs-diffs)))))]))
  
  ; Game State
  (define-struct game (board deck sets stats))
  (define (game-over? gs)
    (and (< (length (game-deck gs)) 3)
         (not (> (length (available-sets (game-board gs))) 0))))
  
  (define read-timer current-milliseconds)
  
  (define (new-game)
    (let ([starting-deck (shuffle-deck)])
      (make-game (list-head starting-deck 12)
                 (list-tail starting-deck 12)
                 empty
                 (make-stats (read-timer)
                             empty
                             +inf.0
                             0
                             0
                             0))))
  (define (collect-set gs c1 c2 c3)
    (if (not (set? c1 c2 c3))
        (copy-struct game gs
                     [game-stats
                      (copy-struct stats (game-stats gs)
                                   [stats-non-sets
                                    (add1 (stats-non-sets (game-stats gs)))])])
        (let* ([old-board (game-board gs)]
               [new-board (filter (lambda (cx) (not (or (eq? cx c1)
                                                        (eq? cx c2)
                                                        (eq? cx c3))))
                                  old-board)]
               [game-over? (not (> (length (available-sets new-board)) 0))])
          (copy-struct game gs
                       [game-board
                        new-board]
                       [game-sets
                        (list* (list c1 c2 c3)
                               (game-sets gs))]
                       [game-stats
                        (let ([os (game-stats gs)])
                          (copy-struct stats os
                                       [stats-find-times
                                        (list* (read-timer)
                                               (stats-find-times os))]
                                       [stats-end-time
                                        (if game-over?
                                            (read-timer)
                                            +inf.0)]
                                       [stats-hasty-sets
                                        (if (> (length (available-sets old-board))
                                               (add1 (length (available-sets new-board))))
                                            (add1 (stats-hasty-sets os))
                                            (stats-hasty-sets os))]))]))))
  
  (define (give-three gs)
    (if (>= (length (game-deck gs)) 3)
        (let ([old-board (game-board gs)])
          (copy-struct game gs
                       [game-board
                        (append old-board
                                (list-head (game-deck gs) 3))]
                       [game-deck
                        (list-tail (game-deck gs) 3)]
                       [game-stats
                        (let ([os (game-stats gs)])
                          (copy-struct stats os
                                       [stats-useless-gives
                                        (if (and (= (length old-board) 12)
                                                 (> (length (available-sets old-board)) 0))
                                            (add1 (stats-useless-gives os))
                                            (stats-useless-gives os))]))]))
        gs)))