module Main(main) where import Concurrent import Monad(unless) import Network import Posix(installHandler,sigPIPE,Handler(Ignore)) import System(getArgs,exitFailure) import GetOpt import IO(stderr,hPutStrLn) import Utils import qualified Board(load) import qualified Server import Opts -------------------------------------------------------------------------------- -- command line options -------------------------------------------------------------------------------- default_options = Opt { portNum = PortNumber 20005 , gameType = Continuous , mapFile = Nothing , packFile = Nothing , fuel = 5000 , capacity = 50 , verbosity = Normal , initPos = (1,1) , initPoses = [] , timeout = Nothing } options = [ Option ['p'] ["port"] (ReqArg (rd port) "NUM") "port to listen on" , Option ['n'] ["new"] (ReqArg (rd manyGames) "NUM") "new game every NUM players" , Option ['o'] ["one"] (ReqArg (rd oneGame) "NUM") "one game with NUM players" , Option ['m'] ["map"] (ReqArg mapF "FILE") "the map to use for the game" , Option ['k'] ["packs"] (ReqArg packF "FILE") "locations of packages" , Option ['f'] ["fuel"] (ReqArg (rd setFuel) "NUM") "fuel for each player" , Option ['c'] ["capacity"] (ReqArg (rd setCapa) "NUM") "capacity for each player" , Option ['v'] ["verbose"] (NoArg verb) "display a lot of info" , Option ['q'] ["quiet"] (NoArg quiet) "don't display any info" , Option ['i'] ["init"] (ReqArg (rd setInitP) "(NUM,NUM)") "set the default initial position" , Option ['j'] ["inits"] (ReqArg (rd setInitPs) "[(NUM,NUM)]") "set the first initial positions" , Option ['t'] ["timeout"] (ReqArg (rd setTimeout) "NUM") "set timeout in millisecs" , Option ['r'] ["robo"] (ReqArg rd_player "NUM:(NUM,NUM):CMD") "a player with uid:initial_pos:command" ] where rd f x opts = case parse x of Nothing -> opts Just y -> f y opts rd_player x opts = case linesBy (== ':') x of a:b:c:_ -> maybe opts addPl $ do uid <- parse a pos <- parse b return (uid,pos,c) _ -> opts where addPl y = case opts of Opt { gameType = OneGamePlayers ys } -> opts { gameType = OneGamePlayers (y:ys) } _ -> opts { gameType = OneGamePlayers [y] } port x opts = opts { portNum = PortNumber (fromIntegral x) } manyGames x opts = opts { gameType = ManyGames x } oneGame x opts = opts { gameType = OneGame x } setTimeout x opts = opts { timeout = Just x } setInitP x opts = opts { initPos = x } setInitPs x opts = opts { initPoses = x } setFuel x opts = opts { fuel = x } setCapa x opts = opts { capacity = x } packF x opts = opts { packFile = Just x } mapF x opts = opts { mapFile = Just x } verb opts = opts { verbosity = Chatty } quiet opts = opts { verbosity = Quiet } -------------------------------------------------------------------------------- -- the driver -------------------------------------------------------------------------------- main = withSocketsDo $ do installHandler sigPIPE Ignore Nothing args <- getArgs let (optFs,_,errs) = getOpt Permute options args opts = foldr ($) default_options optFs unless (null errs) showUsage let invalidMapFile = putStrLn "Invalid map file" >> exitFailure invalidPackFile = putStrLn "Invalid pack file" >> exitFailure (mapF,packF) <- maybe showUsage return $ do mapF <- mapFile opts packF <- packFile opts return (mapF,packF) board <- maybe invalidMapFile return =<< Board.load mapF packs <- maybe invalidPackFile return . parse =<< readFile packF let opts1 = opts { mapFile = board, packFile = packs } Server.start opts1 showUsage = do hPutStrLn stderr $ usageInfo "Required: map and packs.\n usage:" options exitFailure