gameServer/Opts.hs
author koda
Fri, 13 Aug 2010 02:13:18 +0200
changeset 3737 2ba6ac8a114b
parent 3671 a94d1dc4a8d9
child 4242 5e3c5fe2cb14
permissions -rw-r--r--
reworked the initialization functions, now it should be safe to update and no more need of spinning wheel at first launch adjusted default zoom value polished lobby interface updated ammosets to new weapons
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
3671
a94d1dc4a8d9 - burp's patch cleaning up module dependancies + cabal file
unc0rr
parents: 3500
diff changeset
     6
import System.Environment
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 )
3500
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 2966
diff changeset
    10
import qualified Data.ByteString.Char8 as B
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 2966
diff changeset
    11
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
options :: [OptDescr (ServerInfo -> ServerInfo)]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
options = [
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    17
    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
    18
    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
    19
    ]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    21
readListenPort,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    22
    readDedicated,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    23
    readDbLogin,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    24
    readDbPassword,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    25
    readDbHost :: String -> ServerInfo -> ServerInfo
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1804
diff changeset
    26
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
readListenPort str opts = opts{listenPort = readPort}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    28
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    29
        readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
readDedicated str opts = opts{isDedicated = readDedicated}
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    32
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    33
        readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
3500
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 2966
diff changeset
    35
readDbLogin str opts = opts{dbLogin = B.pack str}
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 2966
diff changeset
    36
readDbPassword str opts = opts{dbPassword = B.pack str}
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 2966
diff changeset
    37
readDbHost str opts = opts{dbHost = B.pack str}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
getOpts :: ServerInfo -> IO ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
getOpts opts = do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    41
    args <- getArgs
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    42
    case getOpt Permute options args of
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    43
        (o, [], []) -> return $ foldr ($) opts o
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 1964
diff changeset
    44
        (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
2966
fab0d8b04bb9 Server:
smxx
parents: 2867
diff changeset
    45
    where header = "Usage: hedgewars-server [OPTION...]"