--- a/gameServer/Actions.hs Sat Nov 07 21:01:04 2015 +0100
+++ b/gameServer/Actions.hs Sat Nov 07 23:44:49 2015 +0300
@@ -762,10 +762,11 @@
processAction (CheckSuccess info) = do
- Just (CheckInfo fileName teams script) <- client's checkInfo
+ Just (CheckInfo fileName teams gameDetails) <- client's checkInfo
p <- client's clientProto
si <- gets serverInfo
- io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) script info
+ when (isJust gameDetails)
+ $ io $ writeChan (dbQueries si) $ StoreAchievements p (B.pack fileName) (map toPair teams) (fromJust gameDetails) info
io $ moveCheckedRecord fileName
where
toPair t = (teamname t, teamowner t)
--- a/gameServer/CoreTypes.hs Sat Nov 07 21:01:04 2015 +0100
+++ b/gameServer/CoreTypes.hs Sat Nov 07 23:44:49 2015 +0300
@@ -16,7 +16,7 @@
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
\-}
-{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module CoreTypes where
import Control.Concurrent
@@ -120,7 +120,7 @@
{
recordFileName :: String,
recordTeams :: [TeamInfo],
- recordScript :: B.ByteString
+ details :: Maybe GameDetails
}
data ClientInfo =
@@ -346,10 +346,21 @@
CheckAccount ClientIndex Int B.ByteString B.ByteString
| ClearCache
| SendStats Int Int
- | StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] B.ByteString [B.ByteString]
+ | StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] GameDetails [B.ByteString]
| GetReplayName ClientIndex Int B.ByteString
deriving (Show, Read)
+data GameDetails =
+ GameDetails {
+ gameScript :: B.ByteString
+ , infRope
+ , isVamp
+ , infAttacks :: Bool
+ } deriving (Show, Read)
+
+instance NFData GameDetails where
+ rnf (GameDetails a b c d) = a `deepseq` b `deepseq` c `deepseq` d `deepseq` ()
+
data CoreMessage =
Accept ClientInfo
| ClientMessage (ClientIndex, [B.ByteString])
--- a/gameServer/EngineInteraction.hs Sat Nov 07 21:01:04 2015 +0100
+++ b/gameServer/EngineInteraction.hs Sat Nov 07 23:44:49 2015 +0300
@@ -100,8 +100,8 @@
-> Map.Map B.ByteString B.ByteString
-> Map.Map B.ByteString [B.ByteString]
-> [B.ByteString]
- -> ([B.ByteString], [B.ByteString])
-replayToDemo ti mParams prms msgs = if not sane then ([], []) else ([scriptName], concat [
+ -> (Maybe GameDetails, [B.ByteString])
+replayToDemo ti mParams prms msgs = if not sane then (Nothing, []) else (Just $ GameDetails scriptName infRopes vamp infattacks, concat [
[em "TD"]
, maybeScript
, maybeMap
@@ -125,7 +125,7 @@
sane = Set.null (keys1 Set.\\ Map.keysSet mParams)
&& Set.null (keys2 Set.\\ Map.keysSet prms)
&& (not . null . drop 41 $ scheme)
- && (not . null . tail $ prms Map.! "AMMO")
+ && (not . null . drop 8 $ prms Map.! "AMMO")
mapGenTypes = ["+rnd+", "+maze+", "+drawn+", "+perlin+"]
scriptName = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms
maybeScript = let s = scriptName in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
@@ -162,6 +162,9 @@
])
$ hedgehogs t
)
+ infRopes = ammoStr `B.index` 7 == '9'
+ vamp = gameFlags .&. 0x00000200 /= 0
+ infattacks = gameFlags .&. 0x00100000 /= 0
drawnMapData :: B.ByteString -> [B.ByteString]
drawnMapData =
--- a/gameServer/OfficialServer/GameReplayStore.hs Sat Nov 07 21:01:04 2015 +0100
+++ b/gameServer/OfficialServer/GameReplayStore.hs Sat Nov 07 23:44:49 2015 +0300
@@ -70,11 +70,11 @@
where
loadFile :: String -> IO (Maybe CheckInfo, [B.ByteString])
loadFile fileName = E.handle (\(e :: SomeException) ->
- warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Just $ CheckInfo fileName [] "", [])) $ do
+ warningM "REPLAYS" ("Problems reading " ++ fileName ++ ": " ++ show e) >> return (Just $ CheckInfo fileName [] Nothing, [])) $ do
(teams, params1, params2, roundMsgs) <- liftM read $ readFile fileName
let d = replayToDemo teams (Map.fromList params1) (Map.fromList params2) (reverse roundMsgs)
d `deepseq` return $ (
- Just (CheckInfo fileName teams (head $ fst d))
+ Just (CheckInfo fileName teams (fst d))
, snd d
)
--- a/gameServer/OfficialServer/extdbinterface.hs Sat Nov 07 21:01:04 2015 +0100
+++ b/gameServer/OfficialServer/extdbinterface.hs Sat Nov 07 23:44:49 2015 +0300
@@ -52,8 +52,8 @@
\ ?, ?, ?, ?)"
dbQueryGamesHistory =
- "INSERT INTO rating_games (script, protocol, filename, time) \
- \ VALUES (?, ?, ?, ?)"
+ "INSERT INTO rating_games (script, protocol, filename, time, vamp, ropes, infattacks) \
+ \ VALUES (?, ?, ?, ?, ?, ?, ?)"
dbQueryGameId = "SELECT LAST_INSERT_ID()"
@@ -93,8 +93,8 @@
SendStats clients rooms ->
void $ execute dbConn dbQueryStats (clients, rooms)
- StoreAchievements p fileName teams script info ->
- sequence_ $ parseStats dbConn p fileName teams script info
+ StoreAchievements p fileName teams g info ->
+ sequence_ $ parseStats dbConn p fileName teams g info
--readTime = read . B.unpack . B.take 19 . B.drop 8
@@ -105,18 +105,18 @@
-> Word16
-> B.ByteString
-> [(B.ByteString, B.ByteString)]
- -> B.ByteString
+ -> GameDetails
-> [B.ByteString]
-> [IO Int64]
-parseStats dbConn p fileName teams script = ps
+parseStats dbConn p fileName teams (GameDetails script infRopes vamp infAttacks) = ps
where
time = readTime fileName
ps :: [B.ByteString] -> [IO Int64]
ps [] = []
- ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time)
+ ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
: places (map drawParams teams)
: ps bs
- ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time)
+ ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
: places (map (placeParams (take winNum bs)) teams)
: ps (drop winNum bs)
ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = execute dbConn dbQueryAchievement