diff -r 46a9fde631f4 -r 75db7bb8dce8 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Wed Jan 02 11:11:49 2013 +0100 +++ b/gameServer/HWProtoInRoomState.hs Sun Jan 27 00:28:57 2013 +0100 @@ -2,13 +2,11 @@ module HWProtoInRoomState where import qualified Data.Map as Map -import Data.Sequence((|>)) import Data.List as L import Data.Maybe import qualified Data.ByteString.Char8 as B import Control.Monad import Control.Monad.Reader -import Control.DeepSeq -------------------------------------- import CoreTypes import Actions @@ -29,7 +27,7 @@ handleCmd_inRoom ("CFG" : paramName : paramStrs) - | null paramStrs = return [ProtocolError "Empty config entry"] + | null paramStrs = return [ProtocolError $ loc "Empty config entry"] | otherwise = do chans <- roomOthersChans cl <- thisClient @@ -38,7 +36,7 @@ ModifyRoom f, AnswerClients chans ("CFG" : paramName : paramStrs)] else - return [ProtocolError "Not room master"] + return [ProtocolError $ loc "Not room master"] where f r = if paramName `Map.member` (mapParams r) then r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} @@ -46,7 +44,7 @@ r{params = Map.insert paramName paramStrs (params r)} handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) - | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"] + | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] | otherwise = do (ci, _) <- ask rm <- thisRoom @@ -60,34 +58,37 @@ return color else liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom - let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif (newTeamHHNum rm) (hhsList hhsInfo) + let roomTeams = teams rm + let hhNum = let p = if not $ null roomTeams then hhnum $ head roomTeams else 4 in newTeamHHNum roomTeams p + let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo) return $ - if not . null . drop (maxTeams rm - 1) $ teams rm then - [Warning "too many teams"] - else if canAddNumber rm <= 0 then - [Warning "too many hedgehogs"] + if not . null . drop (maxTeams rm - 1) $ roomTeams then + [Warning $ loc "too many teams"] + else if canAddNumber roomTeams <= 0 then + [Warning $ loc "too many hedgehogs"] else if isJust $ findTeam rm then - [Warning "There's already a team with same name in the list"] + [Warning $ loc "There's already a team with same name in the list"] else if isJust $ gameInfo rm then - [Warning "round in progress"] + [Warning $ loc "round in progress"] else if isRestrictedTeams rm then - [Warning "restricted"] + [Warning $ loc "restricted"] else [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), SendUpdateOnThisRoom, ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), AnswerClients clChan ["TEAM_ACCEPTED", tName], + AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam], AnswerClients othChans $ teamToNet $ newTeam, AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] ] where - canAddNumber r = 48 - (sum . map hhnum $ teams r) + canAddNumber rt = (48::Int) - (sum $ map hhnum rt) findTeam = find (\t -> tName == teamname t) . teams dif = readInt_ difStr hhsList [] = [] hhsList [_] = error "Hedgehogs list with odd elements number" hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs - newTeamHHNum r = min 4 (canAddNumber r) + newTeamHHNum rt p = min p (canAddNumber rt) maxTeams r | roomProto r < 38 = 6 | otherwise = 8 @@ -102,10 +103,10 @@ let team = fromJust maybeTeam return $ - if isNothing $ findTeam r then - [Warning "REMOVE_TEAM: no such team"] + if isNothing $ maybeTeam then + [Warning $ loc "REMOVE_TEAM: no such team"] else if clNick /= teamowner team then - [ProtocolError "Not team owner!"] + [ProtocolError $ loc "Not team owner!"] else [RemoveTeam tName, ModifyClient @@ -121,20 +122,23 @@ handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do cl <- thisClient - others <- roomOthersChans r <- thisRoom + clChan <- thisClientChans + roomChans <- roomClientsChans let maybeTeam = findTeam r let team = fromJust maybeTeam return $ if not $ isMaster cl then - [ProtocolError "Not room master"] - else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > canAddNumber r + hhnum team then + [ProtocolError $ loc "Not room master"] + else if isNothing maybeTeam then [] + else if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber r + hhnum team then + [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] else [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, - AnswerClients others ["HH_NUM", teamName, showB hhNumber]] + AnswerClients roomChans ["HH_NUM", teamName, showB hhNumber]] where hhNumber = readInt_ numberStr findTeam = find (\t -> teamName == teamname t) . teams @@ -152,7 +156,7 @@ return $ if not $ isMaster cl then - [ProtocolError "Not room master"] + [ProtocolError $ loc "Not room master"] else if isNothing maybeTeam then [] else @@ -187,7 +191,7 @@ let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm - if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then + if isMaster cl && (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then if enoughClans rm then return [ ModifyRoom @@ -201,7 +205,7 @@ , ModifyRoomClients (\c -> c{isInGame = True}) ] else - return [Warning "Less than two clans!"] + return [Warning $ loc "Less than two clans!"] else return [] where @@ -214,7 +218,8 @@ chans <- roomOthersChans if teamsInGame cl > 0 && (isJust $ gameInfo rm) && isLegal then - return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = roundMsgs g |> msg}) $ gameInfo r}) | not isKeepAlive] + return $ AnswerClients chans ["EM", msg] + : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = msg : roundMsgs g}) $ gameInfo r}) | not isKeepAlive] else return [] where @@ -231,10 +236,7 @@ if isInGame cl then if isJust $ gameInfo rm then - if (isMaster cl && isCorrect) then - return $ FinishGame : unsetInGameState - else - return $ unsetInGameState ++ map SendTeamRemovalMessage clTeams + return $ unsetInGameState ++ map SendTeamRemovalMessage clTeams else return unsetInGameState else @@ -250,7 +252,7 @@ cl <- thisClient return $ if not $ isMaster cl then - [ProtocolError "Not room master"] + [ProtocolError $ loc "Not room master"] else [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] @@ -259,7 +261,7 @@ cl <- thisClient return $ if not $ isMaster cl then - [ProtocolError "Not room master"] + [ProtocolError $ loc "Not room master"] else [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] @@ -268,7 +270,7 @@ cl <- thisClient return $ if not $ isMaster cl then - [ProtocolError "Not room master"] + [ProtocolError $ loc "Not room master"] else [ModifyRoom (\r -> r{isRegisteredOnly = not $ isRegisteredOnly r})] @@ -280,10 +282,10 @@ return $ if not $ isMaster cl then - [ProtocolError "Not room master"] + [ProtocolError $ loc "Not room master"] else if isJust $ find (\r -> newName == name r) rs then - [Warning "Room with such name already exists"] + [Warning $ loc "Room with such name already exists"] else [ModifyRoom roomUpdate, AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (nick cl) (roomUpdate rm))] @@ -305,10 +307,15 @@ (thisClientId, rnc) <- ask maybeClientId <- clientByNick newAdmin master <- liftM isMaster thisClient + serverAdmin <- liftM isAdministrator thisClient let newAdminId = fromJust maybeClientId let sameRoom = clientRoom rnc thisClientId == clientRoom rnc newAdminId return - [ChangeMaster (Just newAdminId) | master && isJust maybeClientId && (newAdminId /= thisClientId) && sameRoom] + [ChangeMaster (Just newAdminId) | + (master || serverAdmin) + && isJust maybeClientId + && ((newAdminId /= thisClientId) || (serverAdmin && not master)) + && sameRoom] handleCmd_inRoom ["TEAMCHAT", msg] = do