(module servlet mzscheme
  (require (lib "servlet.ss" "web-server")
           (lib "list.ss")
           (lib "etc.ss")
           (lib "xml.ss" "xml")
           (lib "plt-match.ss"))
  (require (planet "list.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "maybe.ss" ("jaymccarthy" "mmss.plt" 1)))
  (require "SET.ss")
  (provide interface-version
           timeout
           start)
  
  (define interface-version 'v1)
  (define timeout (* 60 60 24))
  
  (define current-game (make-parameter #f))
  
  (define (card->image c)
    (format "/setcards/~a.gif" (card->number c)))
  (define (card->image/small c)
    `(img ([src ,(format "/setcards/small/~a.gif" (card->number c))]
           [width "47"]
           [height "31"])))
  
  (define (start-game)    
    (parameterize ([current-game (new-game)])
      (show-board)))
  
  (define show-board
    (opt-lambda ([message #f])
      (if (and (< (length (game-board (current-game))) 12)
               (>= (length (game-deck (current-game))) 3))
          (parameterize ([current-game (give-three (current-game))])
            (show-board message))
          (send/suspend/dispatch
           (lambda (embed/url)
             `(html (head (title "SET")
                          (style ([type "text/css"])
                                 "body { background-color: #F2F8C2; } "
                                 "div#info { float: right; width: 45%; text-align: center; } "
                                 "div#body { float: left; width: 35%; text-align: center; } "
                                 "table#board { width: 50%; text-align: center; } "
                                 "td.card { text-align: center; } "
                                 "a { text-decoration: none; color: blue; } "
                                 "a:hover { text-decoration: underline; } "
                                 "a.k-url:visited { color: blue; } "
                                 "tr#controls td { text-align: center; } "
                                 "div#footer { clear: left; width: 99%; } ")
                          (script ([type "text/javascript"])
                                  ,(make-cdata 
                                    (make-location 0 0 0) 
                                    (make-location 0 0 0)
                                    (string-append
                                     "function checkBoard() {"
                                     "var setform = document.getElementById(\"SET\");"
                                     "var count = 0;"
                                     "for ( var i = 0; i < setform.elements.length - 3; i++ ) {"
                                     " if ( setform.elements[i].checked ) { "
                                     "  count++;"
                                     " }"
                                     "}"
                                     "if ( count == 3 ) {"
                                     " return setform.elements[setform.elements.length-2].click();"
                                     "}"
                                     "};"
                                     "function checkCard(card) {"
                                     "var card = document.getElementById(card);"
                                     "card.checked = ! card.checked;"
                                     "};"))))
                    (body 
                     (div ([id "body"])
                          (form ([method "POST"]
                                 [id "SET"]
                                 [action ,(embed/url 
                                           (lambda (request)
                                             (let* ([bindings (request-bindings request)]
                                                    [no-set? (exists-binding? 'no-set bindings)]
                                                    [propose-set? (exists-binding? 'propose-set bindings)]
                                                    [start-over? (exists-binding? 'start-over bindings)])
                                               (cond 
                                                 [no-set?
                                                  (parameterize ([current-game (give-three (current-game))])
                                                    (show-board))]
                                                 [propose-set?
                                                  (let ([nums (map just-value
                                                                   (filter just?
                                                                           (map (lambda (b)
                                                                                  (match (symbol->string (car b))
                                                                                    [(regexp "^card-(.*?)$"
                                                                                             (list s n))
                                                                                     (make-just (string->number n))]
                                                                                    [_
                                                                                     (make-nothing)]))
                                                                                bindings)))])
                                                    (if (not (equal? (length nums) 3))
                                                        (show-board "Must supply three cards.")
                                                        (let ([cards (number->card* (game-board (current-game)) nums)])
                                                          (parameterize ([current-game (apply collect-set (current-game) cards)])
                                                            (show-board)))))]
                                                 [start-over?
                                                  (start-game)]))))])
                                (table ([id "board"])
                                       ,@(map (lambda (s)
                                                `(tr ,@s))
                                              (slices (map (lambda (c)
                                                             (let* ([n (card->number c)]
                                                                    [card-id (format "card-~a" n)])
                                                               `(td ([class "card"])
                                                                    (img ([src ,(card->image c)]
                                                                          [onClick ,(format "checkCard(\"~a\"); checkBoard();"
                                                                                            card-id)]))
                                                                    (br)
                                                                    (input ([type "checkbox"]
                                                                            [name ,card-id] [id ,card-id]
                                                                            [onClick "checkBoard();"])))))
                                                           (game-board (current-game)))
                                                      3 #t `(td nbsp)))
                                       (tr (td ([colspan "3"]) nbsp))
                                       (tr ([id "controls"]) (td (input ([type "submit"] [name "no-set"] [value "No Set"])))
                                           (td (input ([type "submit"] [name "propose-set"] [value "Propose Set"])))
                                           (td (input ([type "submit"] [name "start-over"] [value "Start Over"])))))))
                     (div ([id "info"])
                          ,@(if message
                                `((div ([id "message"]) ,message))
                                empty)
                          ,@(if (game-over? (current-game))
                                `((h2 "Game Over."))
                                empty)
                          (table ([id "stats"])
                                 (tr (td "Non-sets:")
                                     (td ,(number->string (stats-non-sets (game-stats (current-game))))))
                                 (tr (td "Useless Gives:")
                                     (td ,(number->string (stats-useless-gives (game-stats (current-game))))))
                                 (tr (td "Hasty SETs:")
                                     (td ,(number->string (stats-hasty-sets (game-stats (current-game))))))
                                 (tr (td "Total time:")
                                     (td ,(let ([st (stats-start-time (game-stats (current-game)))]
                                                [fts (stats-find-times (game-stats (current-game)))])
                                            (if (empty? fts)
                                                "0"
                                                (number->string 
                                                 (exact->inexact
                                                  (/ (- (first fts) st)
                                                     1000))))))))
                          (h2 "Completed SETs:")
                          (table ([id "sets"])
                                 ,@(map (match-lambda*
                                          [(list (list c1 c2 c3) time-diff)
                                           `(tr (td ,(format "~a"
                                                             (exact->inexact
                                                              (/ time-diff 
                                                                 1000))))
                                                (td ,(card->image/small c1))
                                                (td ,(card->image/small c2))
                                                (td ,(card->image/small c3)))])
                                        (game-sets (current-game))
                                        (stats-find-times/diff (game-stats (current-game))))))
                     (div ([id "footer"])
                          (p ([align "right"])
                             "Powered by " (a ([href "http://www.plt-scheme.org/"])
                                              (img ([width "53"] [height "19"] [src "/Defaults/documentation/plt-logo.gif"]))) 
                             (br)
                             (font ([size "2"]) "For more information on PLT Software, please follow the icon link."))))))))))
  
  (define (start initial-request)
    (start-game)))