hstzaar-0.6: 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 = "  where AI is one of: " ++ unwords [name ai | ai<-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] -> do p1<-string_to_AI a1
                          p2<-string_to_AI a2
                          let numboards = max 1 (numMatches`div`2)
                          rndgen <- getStdGen
                          let (boards, rnd) = randomBoards numboards rndgen
                          playAIs p1 p2 boards rnd
            _ -> ioError $ userError $ usageInfo header options ++ footer

string_to_AI :: String  -> IO AI
string_to_AI n 
    = case [p | p<-aiPlayers, name p==n] of
        [] -> ioError $ userError ("invalid AI: " ++ n)
        (p:_) -> return p