gameServer/HWProtoCore.hs
author koda
Sat, 05 Jun 2010 14:07:58 +0000
changeset 3495 a6b4f351d400
parent 3458 11cd56019f00
child 3500 af8390d807d6
permissions -rw-r--r--
now engine can be optionally built as library, there's an example wrapper of how to use it building server is now disabled by default, saves users some headaches
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoCore where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import qualified Data.IntMap as IntMap
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     4
import Data.Foldable
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
     5
import Maybe
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
     6
import Control.Monad.Reader
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
import HWProtoInRoomState
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    14
import HandlerUtils
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    15
import RoomsAndClients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    17
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    19
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    20
handleCmd ["PING"] = answerClient ["PONG"]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    22
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    23
handleCmd ("QUIT" : xs) = return [ByeClient msg]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    24
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    25
        msg = if not $ null xs then head xs else ""
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    27
{-
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents: 3435
diff changeset
    28
handleCmd ["PONG"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    29
    if pingsQueue client == 0 then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    30
        [ProtocolError "Protocol violation"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    31
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    32
        [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    33
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    34
        client = clients IntMap.! clID
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    35
-}
1928
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    36
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    37
handleCmd cmd = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    38
    (ci, irnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    39
    if logonPassed (irnc `client` ci) then
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents: 3435
diff changeset
    40
        handleCmd_loggedin cmd
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    41
        else
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents: 3435
diff changeset
    42
        handleCmd_NotEntered cmd
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    43
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    44
{-
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    45
handleCmd_loggedin clID clients rooms ["INFO", asknick] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    46
    if noSuchClient then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    47
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    48
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    49
        [AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    50
            ["INFO",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    51
            nick client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    52
            "[" ++ host client ++ "]",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    53
            protoNumber2ver $ clientProto client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    54
            "[" ++ roomInfo ++ "]" ++ roomStatus]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    55
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    56
        maybeClient = find (\cl -> asknick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    57
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    58
        client = fromJust maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    59
        room = rooms IntMap.! roomID client
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    60
        roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    61
        roomMasterSign = if isMaster client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    62
        adminSign = if isAdministrator client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    63
        roomStatus =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    64
            if gameinprogress room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    65
            then if teamsInGame client > 0 then "(playing)" else "(spectating)"
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    66
            else ""
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    67
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    68
-}
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    69
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    70
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    71
handleCmd_loggedin cmd = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    72
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    73
    if clientRoom rnc ci == lobbyId then
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    74
        handleCmd_lobby cmd
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    75
        else
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 2961
diff changeset
    76
        handleCmd_inRoom cmd