equal
deleted
inserted
replaced
1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 |
2 |
3 module EngineInteraction where |
3 module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where |
4 |
4 |
5 import qualified Data.Set as Set |
5 import qualified Data.Set as Set |
6 import Control.Monad |
6 import Control.Monad |
7 import qualified Codec.Binary.Base64 as Base64 |
7 import qualified Codec.Binary.Base64 as Base64 |
8 import qualified Data.ByteString.Char8 as B |
8 import qualified Data.ByteString.Char8 as B |
9 import qualified Data.ByteString as BW |
9 import qualified Data.ByteString as BW |
|
10 import qualified Data.ByteString.Lazy as BL |
10 import qualified Data.Map as Map |
11 import qualified Data.Map as Map |
11 import qualified Data.List as L |
12 import qualified Data.List as L |
12 import Data.Word |
13 import Data.Word |
13 import Data.Bits |
14 import Data.Bits |
14 import Control.Arrow |
15 import Control.Arrow |
15 import Data.Maybe |
16 import Data.Maybe |
|
17 import Codec.Compression.Zlib as Z |
16 ------------- |
18 ------------- |
17 import CoreTypes |
19 import CoreTypes |
18 import Utils |
20 import Utils |
19 |
21 |
20 |
22 |
26 fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
28 fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
27 where |
29 where |
28 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
30 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
29 removeLength _ = Nothing |
31 removeLength _ = Nothing |
30 |
32 |
|
33 em :: B.ByteString -> B.ByteString |
|
34 em = toEngineMsg |
|
35 |
|
36 eml :: [B.ByteString] -> B.ByteString |
|
37 eml = em . B.concat |
31 |
38 |
32 splitMessages :: B.ByteString -> [B.ByteString] |
39 splitMessages :: B.ByteString -> [B.ByteString] |
33 splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b) |
40 splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b) |
34 |
41 |
35 |
42 |
70 , concatMap teamSetup ti |
77 , concatMap teamSetup ti |
71 , msgs |
78 , msgs |
72 , [em "!"] |
79 , [em "!"] |
73 ] |
80 ] |
74 where |
81 where |
75 em = toEngineMsg |
|
76 eml = em . B.concat |
|
77 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
82 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
78 maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
83 maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
79 maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
84 maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
80 scheme = tail $ prms Map.! "SCHEME" |
85 scheme = tail $ prms Map.! "SCHEME" |
81 mapgen = mParams Map.! "MAPGEN" |
86 mapgen = mParams Map.! "MAPGEN" |
106 ]) |
111 ]) |
107 $ hedgehogs t |
112 $ hedgehogs t |
108 ) |
113 ) |
109 |
114 |
110 drawnMapData :: B.ByteString -> [B.ByteString] |
115 drawnMapData :: B.ByteString -> [B.ByteString] |
111 drawnMapData = error "drawnMapData" |
116 drawnMapData = |
|
117 L.map (\m -> eml ["edraw ", BW.pack m]) |
|
118 . L.unfoldr by200 |
|
119 . BL.unpack |
|
120 . Z.decompress |
|
121 . BL.pack |
|
122 . L.drop 4 |
|
123 . fromMaybe [] |
|
124 . Base64.decode |
|
125 . B.unpack |
|
126 where |
|
127 by200 :: [a] -> Maybe ([a], [a]) |
|
128 by200 [] = Nothing |
|
129 by200 m = Just $ L.splitAt 200 m |
112 |
130 |
113 schemeParams :: [(B.ByteString, Int)] |
131 schemeParams :: [(B.ByteString, Int)] |
114 schemeParams = [ |
132 schemeParams = [ |
115 ("e$damagepct", 1) |
133 ("e$damagepct", 1) |
116 , ("e$turntime", 1000) |
134 , ("e$turntime", 1000) |