Start implementation of archivements/ratings on server side: replay saving routine
--- a/gameServer/Actions.hs Tue Apr 12 21:28:37 2011 +0400
+++ b/gameServer/Actions.hs Tue Apr 12 22:31:48 2011 +0400
@@ -17,6 +17,7 @@
import Data.Unique
import Control.Arrow
import Control.Exception
+import OfficialServer.GameReplayStore
-----------------------------
import CoreTypes
import Utils
@@ -60,6 +61,7 @@
| AddNick2Bans B.ByteString B.ByteString UTCTime
| AddIP2Bans B.ByteString B.ByteString UTCTime
| CheckBanned
+ | SaveReplay
type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
@@ -470,3 +472,10 @@
throw RestartException
else
processAction $ ModifyServerInfo (\s -> s{restartPending=True})
+
+processAction SaveReplay = do
+ ri <- clientRoomA
+ rnc <- gets roomsClients
+ io $ do
+ r <- room'sM rnc id ri
+ saveReplay r
--- a/gameServer/CoreTypes.hs Tue Apr 12 21:28:37 2011 +0400
+++ b/gameServer/CoreTypes.hs Tue Apr 12 22:31:48 2011 +0400
@@ -44,6 +44,7 @@
data HedgehogInfo =
HedgehogInfo B.ByteString B.ByteString
+ deriving (Show, Read)
data TeamInfo =
TeamInfo
@@ -60,6 +61,7 @@
hhnum :: Int,
hedgehogs :: [HedgehogInfo]
}
+ deriving (Show, Read)
data RoomInfo =
RoomInfo
--- a/gameServer/HWProtoInRoomState.hs Tue Apr 12 21:28:37 2011 +0400
+++ b/gameServer/HWProtoInRoomState.hs Tue Apr 12 22:31:48 2011 +0400
@@ -205,7 +205,8 @@
chans <- roomClientsChans
if isMaster cl && gameinprogress rm then
- return $ ModifyRoom
+ return $
+ ModifyRoom
(\r -> r{
gameinprogress = False,
readyPlayers = 0,
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/OfficialServer/GameReplayStore.hs Tue Apr 12 22:31:48 2011 +0400
@@ -0,0 +1,19 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module OfficialServer.GameReplayStore where
+
+import CoreTypes
+import Data.Time
+import Control.Exception as E
+import qualified Data.Map as Map
+import Data.Sequence()
+import System.Log.Logger
+
+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)
+ E.catch
+ (writeFile fileName (show replayInfo))
+ (\(e :: IOException) -> warningM "REPLAYS" $ "Couldn't write to " ++ fileName ++ ": " ++ show e)
+
\ No newline at end of file