gameServer/hedgewars-server.hs
author nemo
Sat, 04 Dec 2010 11:30:54 -0500
changeset 4455 a0c8779713f2
parent 4295 1f5604cd99be
child 4568 f85243bf890e
child 4593 39d07170085b
permissions -rw-r--r--
In AI survival mode, have the AI score when it kills humans, instead of its own team, clear poison on an AI kill, and reset AI health using InitialHealth instead of 100.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2348
b39d826e1ccd Drop support for ghc 6.8, use 6.10 instead
unc0rr
parents: 2296
diff changeset
     1
{-# LANGUAGE CPP, ScopedTypeVariables #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
     5
import Network
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Control.Concurrent.STM
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent.Chan
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2129
diff changeset
     8
import qualified Control.Exception as Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import System.Log.Logger
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
-----------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Opts
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import ServerCore
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    21
setupLoggers :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
setupLoggers =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    23
    updateGlobalLogger "Clients"
3947
709fdb89f76c Some screwing around in try to fix space leak. No luck yet.
unc0rr
parents: 3500
diff changeset
    24
        (setLevel INFO)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    26
main :: IO ()
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
#if !defined(mingw32_HOST_OS)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    29
    installHandler sigPIPE Ignore Nothing;
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    30
    installHandler sigCHLD Ignore Nothing;
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    33
    setupLoggers
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    35
    stats' <- atomically $ newTMVar (StatisticsInfo 0 0)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    36
    dbQueriesChan <- newChan
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    37
    coreChan' <- newChan
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    38
    serverInfo' <- getOpts $ newServerInfo stats' coreChan' dbQueriesChan
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    39
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    40
#if defined(OFFICIAL_SERVER)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    41
    dbHost' <- askFromConsole "DB host: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    42
    dbLogin' <- askFromConsole "login: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    43
    dbPassword' <- askFromConsole "password: "
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    44
    let serverInfo = serverInfo'{dbHost = dbHost', dbLogin = dbLogin', dbPassword = dbPassword'}
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    45
#else
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    46
    let serverInfo = serverInfo'
1964
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    47
#endif
dc9ea05c9d2f - Another way of defining official server
unc0rr
parents: 1927
diff changeset
    48
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    49
    Exception.bracket
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    50
        (Network.listenOn $ Network.PortNumber $ listenPort serverInfo)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2349
diff changeset
    51
        sClose
4295
1f5604cd99be This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents: 4247
diff changeset
    52
        (startServer serverInfo)