--- 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