--- a/gameServer/HWProtoInRoomState.hs Thu Feb 25 15:58:44 2010 +0000
+++ b/gameServer/HWProtoInRoomState.hs Thu Feb 25 18:28:33 2010 +0000
@@ -16,192 +16,195 @@
handleCmd_inRoom :: CmdHandler
handleCmd_inRoom 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_inRoom clID clients _ ["TEAM_CHAT", msg] =
- [AnswerOthersInRoom ["TEAM_CHAT", clientNick, msg]]
- where
- clientNick = nick $ clients IntMap.! clID
+ [AnswerOthersInRoom ["TEAM_CHAT", clientNick, msg]]
+ where
+ clientNick = nick $ clients IntMap.! clID
handleCmd_inRoom clID clients rooms ["PART"] =
- [RoomRemoveThisClient "part"]
- where
- client = clients IntMap.! clID
+ [RoomRemoveThisClient "part"]
+ where
+ client = clients IntMap.! clID
handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs)
- | null paramStrs = [ProtocolError "Empty config entry"]
- | isMaster client =
- [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
- AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
- | otherwise = [ProtocolError "Not room master"]
- where
- client = clients IntMap.! clID
+ | null paramStrs = [ProtocolError "Empty config entry"]
+ | isMaster client =
+ [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
+ AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
+ | otherwise = [ProtocolError "Not room master"]
+ where
+ client = clients IntMap.! clID
handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
- | length hhsInfo /= 16 = []
- | length (teams room) == 6 = [Warning "too many teams"]
- | canAddNumber <= 0 = [Warning "too many hedgehogs"]
- | isJust findTeam = [Warning "There's already a team with same name in the list"]
- | gameinprogress room = [Warning "round in progress"]
- | isRestrictedTeams room = [Warning "restricted"]
- | otherwise =
- [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
- ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
- AnswerThisClient ["TEAM_ACCEPTED", name],
- AnswerOthersInRoom $ teamToNet newTeam,
- AnswerOthersInRoom ["TEAM_COLOR", name, color]
- ]
- where
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
- canAddNumber = 48 - (sum . map hhnum $ teams room)
- findTeam = find (\t -> name == teamname t) $ teams room
- newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
- difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
- hhsList [] = []
- hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
- newTeamHHNum = min 4 canAddNumber
+ | length hhsInfo /= 16 = []
+ | length (teams room) == 6 = [Warning "too many teams"]
+ | canAddNumber <= 0 = [Warning "too many hedgehogs"]
+ | isJust findTeam = [Warning "There's already a team with same name in the list"]
+ | gameinprogress room = [Warning "round in progress"]
+ | isRestrictedTeams room = [Warning "restricted"]
+ | otherwise =
+ [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
+ ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
+ AnswerThisClient ["TEAM_ACCEPTED", name],
+ AnswerOthersInRoom $ teamToNet (clientProto client) newTeam,
+ AnswerOthersInRoom ["TEAM_COLOR", name, color]
+ ]
+ where
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
+ canAddNumber = 48 - (sum . map hhnum $ teams room)
+ findTeam = find (\t -> name == teamname t) $ teams room
+ newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
+ difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
+ hhsList [] = []
+ hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
+ newTeamHHNum = min 4 canAddNumber
+
+handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo) =
+ handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : "" : difStr : hhsInfo)
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
- | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
- | nick client /= teamowner team = [ProtocolError "Not team owner!"]
- | otherwise =
- [RemoveTeam teamName,
- ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1})
- ]
- where
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
- noSuchTeam = isNothing findTeam
- team = fromJust findTeam
- findTeam = find (\t -> teamName == teamname t) $ teams room
+ | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
+ | nick client /= teamowner team = [ProtocolError "Not team owner!"]
+ | otherwise =
+ [RemoveTeam teamName,
+ ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1})
+ ]
+ where
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
+ noSuchTeam = isNothing findTeam
+ team = fromJust findTeam
+ findTeam = find (\t -> teamName == teamname t) $ teams room
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr]
- | not $ isMaster client = [ProtocolError "Not room master"]
- | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = []
- | otherwise =
- [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
- AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
- where
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
- hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
- noSuchTeam = isNothing findTeam
- team = fromJust findTeam
- findTeam = find (\t -> teamName == teamname t) $ teams room
- canAddNumber = 48 - (sum . map hhnum $ teams room)
+ | not $ isMaster client = [ProtocolError "Not room master"]
+ | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = []
+ | otherwise =
+ [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
+ AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
+ where
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
+ hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
+ noSuchTeam = isNothing findTeam
+ team = fromJust findTeam
+ findTeam = find (\t -> teamName == teamname t) $ teams room
+ canAddNumber = 48 - (sum . map hhnum $ teams room)
handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor]
- | not $ isMaster client = [ProtocolError "Not room master"]
- | noSuchTeam = []
- | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor},
- AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor],
- ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})]
- where
- noSuchTeam = isNothing findTeam
- team = fromJust findTeam
- findTeam = find (\t -> teamName == teamname t) $ teams room
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
+ | not $ isMaster client = [ProtocolError "Not room master"]
+ | noSuchTeam = []
+ | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor},
+ AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor],
+ ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})]
+ where
+ noSuchTeam = isNothing findTeam
+ team = fromJust findTeam
+ findTeam = find (\t -> teamName == teamname t) $ teams room
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
- [ModifyClient (\c -> c{isReady = not $ isReady client}),
- ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
- AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
- where
- client = clients IntMap.! clID
+ [ModifyClient (\c -> c{isReady = not $ isReady client}),
+ ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
+ AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
+ where
+ client = clients IntMap.! clID
handleCmd_inRoom clID clients rooms ["START_GAME"] =
- if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
- if enoughClans then
- [ModifyRoom
- (\r -> r{
- gameinprogress = True,
- roundMsgs = empty,
- leftTeams = [],
- teamsAtStart = teams r}
- ),
- AnswerThisRoom ["RUN_GAME"]]
- else
- [Warning "Less than two clans!"]
- else
- []
- where
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
- enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
+ if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
+ if enoughClans then
+ [ModifyRoom
+ (\r -> r{
+ gameinprogress = True,
+ roundMsgs = empty,
+ leftTeams = [],
+ teamsAtStart = teams r}
+ ),
+ AnswerThisRoom ["RUN_GAME"]]
+ else
+ [Warning "Less than two clans!"]
+ else
+ []
+ where
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
+ enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
handleCmd_inRoom clID clients rooms ["EM", msg] =
- if (teamsInGame client > 0) && isLegal then
- (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
- else
- []
- where
- client = clients IntMap.! clID
- (isLegal, isKeepAlive) = checkNetCmd msg
+ if (teamsInGame client > 0) && isLegal then
+ (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
+ else
+ []
+ where
+ client = clients IntMap.! clID
+ (isLegal, isKeepAlive) = checkNetCmd msg
handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
- if isMaster client then
- [ModifyRoom
- (\r -> r{
- gameinprogress = False,
- readyPlayers = 0,
- roundMsgs = empty,
- leftTeams = [],
- teamsAtStart = []}
- ),
- UnreadyRoomClients
- ] ++ answerRemovedTeams
- else
- []
- where
- client = clients IntMap.! clID
- room = rooms IntMap.! (roomID client)
- answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
+ if isMaster client then
+ [ModifyRoom
+ (\r -> r{
+ gameinprogress = False,
+ readyPlayers = 0,
+ roundMsgs = empty,
+ leftTeams = [],
+ teamsAtStart = []}
+ ),
+ UnreadyRoomClients
+ ] ++ answerRemovedTeams
+ else
+ []
+ where
+ client = clients IntMap.! clID
+ room = rooms IntMap.! (roomID client)
+ answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"]
- | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
- | otherwise = [ProtocolError "Not room master"]
- where
- client = clients IntMap.! clID
+ | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
+ | otherwise = [ProtocolError "Not room master"]
+ where
+ client = clients IntMap.! clID
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"]
- | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
- | otherwise = [ProtocolError "Not room master"]
- where
- client = clients IntMap.! clID
+ | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
+ | otherwise = [ProtocolError "Not room master"]
+ where
+ client = clients IntMap.! clID
handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
- [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
- where
- client = clients IntMap.! clID
- maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
- noSuchClient = isNothing maybeClient
- kickClient = fromJust maybeClient
- kickID = clientUID kickClient
+ [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
+ where
+ client = clients IntMap.! clID
+ maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
+ noSuchClient = isNothing maybeClient
+ kickClient = fromJust maybeClient
+ kickID = clientUID kickClient
handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] =
- if (teamsInGame client > 0) then
- [AnswerSameClan ["EM", engineMsg]]
- else
- []
- where
- client = clients IntMap.! clID
- engineMsg = toEngineMsg $ 'b' : (nick client ++ "(team): " ++ decodedMsg ++ "\x20\x20")
- decodedMsg = UTF8.decodeString msg
+ if (teamsInGame client > 0) then
+ [AnswerSameClan ["EM", engineMsg]]
+ else
+ []
+ where
+ client = clients IntMap.! clID
+ engineMsg = toEngineMsg $ 'b' : (nick client ++ "(team): " ++ decodedMsg ++ "\x20\x20")
+ decodedMsg = UTF8.decodeString msg
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]