gameServer/Opts.hs
author nemo
Sun, 30 Jan 2011 17:54:02 -0500
changeset 4889 f71e30eb1d37
parent 4568 f85243bf890e
child 4905 7842d085acf4
permissions -rw-r--r--
Reset things using team colour on change in SetClanColor in lua. This routine had better have been worth it. Also add GearHidden to health recount. Oh. and NEEDS TESTING.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
(
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
     3
    getOpts,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
) where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
     6
import System.Environment ( getArgs )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import System.Console.GetOpt
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Data.Maybe ( fromMaybe )
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
options :: [OptDescr (ServerInfo -> ServerInfo)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
options = [
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    15
    Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    16
    Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    17
    ]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    19
readListenPort,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    20
    readDedicated,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    21
    readDbLogin,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    22
    readDbPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    23
    readDbHost :: String -> ServerInfo -> ServerInfo
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    24
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
readListenPort str opts = opts{listenPort = readPort}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    26
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    27
        readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
readDedicated str opts = opts{isDedicated = readDedicated}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    30
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    31
        readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    33
readDbLogin str opts = opts{dbLogin = str}
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    34
readDbPassword str opts = opts{dbPassword = str}
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    35
readDbHost str opts = opts{dbHost = str}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
getOpts :: ServerInfo -> IO ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
getOpts opts = do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    39
    args <- getArgs
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    40
    case getOpt Permute options args of
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    41
        (o, [], []) -> return $ foldr ($) opts o
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    42
        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
2966
fab0d8b04bb9 Server:
smxx
parents: 2867
diff changeset
    43
    where header = "Usage: hedgewars-server [OPTION...]"