hstzaar-0.7: src/Main.hs

-- Main module for Haskell TZAAR game implementation
-- Pedro Vasconcelos, 2010
module Main (main) where

import Paths_hstzaar
import Board
import AI
import GUI
import Tournament
import Tests
import System
import System.Random
import System.Console.GetOpt
import System.Exit
import Control.Monad (when)


data Flag = Seed Int
          | NumMatches Int 
          | RunTests
            deriving Show


options :: [OptDescr Flag]
options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED") "random number seed",
           Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N") "number of matches (for AI tournaments)",
           Option ['T'] ["tests"] (NoArg RunTests) "run QuickCheck tests"
          ]

parseArgs :: [String] -> IO ([Flag],[String])
parseArgs argv 
    =  case getOpt Permute options argv of
         (flags, argv', []) -> return (flags, argv')
         (_, _, errs) -> ioError $ 
                         userError $ 
                         concat errs ++ usageInfo header options ++ footer
    
header, footer :: String
header = "usage: hstzaar [OPTION..] [AI AI]"
footer = "\twhere AI is one of: " ++ unwords (map fst aiPlayers)


-- default number of matches for AI tournaments
defMatches :: Int
defMatches = 10

processFlags :: [Flag] -> IO Int
processFlags flags = process flags defMatches
    where 
      process [] m = return m
      process (RunTests:flags) m = run_tests >> exitSuccess
      process (Seed s:flags) m  = setStdGen (mkStdGen s) >> process flags m
      process (NumMatches n:flags) _ = process flags n



main :: IO ()
main = do argv<-getArgs
          (flags, argv')<- parseArgs argv
          numMatches <- processFlags flags
          --
          case argv' of
            [] -> do gladepath <- getDataFileName "data/hstzaar.glade"
                     gui gladepath
            [a1,a2] | a1`elem`ais && a2`elem`ais-> 
                      do let numboards = max 1 (numMatches`div`2)
                         rndgen <- getStdGen
                         let (boards, rnd) = randomBoards numboards rndgen
                         playAIs (toAI a1) (toAI a2) boards rnd
            _ -> ioError $ userError $ usageInfo header options ++ footer
    where ais = map fst aiPlayers



toAI :: String -> AI
toAI ai = maybe (error ("invalid ai: "++ai)) id (lookup ai aiPlayers)