Finish implementation of ghost points served from server, not tested
authorunc0rr
Sat, 27 Feb 2016 09:44:13 +0300
changeset 11582 bee3a2f8e117
parent 11581 134113bff264
child 11583 013264e25d71
Finish implementation of ghost points served from server, not tested
gameServer/Actions.hs
gameServer/EngineInteraction.hs
--- 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 = [