Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
--- 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
--- 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"]
--- 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
""
--- 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"] =
--- 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] =
--- 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)