# HG changeset patch # User unc0rr # Date 1370464110 -14400 # Node ID 878f06e9c4848ec907bc4e111c8652d88d33cc41 # Parent 4dde5fecffe2d40b66f8e1755c4854b19940b7ab - Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested. - Fix a bunch of build warnings diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/Actions.hs --- a/gameServer/Actions.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/Actions.hs Thu Jun 06 00:28:30 2013 +0400 @@ -162,7 +162,13 @@ rnc <- gets roomsClients io $ do - modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False, isInGame = False, clientClan = Nothing}) ci + modifyClient rnc ( + \cl -> cl{teamsInGame = 0 + , isReady = False + , isMaster = False + , isInGame = False + , isJoinedMidGame = False + , clientClan = Nothing}) ci modifyRoom rnc (\r -> r{playersIn = playersIn r + 1}) ri moveClientToRoom rnc ri ci @@ -290,7 +296,7 @@ pr <- client's clientProto mapM_ processAction [ AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr . map nick . filter (not . isMaster) $ roomPlayers - , ModifyRoomClients (\cl -> cl{isReady = isMaster cl}) + , ModifyRoomClients (\cl -> cl{isReady = isMaster cl, isJoinedMidGame = False}) , ModifyRoom (\r -> r{readyPlayers = 1}) ] where @@ -301,10 +307,17 @@ rnc <- gets roomsClients ri <- clientRoomA thisRoomChans <- liftM (map sendChan) $ roomClientsS ri + joinedMidGame <- liftM (filter isJoinedMidGame) $ roomClientsS ri answerRemovedTeams <- io $ - room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri + room'sM rnc (\r -> let gi = fromJust $ gameInfo r in + concatMap (\c -> + (answerFullConfigParams c (mapParams r) (params r)) + ++ + (map (\t -> AnswerClients [sendChan c] ["REMOVE_TEAM", t]) $ leftTeams gi) + ) joinedMidGame + ) ri - mapM_ processAction $ + mapM_ processAction $ ( SaveReplay : ModifyRoom (\r -> r{ @@ -312,10 +325,11 @@ readyPlayers = 0 } ) - : UnreadyRoomClients : SendUpdateOnThisRoom : AnswerClients thisRoomChans ["ROUND_FINISHED"] : answerRemovedTeams + ) + ++ [UnreadyRoomClients] processAction (SendTeamRemovalMessage teamName) = do diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/CoreTypes.hs Thu Jun 06 00:28:30 2013 +0400 @@ -107,6 +107,7 @@ isAdministrator :: Bool, isChecker :: Bool, isKickedFromServer :: Bool, + isJoinedMidGame :: Bool, clientClan :: !(Maybe B.ByteString), checkInfo :: Maybe CheckInfo, teamsInGame :: Word diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/HWProtoChecker.hs --- a/gameServer/HWProtoChecker.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/HWProtoChecker.hs Thu Jun 06 00:28:30 2013 +0400 @@ -1,17 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module HWProtoChecker where -import qualified Data.Map as Map import Data.Maybe -import Data.List import Control.Monad.Reader -------------------------------------- import CoreTypes import Actions -import Utils import HandlerUtils -import RoomsAndClients -import EngineInteraction handleCmd_checker :: CmdHandler diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/HWProtoLobbyState.hs Thu Jun 06 00:28:30 2013 +0400 @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module HWProtoLobbyState where -import qualified Data.Map as Map import Data.Maybe import Data.List import Control.Monad.Reader @@ -51,7 +50,7 @@ [ AddRoom rName roomPassword , AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+hr", nick cl] - , ModifyClient (\c -> c{isMaster = True, isReady = True}) + , ModifyClient (\c -> c{isMaster = True, isReady = True, isJoinedMidGame = False}) , ModifyRoom (\r -> r{readyPlayers = 1}) ] @@ -87,12 +86,13 @@ else [ MoveToRoom jRI + , ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom}) , AnswerClients [sendChan cl] $ "JOINED" : nicks , AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] , AnswerClients [sendChan cl] $ ["CLIENT_FLAGS", "+h", ownerNick] ] ++ (if clientProto cl < 38 then map (readynessMessage cl) jRoomClients else [sendStateFlags cl jRoomClients]) - ++ answerFullConfig cl (mapParams jRoom) (params jRoom) + ++ answerFullConfig cl jRoom ++ answerTeams cl jRoom ++ watchRound cl jRoom chans @@ -105,18 +105,9 @@ (ingame, inroomlobby) = partition isInGame clients f fl lst = ["CLIENT_FLAGS" : fl : map nick lst | not $ null lst] - toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs - - answerFullConfig cl mpr pr - | clientProto cl < 38 = map (toAnswer cl) $ - (reverse . map (\(a, b) -> (a, [b])) $ Map.toList mpr) - ++ (("SCHEME", pr Map.! "SCHEME") - : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)) - - | otherwise = map (toAnswer cl) $ - ("FULLMAPCONFIG", Map.elems mpr) - : ("SCHEME", pr Map.! "SCHEME") - : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr) + -- get config from gameInfo if possible, otherwise from room + answerFullConfig cl jRoom = let f r g = (if isJust $ gameInfo jRoom then g . fromJust . gameInfo else r) jRoom + in answerFullConfigParams cl (f mapParams giMapParams) (f params giParams) answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/HandlerUtils.hs --- a/gameServer/HandlerUtils.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/HandlerUtils.hs Thu Jun 06 00:28:30 2013 +0400 @@ -6,7 +6,7 @@ import RoomsAndClients import CoreTypes -import Actions + thisClient :: Reader (ClientIndex, IRnC) ClientInfo thisClient = do diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/NetRoutines.hs --- a/gameServer/NetRoutines.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/NetRoutines.hs Thu Jun 06 00:28:30 2013 +0400 @@ -44,6 +44,7 @@ False False False + False Nothing Nothing 0 diff -r 4dde5fecffe2 -r 878f06e9c484 gameServer/Utils.hs --- a/gameServer/Utils.hs Wed Jun 05 00:26:22 2013 +0400 +++ b/gameServer/Utils.hs Thu Jun 06 00:28:30 2013 +0400 @@ -137,5 +137,25 @@ head (Map.findWithDefault ["Default"] "AMMO" (params r)) ] + +answerFullConfigParams :: + ClientInfo + -> Map.Map B.ByteString B.ByteString + -> Map.Map B.ByteString [B.ByteString] + -> [Action] +answerFullConfigParams cl mpr pr + | clientProto cl < 38 = map (toAnswer cl) $ + (reverse . map (\(a, b) -> (a, [b])) $ Map.toList mpr) + ++ (("SCHEME", pr Map.! "SCHEME") + : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr)) + + | otherwise = map (toAnswer cl) $ + ("FULLMAPCONFIG", Map.elems mpr) + : ("SCHEME", pr Map.! "SCHEME") + : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr) + where + toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs + + loc :: B.ByteString -> B.ByteString loc = id