--- a/gameServer/Actions.hs Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/Actions.hs Tue Sep 03 22:35:57 2013 +0400
@@ -17,7 +17,7 @@
import Control.DeepSeq
import Data.Unique
import Control.Arrow
-import Control.Exception
+import Control.Exception as E
import System.Process
import Network.Socket
import System.Random
@@ -714,5 +714,24 @@
#endif
processAction (ShowReplay name) = do
- return ()
+ c <- client's sendChan
+ cl <- client's id
+
+ let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" name then B.drop 8 name else name]
+
+ checkInfo <- liftIO $ E.handle (\(e :: SomeException) ->
+ warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do
+ (t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName)
+ return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs)
+ let (teams, params1, params2, roundMsgs) = fromJust checkInfo
+
+ when (isJust checkInfo) $ do
+ mapM_ processAction $ concat [
+ [AnswerClients [c] ["JOINED", nick cl]]
+ , answerFullConfigParams cl params1 params2
+ , answerAllTeams cl teams
+ , [AnswerClients [c] ["RUN_GAME"]]
+ , [AnswerClients [c] $ "EM" : roundMsgs]
+ , [AnswerClients [c] ["KICKED"]]
+ ]
--- a/gameServer/HWProtoCore.hs Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/HWProtoCore.hs Tue Sep 03 22:35:57 2013 +0400
@@ -50,7 +50,7 @@
rnc <- liftM snd ask
let chans = map (sendChan . client rnc) $ allClients rnc
return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl]
- h "WATCH" = return . QueryReplay
+ h "WATCH" f = return [QueryReplay f]
h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]]
handleCmd cmd = do
--- a/gameServer/HWProtoLobbyState.hs Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/HWProtoLobbyState.hs Tue Sep 03 22:35:57 2013 +0400
@@ -14,16 +14,6 @@
import EngineInteraction
-answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
-answerAllTeams cl = concatMap toAnswer
- where
- clChan = sendChan cl
- toAnswer team =
- [AnswerClients [clChan] $ teamToNet team,
- AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
- AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
-
-
handleCmd_lobby :: CmdHandler
--- a/gameServer/Utils.hs Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/Utils.hs Tue Sep 03 22:35:57 2013 +0400
@@ -157,5 +157,15 @@
toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
+answerAllTeams cl = concatMap toAnswer
+ where
+ clChan = sendChan cl
+ toAnswer team =
+ [AnswerClients [clChan] $ teamToNet team,
+ AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
+ AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
+
+
loc :: B.ByteString -> B.ByteString
loc = id