# HG changeset patch # User unc0rr # Date 1456555453 -10800 # Node ID bee3a2f8e117c6476fe8e214653968c79942add7 # Parent 134113bff264a0bb7d1e9a928d60ce915596009c Finish implementation of ghost points served from server, not tested diff -r 134113bff264 -r bee3a2f8e117 gameServer/Actions.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 -} diff -r 134113bff264 -r bee3a2f8e117 gameServer/EngineInteraction.hs --- 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 = [