# HG changeset patch # User unc0rr # Date 1316808057 -14400 # Node ID 2c72fe81dd37306e0844b79bbb0b4d62807a9b70 # Parent 3c578f531cc15cf45d84420fcdcf31baaeb85270 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/Actions.hs --- a/gameServer/Actions.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/Actions.hs Sat Sep 24 00:00:57 2011 +0400 @@ -17,10 +17,10 @@ import Data.Unique import Control.Arrow import Control.Exception -import OfficialServer.GameReplayStore import System.Process import Network.Socket ----------------------------- +import OfficialServer.GameReplayStore import CoreTypes import Utils import ClientIO @@ -206,7 +206,7 @@ (Just ci) <- gets clientIndex ri <- clientRoomA rnc <- gets roomsClients - (gameProgress, playersNum) <- io $ room'sM rnc (gameinprogress &&& playersIn) ri + (gameProgress, playersNum) <- io $ room'sM rnc ((isJust . gameInfo) &&& playersIn) ri ready <- client's isReady master <- client's isMaster -- client <- client's id @@ -298,7 +298,7 @@ processAction (RemoveTeam teamName) = do rnc <- gets roomsClients ri <- clientRoomA - inGame <- io $ room'sM rnc gameinprogress ri + inGame <- io $ room'sM rnc (isJust . gameInfo) ri chans <- othersChans if not $ inGame then mapM_ processAction [ @@ -310,8 +310,10 @@ AnswerClients chans ["EM", rmTeamMsg], ModifyRoom (\r -> r{ teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r, - leftTeams = teamName : leftTeams r, - roundMsgs = roundMsgs r Seq.|> rmTeamMsg + gameInfo = liftM (\g -> g{ + leftTeams = teamName : leftTeams g, + roundMsgs = roundMsgs g Seq.|> rmTeamMsg + }) $ gameInfo r }) ] where diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/CoreTypes.hs Sat Sep 24 00:00:57 2011 +0400 @@ -62,6 +62,22 @@ hedgehogs :: [HedgehogInfo] } deriving (Show, Read) + +data GameInfo = + GameInfo + { + roundMsgs :: Seq B.ByteString, + leftTeams :: [B.ByteString], + teamsAtStart :: [TeamInfo], + allPlayersHaveRegisteredAccounts :: Bool + } + +newGameInfo :: Bool -> GameInfo +newGameInfo = + GameInfo + Data.Sequence.empty + [] + [] data RoomInfo = RoomInfo @@ -71,14 +87,11 @@ password :: B.ByteString, roomProto :: Word16, teams :: [TeamInfo], - gameinprogress :: Bool, + gameInfo :: Maybe GameInfo, playersIn :: !Int, readyPlayers :: !Int, isRestrictedJoins :: Bool, isRestrictedTeams :: Bool, - roundMsgs :: Seq B.ByteString, - leftTeams :: [B.ByteString], - teamsAtStart :: [TeamInfo], mapParams :: Map.Map B.ByteString B.ByteString, params :: Map.Map B.ByteString [B.ByteString] } @@ -91,14 +104,11 @@ "" 0 [] - False + Nothing 0 0 False False - Data.Sequence.empty - [] - [] ( Map.fromList $ Prelude.zipWith (,) ["MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"] diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/HWProtoCore.hs --- a/gameServer/HWProtoCore.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/HWProtoCore.hs Sat Sep 24 00:00:57 2011 +0400 @@ -52,7 +52,7 @@ let roomMasterSign = if isMaster cl then "@" else "" let adminSign = if isAdministrator cl then "@" else "" let roomInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" - let roomStatus = if gameinprogress clRoom then + let roomStatus = if isJust $ gameInfo clRoom then if teamsInGame cl > 0 then "(playing)" else "(spectating)" else "" diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/HWProtoInRoomState.hs Sat Sep 24 00:00:57 2011 +0400 @@ -58,7 +58,7 @@ [Warning "too many hedgehogs"] else if isJust $ findTeam rm then [Warning "There's already a team with same name in the list"] - else if gameinprogress rm then + else if isJust $ gameInfo rm then [Warning "round in progress"] else if isRestrictedTeams rm then [Warning "restricted"] @@ -170,15 +170,13 @@ rm <- thisRoom chans <- roomClientsChans - if isMaster cl && playersIn rm == readyPlayers rm && not (gameinprogress rm) then + if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then if enoughClans rm then return [ ModifyRoom (\r -> r{ - gameinprogress = True, - roundMsgs = empty, - leftTeams = [], - teamsAtStart = teams r} + gameInfo = Just $ newGameInfo False + } ), AnswerClients chans ["RUN_GAME"] ] @@ -195,35 +193,34 @@ rm <- thisRoom chans <- roomOthersChans - if teamsInGame cl > 0 && gameinprogress rm && isLegal then - return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive] + 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] else return [] where (isLegal, isKeepAlive) = checkNetCmd msg -handleCmd_inRoom ["ROUNDFINISHED", _] = do +handleCmd_inRoom ["ROUNDFINISHED", correctly] = do cl <- thisClient rm <- thisRoom chans <- roomClientsChans - if isMaster cl && gameinprogress rm then + if isMaster cl && (isJust $ gameInfo rm) then return $ ModifyRoom (\r -> r{ - gameinprogress = False, - readyPlayers = 0, - roundMsgs = empty, - leftTeams = [], - teamsAtStart = []} + gameInfo = Nothing, + readyPlayers = 0 + } ) : UnreadyRoomClients : answerRemovedTeams chans rm else return [] where - answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams + answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo + isCorrect = correctly == "1" -- compatibility with clients with protocol < 38 handleCmd_inRoom ["ROUNDFINISHED"] = diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/HWProtoLobbyState.hs Sat Sep 24 00:00:57 2011 +0400 @@ -34,7 +34,7 @@ return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] where roomInfo irnc r = [ - showB $ gameinprogress r, + showB $ isJust $ gameInfo r, name r, showB $ playersIn r, showB $ length $ teams r, @@ -117,13 +117,13 @@ : ("SCHEME", pr Map.! "SCHEME") : (filter (\(p, _) -> p /= "SCHEME") $ Map.toList pr) - answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom + answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom - watchRound cl jRoom = if not $ gameinprogress jRoom then + watchRound cl jRoom = if isNothing $ gameInfo jRoom then [] else [AnswerClients [sendChan cl] ["RUN_GAME"], - AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] + AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs . fromJust . gameInfo $ jRoom)] handleCmd_lobby ["JOIN_ROOM", roomName] = diff -r 3c578f531cc1 -r 2c72fe81dd37 gameServer/OfficialServer/GameReplayStore.hs --- a/gameServer/OfficialServer/GameReplayStore.hs Fri Sep 23 09:58:41 2011 +0200 +++ b/gameServer/OfficialServer/GameReplayStore.hs Sat Sep 24 00:00:57 2011 +0400 @@ -7,12 +7,14 @@ import qualified Data.Map as Map import Data.Sequence() import System.Log.Logger +import Data.Maybe saveReplay :: RoomInfo -> IO () saveReplay r = do time <- getCurrentTime let fileName = "replays/" ++ show time - let replayInfo = (teamsAtStart r, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs r) + let gi = fromJust $ gameInfo r + let replayInfo = (teamsAtStart gi, Map.toList $ mapParams r, Map.toList $ params r, roundMsgs gi) E.catch (writeFile fileName (show replayInfo)) (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)