gameServer/HWProtoCore.hs
author koda
Thu, 13 Jan 2011 02:56:25 +0100
branch0.9.15
changeset 4733 45b5a16c01fb
parent 4568 f85243bf890e
child 4904 0eab727d4717
permissions -rw-r--r--
Added tag 0.9.15 for changeset bd74fd83929a
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
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: 4242
diff changeset
     5
import Data.Maybe
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Utils
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import HWProtoNEState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import HWProtoLobbyState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import HWProtoInRoomState
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    14
handleCmd, handleCmd_loggedin :: CmdHandler
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    16
handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    18
handleCmd clID clients rooms ("QUIT" : xs) =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    19
    [ByeClient msg]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    20
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    21
        msg = if not $ null xs then head xs else ""
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    23
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    24
handleCmd clID clients _ ["PONG"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    25
    if pingsQueue client == 0 then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    26
        [ProtocolError "Protocol violation"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    27
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    28
        [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    29
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    30
        client = clients IntMap.! clID
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    31
1928
9bf8f4f30d6b - Implement ping timeout
unc0rr
parents: 1879
diff changeset
    32
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    33
handleCmd clID clients rooms cmd =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    34
    if not $ logonPassed client then
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    35
        handleCmd_NotEntered clID clients rooms cmd
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    36
    else
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    37
        handleCmd_loggedin clID clients rooms cmd
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    38
    where
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    39
        client = clients IntMap.! clID
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    40
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    41
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    42
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
    43
    if noSuchClient then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    44
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    45
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    46
        [AnswerThisClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    47
            ["INFO",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    48
            nick client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    49
            "[" ++ host client ++ "]",
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    50
            protoNumber2ver $ clientProto client,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    51
            "[" ++ roomInfo ++ "]" ++ roomStatus]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    52
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    53
        maybeClient = find (\cl -> asknick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    54
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    55
        client = fromJust maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    56
        room = rooms IntMap.! roomID client
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    57
        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
    58
        roomMasterSign = if isMaster client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    59
        adminSign = if isAdministrator client then "@" else ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    60
        roomStatus =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    61
            if gameinprogress room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2706
diff changeset
    62
            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
    63
            else ""
1862
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    64
7f303aa066da Implement kick from server by administrator
unc0rr
parents: 1841
diff changeset
    65
4568
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    66
handleCmd_loggedin clID clients rooms cmd =
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    67
    if roomID client == 0 then
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    68
        handleCmd_lobby clID clients rooms cmd
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    69
    else
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    70
        handleCmd_inRoom clID clients rooms cmd
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    71
    where
f85243bf890e Ok. This should pull 0.9.14.1 server into default
nemo
parents: 4337
diff changeset
    72
        client = clients IntMap.! clID