Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
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