gameServer/Opts.hs
author nemo
Thu, 01 Jul 2010 23:41:10 -0400
changeset 3608 c509bbc779e7
parent 3500 af8390d807d6
child 3671 a94d1dc4a8d9
permissions -rw-r--r--
Revert prior attempted optimisation. Gridding the land pays in some situations, but not all. Restricting to an upper bound might help, but overall, seems too fuzzy to be worth it. On one side is increased cost of Add/Delete + extra test on collision check, on the other is skipping the list iteration. Perhaps for large lists.
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System
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...]"