diff -r 8455993a7a1b -r 8bf092ddc536 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Thu Jan 16 19:50:18 2014 +0100 +++ b/gameServer/HWProtoInRoomState.hs Thu Jan 16 23:47:36 2014 +0400 @@ -15,6 +15,39 @@ import RoomsAndClients import EngineInteraction + +startGame :: Reader (ClientIndex, IRnC) [Action] +startGame = do + (ci, rnc) <- ask + cl <- thisClient + rm <- thisRoom + chans <- roomClientsChans + + let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci + let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm + + if (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then + if enoughClans rm then + return [ + ModifyRoom + (\r -> r{ + gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) + } + ) + , AnswerClients chans ["RUN_GAME"] + , SendUpdateOnThisRoom + , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks + , ModifyRoomClients (\c -> c{isInGame = True}) + ] + else + return [Warning $ loc "Less than two clans!"] + else + return [] + where + enoughClans = not . null . drop 1 . group . map teamcolor . teams + + + handleCmd_inRoom :: CmdHandler handleCmd_inRoom ["CHAT", msg] = do @@ -173,48 +206,29 @@ handleCmd_inRoom ["TOGGLE_READY"] = do cl <- thisClient - chans <- roomClientsChans - - return [ - ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), - ModifyClient (\c -> c{isReady = not $ isReady cl}), - AnswerClients chans $ if clientProto cl < 38 then - [if isReady cl then "NOT_READY" else "READY", nick cl] - else - ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] - ] - - -handleCmd_inRoom ["START_GAME"] = do - (ci, rnc) <- ask - cl <- thisClient rm <- thisRoom chans <- roomClientsChans - let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci - let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm + (ci, rnc) <- ask + let ri = clientRoom rnc ci + let unreadyClients = filter (not . isReady) . map (client rnc) $ roomClients rnc ri + + gs <- if (not $ isReady cl) && (isSpecial rm) && (unreadyClients == [cl]) then startGame else return [] - if isMaster cl && (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then - if enoughClans rm then - return [ - ModifyRoom - (\r -> r{ - gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) - } - ) - , AnswerClients chans ["RUN_GAME"] - , SendUpdateOnThisRoom - , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks - , ModifyRoomClients (\c -> c{isInGame = True}) - ] - else - return [Warning $ loc "Less than two clans!"] - else - return [] - where - enoughClans = not . null . drop 1 . group . map teamcolor . teams + return $ + ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}) + : ModifyClient (\c -> c{isReady = not $ isReady cl}) + : (AnswerClients chans $ if clientProto cl < 38 then + [if isReady cl then "NOT_READY" else "READY", nick cl] + else + ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]) + : gs +handleCmd_inRoom ["START_GAME"] = do + cl <- thisClient + if isMaster cl then startGame else return [] + handleCmd_inRoom ["EM", msg] = do cl <- thisClient rm <- thisRoom