--- a/gameServer/Actions.hs Fri Feb 26 14:11:16 2016 -0500
+++ b/gameServer/Actions.hs Sat Feb 27 09:44:13 2016 +0300
@@ -733,11 +733,12 @@
ri <- clientRoomA
rnc <- gets roomsClients
thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
+ rm <- io $ room'sM rnc id ri
+ when (roomProto rm > 51) $ do
+ processAction $ ModifyRoom $ \r -> r{params = Map.insert "DRAWNMAP" [prependGhostPoints (toP points) $ head $ (params r) Map.! "DRAWNMAP"] (params r)}
-- inject ghost points into map
- rm <- io $ room'sM rnc id ri
cl <- client's id
- mapM processAction $ map (replaceChans thisRoomChans) $ answerFullConfigParams cl (mapParams rm) (params rm)
- return ()
+ mapM_ processAction $ map (replaceChans thisRoomChans) $ answerFullConfigParams cl (mapParams rm) (params rm)
where
loadFile :: String -> IO [Int]
loadFile fileName = E.handle (\(e :: SomeException) -> return []) $ do
@@ -745,6 +746,8 @@
return (points `deepseq` points)
replaceChans chans (AnswerClients _ msg) = AnswerClients chans msg
replaceChans _ a = a
+ toP [] = []
+ toP (p1:p2:ps) = (fromIntegral p1, fromIntegral p2) : toP ps
{-
let a = map (replaceChans chans) $ answerFullConfigParams cl mp p
-}
--- a/gameServer/EngineInteraction.hs Fri Feb 26 14:11:16 2016 -0500
+++ b/gameServer/EngineInteraction.hs Sat Feb 27 09:44:13 2016 +0300
@@ -19,7 +19,7 @@
{-# LANGUAGE CPP, OverloadedStrings #-}
#if defined(OFFICIAL_SERVER)
-module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where
+module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData, prependGhostPoints) where
#else
module EngineInteraction(checkNetCmd, toEngineMsg) where
#endif
@@ -33,9 +33,12 @@
import qualified Data.Map as Map
import qualified Data.List as L
import Data.Word
+import Data.Int
import Data.Bits
import Control.Arrow
import Data.Maybe
+import Data.Binary
+import Data.Binary.Put
-------------
import CoreTypes
import Utils
@@ -45,12 +48,13 @@
this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror
because standard 'catch' doesn't seem to catch decompression errors for some reason
-}
-import qualified Codec.Compression.Zlib.Internal as Z
+import qualified Codec.Compression.Zlib.Internal as ZI
+import qualified Codec.Compression.Zlib as Z
decompressWithoutExceptions :: BL.ByteString -> Either String BL.ByteString
decompressWithoutExceptions = finalise
- . Z.foldDecompressStream cons nil err
- . Z.decompressWithErrors Z.zlibFormat Z.defaultDecompressParams
+ . ZI.foldDecompressStream cons nil err
+ . ZI.decompressWithErrors ZI.zlibFormat ZI.defaultDecompressParams
where err _ msg = Left msg
nil = Right []
cons chunk = right (chunk :)
@@ -176,17 +180,35 @@
L.map (\m -> eml ["edraw ", BW.pack m])
. L.unfoldr by200
. BL.unpack
- . either (const BL.empty) id
+ . unpackDrawnMap
+ where
+ by200 :: [a] -> Maybe ([a], [a])
+ by200 [] = Nothing
+ by200 m = Just $ L.splitAt 200 m
+
+unpackDrawnMap :: B.ByteString -> BL.ByteString
+unpackDrawnMap = either (const BL.empty) id
. decompressWithoutExceptions
. BL.pack
. L.drop 4
. fromMaybe []
. Base64.decode
. B.unpack
- where
- by200 :: [a] -> Maybe ([a], [a])
- by200 [] = Nothing
- by200 m = Just $ L.splitAt 200 m
+
+compressWithLength :: BL.ByteString -> BL.ByteString
+compressWithLength b = BL.drop 8 . encode . runPut $ do
+ put $ ((fromIntegral $ BL.length b)::Word32)
+ mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b
+
+packDrawnMap :: BL.ByteString -> B.ByteString
+packDrawnMap = B.pack
+ . Base64.encode
+ . BW.unpack
+ . BL.toStrict
+ . compressWithLength
+
+prependGhostPoints :: [(Int16, Int16)] -> B.ByteString -> B.ByteString
+prependGhostPoints pts dm = packDrawnMap $ (runPut $ forM_ pts $ \(x, y) -> put x >> put y >> putWord8 99) `BL.append` unpackDrawnMap dm
schemeParams :: [(B.ByteString, Int)]
schemeParams = [