|
1 {-# LANGUAGE OverloadedStrings #-} |
|
2 |
1 module EngineInteraction where |
3 module EngineInteraction where |
2 |
4 |
3 import qualified Data.Set as Set |
5 import qualified Data.Set as Set |
4 import Control.Monad |
6 import Control.Monad |
5 import qualified Codec.Binary.Base64 as Base64 |
7 import qualified Codec.Binary.Base64 as Base64 |
6 import qualified Data.ByteString.Char8 as B |
8 import qualified Data.ByteString.Char8 as B |
7 import qualified Data.ByteString as BW |
9 import qualified Data.ByteString as BW |
8 import qualified Data.Map as Map |
10 import qualified Data.Map as Map |
|
11 import Data.Word |
|
12 import Data.Bits |
9 ------------- |
13 ------------- |
10 import CoreTypes |
14 import CoreTypes |
|
15 import Utils |
11 |
16 |
12 |
17 |
13 toEngineMsg :: B.ByteString -> B.ByteString |
18 toEngineMsg :: B.ByteString -> B.ByteString |
14 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
19 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
15 |
20 |
35 replayToDemo :: [TeamInfo] |
40 replayToDemo :: [TeamInfo] |
36 -> Map.Map B.ByteString B.ByteString |
41 -> Map.Map B.ByteString B.ByteString |
37 -> Map.Map B.ByteString [B.ByteString] |
42 -> Map.Map B.ByteString [B.ByteString] |
38 -> [B.ByteString] |
43 -> [B.ByteString] |
39 -> [B.ByteString] |
44 -> [B.ByteString] |
40 replayToDemo teams mapParams params msgs = undefined |
45 replayToDemo teams mapParams params msgs = concat [ |
|
46 [em "TD"] |
|
47 , maybeScript |
|
48 , maybeMap |
|
49 , [eml ["etheme ", head $ params Map.! "THEME"]] |
|
50 , [eml ["eseed ", mapParams Map.! "SEED"]] |
|
51 , [eml ["e$gmflags ", showB gameFlags]] |
|
52 , schemeFlags |
|
53 , [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]] |
|
54 , [eml ["e$mapgen ", mapParams Map.! "MAPGEN"]] |
|
55 , msgs |
|
56 ] |
|
57 where |
|
58 em = toEngineMsg |
|
59 eml = em . B.concat |
|
60 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
|
61 maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
|
62 maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
|
63 scheme = tail $ params Map.! "SCHEME" |
|
64 gameFlags :: Word32 |
|
65 gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts |
|
66 schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m]) |
|
67 $ filter (\(_, (n, _)) -> not $ B.null n) |
|
68 $ zip (drop (length gameFlagConsts) scheme) schemeParams |
|
69 |
|
70 |
|
71 schemeParams :: [(B.ByteString, Int)] |
|
72 schemeParams = [ |
|
73 ("e$damagepct", 1) |
|
74 , ("e$turntime", 1000) |
|
75 , ("", 0) |
|
76 , ("e$sd_turns", 1) |
|
77 , ("e$casefreq", 1) |
|
78 , ("e$minestime", 1000) |
|
79 , ("e$minesnum", 1) |
|
80 , ("e$minedudpct", 1) |
|
81 , ("e$explosives", 1) |
|
82 , ("e$healthprob", 1) |
|
83 , ("e$hcaseamount", 1) |
|
84 , ("e$waterrise", 1) |
|
85 , ("e$healthdec", 1) |
|
86 , ("e$ropepct", 1) |
|
87 , ("e$getawaytime", 1) |
|
88 ] |
|
89 |
|
90 |
|
91 gameFlagConsts :: [Word32] |
|
92 gameFlagConsts = [ |
|
93 0x00001000 |
|
94 , 0x00000010 |
|
95 , 0x00000004 |
|
96 , 0x00000008 |
|
97 , 0x00000020 |
|
98 , 0x00000040 |
|
99 , 0x00000080 |
|
100 , 0x00000100 |
|
101 , 0x00000200 |
|
102 , 0x00000400 |
|
103 , 0x00000800 |
|
104 , 0x00002000 |
|
105 , 0x00004000 |
|
106 , 0x00008000 |
|
107 , 0x00010000 |
|
108 , 0x00020000 |
|
109 , 0x00040000 |
|
110 , 0x00080000 |
|
111 , 0x00100000 |
|
112 , 0x00200000 |
|
113 , 0x00400000 |
|
114 , 0x00800000 |
|
115 , 0x01000000 |
|
116 , 0x02000000 |
|
117 , 0x04000000 |
|
118 ] |
41 |
119 |
42 |
120 |
43 |
121 |
44 |
|