-- Main module for Haskell TZAAR game implementation -- Pedro Vasconcelos, 2010-2013 module Main (main) where import Paths_hstzaar import Board import AI import GUI import Serialize import Tournament import Tests import Data.List (intersperse) import System.Environment import System.Random import System.Console.GetOpt import System.Exit import Control.Monad (when) import System.Directory import System.FilePath import qualified Data.Map as Map data Flag = Seed Int | NumMatches Int | DataDir FilePath | 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 ['d'] ["dir"] (ReqArg DataDir "DATADIR") "data directory", 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 name aiPlayers) -- default number of matches for AI tournaments matches :: Int matches = 10 processFlags :: [Flag] -> IO () processFlags = mapM_ process where process RunTests = run_tests >> exitSuccess process (Seed s) = setStdGen (mkStdGen s) process _ = return () main :: IO () main = do argv<-getArgs rnd <- getStdGen (flags, argv')<- parseArgs argv processFlags flags dir <- getDataDir let numMatches = last (matches : [n | NumMatches n <- flags]) let gladepath = last (dir : [d | DataDir d <- flags]) "hstzaar.glade" -- case argv' of [] -> gui gladepath [arg1] -> case lookupAI arg1 aiPlayers of Nothing -> ioError $ userError $ "invalid AI: " ++ arg1 Just ai -> do { txt <- getContents -- read start position ; case readXML txt of Nothing -> putStrLn "ERROR: couldn't parse game file" Just g -> playAI rnd ai (board g) } [arg1,arg2] -> case do p1 <- lookupAI arg1 aiPlayers p2 <- lookupAI arg2 aiPlayers return (p1,p2) of Nothing -> ioError $ userError $ "invalid AI: " ++ unwords [arg1, arg2] Just (p1,p2) -> do let (boards, rnd') = randomBoards numMatches rnd setStdGen rnd' playAIs p1 p2 boards rnd _ -> ioError $ userError $ usageInfo header options ++ footer playAI :: StdGen -> AI -> Board -> IO () playAI rnd ai b | endGame b = putStrLn ("Game end (" ++ show (invert $ active b) ++ " won)") | otherwise = putStrLn (show (active b) ++ ": " ++ showMove m) where (score, m, _) = playing ai b rnd