gameServer/HWProtoInRoomState.hs
author unc0rr
Sun, 14 Nov 2010 20:34:13 +0300
branch0.9.14.1
changeset 4326 85adae559981
parent 4242 5e3c5fe2cb14
child 4295 1f5604cd99be
child 4334 82cfbbab73da
permissions -rw-r--r--
35 -> 0.9.14.1 mapping
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module HWProtoInRoomState where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
     3
import qualified Data.Foldable as Foldable
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
     4
import qualified Data.IntMap as IntMap
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import qualified Data.Map as Map
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Sequence(Seq, (|>), (><), fromList, empty)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Data.List
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
     8
import Maybe
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
--------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Actions
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Utils
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    13
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
handleCmd_inRoom :: CmdHandler
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    17
handleCmd_inRoom clID clients _ ["CHAT", msg] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    18
    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    19
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    20
        clientNick = nick $ clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    22
handleCmd_inRoom clID clients rooms ["PART"] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    23
    [RoomRemoveThisClient "part"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    24
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    25
        client = clients IntMap.! clID
3531
66c403badff6 Reimplement room creating
unC0Rr@gmail.com
parents: 3500
diff changeset
    26
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
    27
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    28
handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    29
    | null paramStrs = [ProtocolError "Empty config entry"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    30
    | isMaster client =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    31
        [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    32
        AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    33
    | otherwise = [ProtocolError "Not room master"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    34
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    35
        client = clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    37
handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    38
    | length hhsInfo == 15 && clientProto client < 30 = handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : " " : flag : difStr : hhsInfo)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    39
    | length hhsInfo /= 16 = [ProtocolError "Corrupted hedgehogs info"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    40
    | length (teams room) == 6 = [Warning "too many teams"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    41
    | canAddNumber <= 0 = [Warning "too many hedgehogs"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    42
    | isJust findTeam = [Warning "There's already a team with same name in the list"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    43
    | gameinprogress room = [Warning "round in progress"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    44
    | isRestrictedTeams room = [Warning "restricted"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    45
    | otherwise =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    46
        [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    47
        ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    48
        AnswerThisClient ["TEAM_ACCEPTED", name],
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    49
        AnswerOthersInRoom $ teamToNet (clientProto client) newTeam,
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    50
        AnswerOthersInRoom ["TEAM_COLOR", name, color]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    51
        ]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    52
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    53
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    54
        room = rooms IntMap.! (roomID client)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    55
        canAddNumber = 48 - (sum . map hhnum $ teams room)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    56
        findTeam = find (\t -> name == teamname t) $ teams room
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    57
        newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    58
        difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    59
        hhsList [] = []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    60
        hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    61
        newTeamHHNum = min 4 canAddNumber
3564
7c583c88327b Reimplement REMOVE_TEAM
unc0rr
parents: 3561
diff changeset
    62
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    63
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    64
    | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    65
    | nick client /= teamowner team = [ProtocolError "Not team owner!"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    66
    | otherwise =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    67
            [RemoveTeam teamName,
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    68
            ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1, clientClan = if teamsInGame client == 1 then undefined else anotherTeamClan})
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    69
            ]
3561
7f8e07e4a4e3 Reimplement REMOVE_TEAM
unc0rr
parents: 3555
diff changeset
    70
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    71
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    72
        room = rooms IntMap.! (roomID client)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    73
        noSuchTeam = isNothing findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    74
        team = fromJust findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    75
        findTeam = find (\t -> teamName == teamname t) $ teams room
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    76
        anotherTeamClan = teamcolor $ fromJust $ find (\t -> teamownerId t == clID) $ teams room
3561
7f8e07e4a4e3 Reimplement REMOVE_TEAM
unc0rr
parents: 3555
diff changeset
    77
3568
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3566
diff changeset
    78
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    79
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    80
    | not $ isMaster client = [ProtocolError "Not room master"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    81
    | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = []
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    82
    | otherwise =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    83
        [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    84
        AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    85
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    86
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    87
        room = rooms IntMap.! (roomID client)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    88
        hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    89
        noSuchTeam = isNothing findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    90
        team = fromJust findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    91
        findTeam = find (\t -> teamName == teamname t) $ teams room
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    92
        canAddNumber = 48 - (sum . map hhnum $ teams room)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
3568
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3566
diff changeset
    94
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    95
handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    96
    | not $ isMaster client = [ProtocolError "Not room master"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    97
    | noSuchTeam = []
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    98
    | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor},
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
    99
            AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor],
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   100
            ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   101
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   102
        noSuchTeam = isNothing findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   103
        team = fromJust findTeam
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   104
        findTeam = find (\t -> teamName == teamname t) $ teams room
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   105
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   106
        room = rooms IntMap.! (roomID client)
3568
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3566
diff changeset
   107
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   109
handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   110
    [ModifyClient (\c -> c{isReady = not $ isReady client}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   111
    ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   112
    AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   113
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   114
        client = clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
3577
0ef6f5182a75 START_GAME command
unc0rr
parents: 3568
diff changeset
   116
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   117
handleCmd_inRoom clID clients rooms ["START_GAME"] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   118
    if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   119
        if enoughClans then
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   120
            [ModifyRoom
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   121
                    (\r -> r{
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   122
                        gameinprogress = True,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   123
                        roundMsgs = empty,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   124
                        leftTeams = [],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   125
                        teamsAtStart = teams r}
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   126
                    ),
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   127
            AnswerThisRoom ["RUN_GAME"]]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   128
        else
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   129
            [Warning "Less than two clans!"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   130
    else
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   131
        []
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   132
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   133
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   134
        room = rooms IntMap.! (roomID client)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   135
        enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   136
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   137
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   138
handleCmd_inRoom clID clients rooms ["EM", msg] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   139
    if (teamsInGame client > 0) && isLegal then
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   140
        (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   141
    else
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   142
        []
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   143
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   144
        client = clients IntMap.! clID
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   145
        (isLegal, isKeepAlive) = checkNetCmd msg
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   146
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   147
handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   148
    if isMaster client then
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   149
        [ModifyRoom
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   150
                (\r -> r{
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   151
                    gameinprogress = False,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   152
                    readyPlayers = 0,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   153
                    roundMsgs = empty,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   154
                    leftTeams = [],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   155
                    teamsAtStart = []}
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   156
                ),
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   157
        UnreadyRoomClients
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   158
        ] ++ answerRemovedTeams
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   159
    else
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   160
        []
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   161
    where
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   162
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   163
        room = rooms IntMap.! (roomID client)
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   164
        answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   165
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   166
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   167
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   168
    | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   169
    | otherwise = [ProtocolError "Not room master"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   170
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   171
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   172
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   173
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   174
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   175
    | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   176
    | otherwise = [ProtocolError "Not room master"]
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   177
    where
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   178
        client = clients IntMap.! clID
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   179
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   180
handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   181
    [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   182
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   183
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   184
        maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   185
        noSuchClient = isNothing maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   186
        kickClient = fromJust maybeClient
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   187
        kickID = clientUID kickClient
1879
bb114339eb4e Implement kick from room
unc0rr
parents: 1866
diff changeset
   188
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   189
2403
6c5d504af2ba - Proper /team command implementation
unc0rr
parents: 2381
diff changeset
   190
handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] =
2960
b467a681c5e0 - Fix spectators team chat
unc0rr
parents: 2952
diff changeset
   191
    [AnswerSameClan ["EM", engineMsg]]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   192
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   193
        client = clients IntMap.! clID
2952
18fada739b55 - Convert strings from utf-8 on recieve, and back to utf-8 when send them
unc0rr
parents: 2928
diff changeset
   194
        engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
4242
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   195
5e3c5fe2cb14 Revert to old server in branch 0.9.14
unc0rr
parents: 3655
diff changeset
   196
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]