17 \-} |
17 \-} |
18 |
18 |
19 {-# LANGUAGE CPP, OverloadedStrings #-} |
19 {-# LANGUAGE CPP, OverloadedStrings #-} |
20 |
20 |
21 #if defined(OFFICIAL_SERVER) |
21 #if defined(OFFICIAL_SERVER) |
22 module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where |
22 module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData, prependGhostPoints) where |
23 #else |
23 #else |
24 module EngineInteraction(checkNetCmd, toEngineMsg) where |
24 module EngineInteraction(checkNetCmd, toEngineMsg) where |
25 #endif |
25 #endif |
26 |
26 |
27 import qualified Data.Set as Set |
27 import qualified Data.Set as Set |
31 import qualified Data.ByteString as BW |
31 import qualified Data.ByteString as BW |
32 import qualified Data.ByteString.Lazy as BL |
32 import qualified Data.ByteString.Lazy as BL |
33 import qualified Data.Map as Map |
33 import qualified Data.Map as Map |
34 import qualified Data.List as L |
34 import qualified Data.List as L |
35 import Data.Word |
35 import Data.Word |
|
36 import Data.Int |
36 import Data.Bits |
37 import Data.Bits |
37 import Control.Arrow |
38 import Control.Arrow |
38 import Data.Maybe |
39 import Data.Maybe |
|
40 import Data.Binary |
|
41 import Data.Binary.Put |
39 ------------- |
42 ------------- |
40 import CoreTypes |
43 import CoreTypes |
41 import Utils |
44 import Utils |
42 |
45 |
43 #if defined(OFFICIAL_SERVER) |
46 #if defined(OFFICIAL_SERVER) |
44 {- |
47 {- |
45 this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror |
48 this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror |
46 because standard 'catch' doesn't seem to catch decompression errors for some reason |
49 because standard 'catch' doesn't seem to catch decompression errors for some reason |
47 -} |
50 -} |
48 import qualified Codec.Compression.Zlib.Internal as Z |
51 import qualified Codec.Compression.Zlib.Internal as ZI |
|
52 import qualified Codec.Compression.Zlib as Z |
49 |
53 |
50 decompressWithoutExceptions :: BL.ByteString -> Either String BL.ByteString |
54 decompressWithoutExceptions :: BL.ByteString -> Either String BL.ByteString |
51 decompressWithoutExceptions = finalise |
55 decompressWithoutExceptions = finalise |
52 . Z.foldDecompressStream cons nil err |
56 . ZI.foldDecompressStream cons nil err |
53 . Z.decompressWithErrors Z.zlibFormat Z.defaultDecompressParams |
57 . ZI.decompressWithErrors ZI.zlibFormat ZI.defaultDecompressParams |
54 where err _ msg = Left msg |
58 where err _ msg = Left msg |
55 nil = Right [] |
59 nil = Right [] |
56 cons chunk = right (chunk :) |
60 cons chunk = right (chunk :) |
57 finalise = right BL.fromChunks |
61 finalise = right BL.fromChunks |
58 {- end snippet -} |
62 {- end snippet -} |
174 drawnMapData :: B.ByteString -> [B.ByteString] |
178 drawnMapData :: B.ByteString -> [B.ByteString] |
175 drawnMapData = |
179 drawnMapData = |
176 L.map (\m -> eml ["edraw ", BW.pack m]) |
180 L.map (\m -> eml ["edraw ", BW.pack m]) |
177 . L.unfoldr by200 |
181 . L.unfoldr by200 |
178 . BL.unpack |
182 . BL.unpack |
179 . either (const BL.empty) id |
183 . unpackDrawnMap |
|
184 where |
|
185 by200 :: [a] -> Maybe ([a], [a]) |
|
186 by200 [] = Nothing |
|
187 by200 m = Just $ L.splitAt 200 m |
|
188 |
|
189 unpackDrawnMap :: B.ByteString -> BL.ByteString |
|
190 unpackDrawnMap = either (const BL.empty) id |
180 . decompressWithoutExceptions |
191 . decompressWithoutExceptions |
181 . BL.pack |
192 . BL.pack |
182 . L.drop 4 |
193 . L.drop 4 |
183 . fromMaybe [] |
194 . fromMaybe [] |
184 . Base64.decode |
195 . Base64.decode |
185 . B.unpack |
196 . B.unpack |
186 where |
197 |
187 by200 :: [a] -> Maybe ([a], [a]) |
198 compressWithLength :: BL.ByteString -> BL.ByteString |
188 by200 [] = Nothing |
199 compressWithLength b = BL.drop 8 . encode . runPut $ do |
189 by200 m = Just $ L.splitAt 200 m |
200 put $ ((fromIntegral $ BL.length b)::Word32) |
|
201 mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b |
|
202 |
|
203 packDrawnMap :: BL.ByteString -> B.ByteString |
|
204 packDrawnMap = B.pack |
|
205 . Base64.encode |
|
206 . BW.unpack |
|
207 . BL.toStrict |
|
208 . compressWithLength |
|
209 |
|
210 prependGhostPoints :: [(Int16, Int16)] -> B.ByteString -> B.ByteString |
|
211 prependGhostPoints pts dm = packDrawnMap $ (runPut $ forM_ pts $ \(x, y) -> put x >> put y >> putWord8 99) `BL.append` unpackDrawnMap dm |
190 |
212 |
191 schemeParams :: [(B.ByteString, Int)] |
213 schemeParams :: [(B.ByteString, Int)] |
192 schemeParams = [ |
214 schemeParams = [ |
193 ("e$damagepct", 1) |
215 ("e$damagepct", 1) |
194 , ("e$turntime", 1000) |
216 , ("e$turntime", 1000) |