gameServer/HWProtoInRoomState.hs
author koda
Sat, 20 Mar 2010 15:16:59 +0000
changeset 3025 01682ec58eb0
parent 2960 b467a681c5e0
child 3435 4e4f88a7bdf2
permissions -rw-r--r--
update project for ipad target relocate objects (windbar, fps, timer) so that window size doesn't matter move touch input in its custom controller rather than hack sdl one
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
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import qualified Data.IntMap as IntMap
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Maybe
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
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
1815
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1814
diff changeset
    17
handleCmd_inRoom clID clients _ ["CHAT", msg] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    18
    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    19
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    20
        clientNick = nick $ clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
1814
e5391d901cff - Remove client teams on exit
unc0rr
parents: 1813
diff changeset
    22
handleCmd_inRoom clID clients rooms ["PART"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    23
    [RoomRemoveThisClient "part"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    24
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    25
        client = clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
    27
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
    28
handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs)
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    29
    | null paramStrs = [ProtocolError "Empty config entry"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    30
    | isMaster client =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    31
        [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    32
        AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    33
    | otherwise = [ProtocolError "Not room master"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    34
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    35
        client = clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
2747
7889a3a9724f Server:
smxx
parents: 2408
diff changeset
    37
handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
2917
2f4320a1b31f Fix server for 0.9.12 (tested)
unc0rr
parents: 2902
diff changeset
    38
    | length hhsInfo == 15 && clientProto client < 30 = handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : " " : flag : difStr : hhsInfo)
2f4320a1b31f Fix server for 0.9.12 (tested)
unc0rr
parents: 2902
diff changeset
    39
    | length hhsInfo /= 16 = [ProtocolError "Corrupted hedgehogs info"]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    40
    | length (teams room) == 6 = [Warning "too many teams"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    41
    | canAddNumber <= 0 = [Warning "too many hedgehogs"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    42
    | isJust findTeam = [Warning "There's already a team with same name in the list"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    43
    | gameinprogress room = [Warning "round in progress"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    44
    | isRestrictedTeams room = [Warning "restricted"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    45
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    46
        [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    47
        ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    48
        AnswerThisClient ["TEAM_ACCEPTED", name],
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    49
        AnswerOthersInRoom $ teamToNet (clientProto client) newTeam,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    50
        AnswerOthersInRoom ["TEAM_COLOR", name, color]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    51
        ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    52
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    53
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    54
        room = rooms IntMap.! (roomID client)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    55
        canAddNumber = 48 - (sum . map hhnum $ teams room)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    56
        findTeam = find (\t -> name == teamname t) $ teams room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    57
        newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    58
        difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
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
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    61
        newTeamHHNum = min 4 canAddNumber
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    62
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
    63
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    64
    | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    65
    | nick client /= teamowner team = [ProtocolError "Not team owner!"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    66
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    67
            [RemoveTeam teamName,
2928
0e95e0e24fd8 When removing team, set player's clan property to a colour of his another team
unc0rr
parents: 2917
diff changeset
    68
            ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1, clientClan = if teamsInGame client == 1 then undefined else anotherTeamClan})
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    69
            ]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    70
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    71
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    72
        room = rooms IntMap.! (roomID client)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    73
        noSuchTeam = isNothing findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    74
        team = fromJust findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    75
        findTeam = find (\t -> teamName == teamname t) $ teams room
2928
0e95e0e24fd8 When removing team, set player's clan property to a colour of his another team
unc0rr
parents: 2917
diff changeset
    76
        anotherTeamClan = teamcolor $ fromJust $ find (\t -> teamownerId t == clID) $ teams room
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    77
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    78
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
    79
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    80
    | not $ isMaster client = [ProtocolError "Not room master"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    81
    | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    82
    | otherwise =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    83
        [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    84
        AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    85
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    86
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    87
        room = rooms IntMap.! (roomID client)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    88
        hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    89
        noSuchTeam = isNothing findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    90
        team = fromJust findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    91
        findTeam = find (\t -> teamName == teamname t) $ teams room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    92
        canAddNumber = 48 - (sum . map hhnum $ teams room)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    94
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
    95
handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    96
    | not $ isMaster client = [ProtocolError "Not room master"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    97
    | noSuchTeam = []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    98
    | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor},
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    99
            AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor],
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
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   102
        noSuchTeam = isNothing findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   103
        team = fromJust findTeam
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   104
        findTeam = find (\t -> teamName == teamname t) $ teams room
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   105
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   106
        room = rooms IntMap.! (roomID client)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   107
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   109
handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   110
    [ModifyClient (\c -> c{isReady = not $ isReady client}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   111
    ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   112
    AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   113
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   114
        client = clients IntMap.! clID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
handleCmd_inRoom clID clients rooms ["START_GAME"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   118
    if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   119
        if enoughClans then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   120
            [ModifyRoom
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
                    ),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   127
            AnswerThisRoom ["RUN_GAME"]]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   128
        else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   129
            [Warning "Less than two clans!"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   130
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   131
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   132
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   133
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   134
        room = rooms IntMap.! (roomID client)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
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
2245
c011aecc95e5 unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents: 2207
diff changeset
   138
handleCmd_inRoom clID clients rooms ["EM", msg] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   139
    if (teamsInGame client > 0) && isLegal then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   140
        (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   141
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   142
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   143
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   144
        client = clients IntMap.! clID
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
1811
1b9e33623b7e Implement 'roundfinished' cmd on net server
unc0rr
parents: 1804
diff changeset
   147
handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   148
    if isMaster client then
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   149
        [ModifyRoom
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 = []}
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   156
                ),
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   157
        UnreadyRoomClients
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   158
        ] ++ answerRemovedTeams
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   159
    else
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   160
        []
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   161
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   162
        client = clients IntMap.! clID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   163
        room = rooms IntMap.! (roomID client)
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
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
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
   167
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   168
    | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   169
    | otherwise = [ProtocolError "Not room master"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   170
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   171
        client = clients IntMap.! clID
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   172
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
diff changeset
   173
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2337
diff changeset
   174
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   175
    | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   176
    | otherwise = [ProtocolError "Not room master"]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   177
    where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   178
        client = clients IntMap.! clID
1831
025348f05b9f Implement two more missing protocol commands
unc0rr
parents: 1818
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")
2403
6c5d504af2ba - Proper /team command implementation
unc0rr
parents: 2381
diff changeset
   195
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   196
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]