--- a/gameServer/HWProtoLobbyState.hs Thu Feb 25 15:58:44 2010 +0000
+++ b/gameServer/HWProtoLobbyState.hs Thu Feb 25 18:28:33 2010 +0000
@@ -11,144 +11,144 @@
import Actions
import Utils
-answerAllTeams teams = concatMap toAnswer teams
- where
- toAnswer team =
- [AnswerThisClient $ teamToNet team,
- AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
- AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
+answerAllTeams protocol teams = concatMap toAnswer teams
+ where
+ toAnswer team =
+ [AnswerThisClient $ teamToNet protocol team,
+ AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team],
+ AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]]
handleCmd_lobby :: CmdHandler
handleCmd_lobby clID clients rooms ["LIST"] =
- [AnswerThisClient ("ROOMS" : roomsInfoList)]
- where
- roomsInfoList = concatMap roomInfo sameProtoRooms
- sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList
- roomsList = IntMap.elems rooms
- protocol = clientProto client
- client = clients IntMap.! clID
- roomInfo room
- | clientProto client < 28 = [
- name room,
- show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
- show $ gameinprogress room
- ]
- | otherwise = [
- show $ gameinprogress room,
- name room,
- show $ playersIn room,
- show $ length $ teams room,
- nick $ clients IntMap.! (masterID room),
- head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
- head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
- head (Map.findWithDefault ["Default"] "AMMO" (params room))
- ]
+ [AnswerThisClient ("ROOMS" : roomsInfoList)]
+ where
+ roomsInfoList = concatMap roomInfo sameProtoRooms
+ sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList
+ roomsList = IntMap.elems rooms
+ protocol = clientProto client
+ client = clients IntMap.! clID
+ roomInfo room
+ | clientProto client < 28 = [
+ name room,
+ show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
+ show $ gameinprogress room
+ ]
+ | otherwise = [
+ show $ gameinprogress room,
+ name room,
+ show $ playersIn room,
+ show $ length $ teams room,
+ nick $ clients IntMap.! (masterID room),
+ head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
+ head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
+ head (Map.findWithDefault ["Default"] "AMMO" (params room))
+ ]
handleCmd_lobby clID clients _ ["CHAT", msg] =
- [AnswerOthersInRoom ["CHAT", clientNick, msg]]
- where
- clientNick = nick $ clients IntMap.! clID
+ [AnswerOthersInRoom ["CHAT", clientNick, msg]]
+ where
+ clientNick = nick $ clients IntMap.! clID
handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword]
- | haveSameRoom = [Warning "Room exists"]
- | illegalName newRoom = [Warning "Illegal room name"]
- | otherwise =
- [RoomRemoveThisClient "", -- leave lobby
- AddRoom newRoom roomPassword,
- AnswerThisClient ["NOT_READY", clientNick]
- ]
- where
- clientNick = nick $ clients IntMap.! clID
- haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
+ | haveSameRoom = [Warning "Room exists"]
+ | illegalName newRoom = [Warning "Illegal room name"]
+ | otherwise =
+ [RoomRemoveThisClient "", -- leave lobby
+ AddRoom newRoom roomPassword,
+ AnswerThisClient ["NOT_READY", clientNick]
+ ]
+ where
+ clientNick = nick $ clients IntMap.! clID
+ haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] =
- handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""]
+ handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""]
handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword]
- | noSuchRoom = [Warning "No such room"]
- | isRestrictedJoins jRoom = [Warning "Joining restricted"]
- | roomPassword /= password jRoom = [Warning "Wrong password"]
- | otherwise =
- [RoomRemoveThisClient "", -- leave lobby
- RoomAddThisClient rID] -- join room
- ++ answerNicks
- ++ answerReady
- ++ [AnswerThisRoom ["NOT_READY", nick client]]
- ++ answerFullConfig
- ++ answerTeams
- ++ watchRound
- where
- noSuchRoom = isNothing mbRoom
- mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
- jRoom = fromJust mbRoom
- rID = roomUID jRoom
- client = clients IntMap.! clID
- roomClientsIDs = IntSet.elems $ playersIDs jRoom
- answerNicks =
- [AnswerThisClient $ "JOINED" :
- map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0]
- answerReady = map
- ((\ c ->
- AnswerThisClient
- [if isReady c then "READY" else "NOT_READY", nick c])
- . (\ clID -> clients IntMap.! clID))
- roomClientsIDs
+ | noSuchRoom = [Warning "No such room"]
+ | isRestrictedJoins jRoom = [Warning "Joining restricted"]
+ | roomPassword /= password jRoom = [Warning "Wrong password"]
+ | otherwise =
+ [RoomRemoveThisClient "", -- leave lobby
+ RoomAddThisClient rID] -- join room
+ ++ answerNicks
+ ++ answerReady
+ ++ [AnswerThisRoom ["NOT_READY", nick client]]
+ ++ answerFullConfig
+ ++ answerTeams
+ ++ watchRound
+ where
+ noSuchRoom = isNothing mbRoom
+ mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
+ jRoom = fromJust mbRoom
+ rID = roomUID jRoom
+ client = clients IntMap.! clID
+ roomClientsIDs = IntSet.elems $ playersIDs jRoom
+ answerNicks =
+ [AnswerThisClient $ "JOINED" :
+ map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0]
+ answerReady = map
+ ((\ c ->
+ AnswerThisClient
+ [if isReady c then "READY" else "NOT_READY", nick c])
+ . (\ clID -> clients IntMap.! clID))
+ roomClientsIDs
- toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
-
- answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
- (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
+ toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
+
+ answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart)
+ (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom)
- watchRound = if not $ gameinprogress jRoom then
- []
- else
- [AnswerThisClient ["RUN_GAME"],
- AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
+ watchRound = if not $ gameinprogress jRoom then
+ []
+ else
+ [AnswerThisClient ["RUN_GAME"],
+ AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)]
- answerTeams = if gameinprogress jRoom then
- answerAllTeams (teamsAtStart jRoom)
- else
- answerAllTeams (teams jRoom)
+ answerTeams = if gameinprogress jRoom then
+ answerAllTeams (clientProto client) (teamsAtStart jRoom)
+ else
+ answerAllTeams (clientProto client) (teams jRoom)
handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] =
- handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
+ handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""]
- ---------------------------
- -- Administrator's stuff --
+ ---------------------------
+ -- Administrator's stuff --
handleCmd_lobby clID clients rooms ["KICK", kickNick] =
- [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID]
- where
- client = clients IntMap.! clID
- maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
- noSuchClient = isNothing maybeClient
- kickID = clientUID $ fromJust maybeClient
+ [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID]
+ where
+ client = clients IntMap.! clID
+ maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
+ noSuchClient = isNothing maybeClient
+ kickID = clientUID $ fromJust maybeClient
handleCmd_lobby clID clients rooms ["BAN", banNick] =
- if not $ isAdministrator client then
- []
- else
- BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick]
- where
- client = clients IntMap.! clID
+ if not $ isAdministrator client then
+ []
+ else
+ BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick]
+ where
+ client = clients IntMap.! clID
handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] =
- [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client]
- where
- client = clients IntMap.! clID
+ [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client]
+ where
+ client = clients IntMap.! clID
handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] =
- [ClearAccountsCache | isAdministrator client]
- where
- client = clients IntMap.! clID
+ [ClearAccountsCache | isAdministrator client]
+ where
+ client = clients IntMap.! clID
handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]