18 where |
26 where |
19 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
27 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
20 removeLength _ = Nothing |
28 removeLength _ = Nothing |
21 |
29 |
22 |
30 |
23 checkNetCmd :: B.ByteString -> (Bool, Bool) |
31 splitMessages :: B.ByteString -> [B.ByteString] |
|
32 splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b) |
|
33 |
|
34 |
|
35 checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString) |
24 checkNetCmd msg = check decoded |
36 checkNetCmd msg = check decoded |
25 where |
37 where |
26 decoded = fromEngineMsg msg |
38 decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg |
27 check Nothing = (False, False) |
39 check Nothing = (B.empty, B.empty) |
28 check (Just ms) | B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+') |
40 check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b) |
29 | otherwise = (False, False) |
41 encode = B.pack . Base64.encode . BW.unpack . B.concat |
|
42 isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m) |
|
43 isNonEmpty = (/=) '+' . B.head . B.tail |
30 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
44 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
31 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
45 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
32 |
46 |
33 |
47 |
34 gameInfo2Replay :: GameInfo -> B.ByteString |
48 replayToDemo :: [TeamInfo] |
35 gameInfo2Replay GameInfo{roundMsgs = rm, |
49 -> Map.Map B.ByteString B.ByteString |
36 teamsAtStart = teams, |
50 -> Map.Map B.ByteString [B.ByteString] |
37 giMapParams = params1, |
51 -> [B.ByteString] |
38 giParams = params2} = undefined |
52 -> [B.ByteString] |
|
53 replayToDemo teams mapParams params msgs = concat [ |
|
54 [em "TD"] |
|
55 , maybeScript |
|
56 , maybeMap |
|
57 , [eml ["etheme ", head $ params Map.! "THEME"]] |
|
58 , [eml ["eseed ", mapParams Map.! "SEED"]] |
|
59 , [eml ["e$gmflags ", showB gameFlags]] |
|
60 , schemeFlags |
|
61 , [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]] |
|
62 , [eml ["e$mapgen ", mapgen]] |
|
63 , mapgenSpecific |
|
64 , concatMap teamSetup teams |
|
65 , msgs |
|
66 , [em "!"] |
|
67 ] |
|
68 where |
|
69 em = toEngineMsg |
|
70 eml = em . B.concat |
|
71 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
|
72 maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
|
73 maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
|
74 scheme = tail $ params Map.! "SCHEME" |
|
75 mapgen = mapParams Map.! "MAPGEN" |
|
76 mapgenSpecific = case mapgen of |
|
77 "+maze+" -> [eml ["e$maze_size ", head $ params Map.! "MAZE_SIZE"]] |
|
78 "+drawn" -> drawnMapData . head $ params Map.! "DRAWNMAP" |
|
79 _ -> [] |
|
80 gameFlags :: Word32 |
|
81 gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts |
|
82 schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m]) |
|
83 $ filter (\(_, (n, _)) -> not $ B.null n) |
|
84 $ zip (drop (length gameFlagConsts) scheme) schemeParams |
|
85 ammoStr :: B.ByteString |
|
86 ammoStr = head . tail $ params Map.! "AMMO" |
|
87 ammo = let l = B.length ammoStr `div` 4; ((a, b), (c, d)) = (B.splitAt l . fst &&& B.splitAt l . snd) . B.splitAt (l * 2) $ ammoStr in |
|
88 (map (\(x, y) -> eml [x, " ", y]) $ zip ["eammloadt", "eammprob", "eammdelay", "eammreinf"] [a, b, c, d]) |
|
89 ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"] |
|
90 initHealth = scheme !! 27 |
|
91 teamSetup :: TeamInfo -> [B.ByteString] |
|
92 teamSetup t = (++) ammo $ |
|
93 eml ["eaddteam <hash> ", showB $ (1 + (readInt_ $ teamcolor t) :: Int) * 2113696, " ", teamname t] |
|
94 : em "erdriven" |
|
95 : eml ["efort ", teamfort t] |
|
96 : take (2 * hhnum t) ( |
|
97 concatMap (\(HedgehogInfo hname hhat) -> [ |
|
98 eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname] |
|
99 , eml ["ehat ", hhat] |
|
100 ]) |
|
101 $ hedgehogs t |
|
102 ) |
|
103 |
|
104 drawnMapData :: B.ByteString -> [B.ByteString] |
|
105 drawnMapData = error "drawnMapData" |
|
106 |
|
107 schemeParams :: [(B.ByteString, Int)] |
|
108 schemeParams = [ |
|
109 ("e$damagepct", 1) |
|
110 , ("e$turntime", 1000) |
|
111 , ("", 0) |
|
112 , ("e$sd_turns", 1) |
|
113 , ("e$casefreq", 1) |
|
114 , ("e$minestime", 1000) |
|
115 , ("e$minesnum", 1) |
|
116 , ("e$minedudpct", 1) |
|
117 , ("e$explosives", 1) |
|
118 , ("e$healthprob", 1) |
|
119 , ("e$hcaseamount", 1) |
|
120 , ("e$waterrise", 1) |
|
121 , ("e$healthdec", 1) |
|
122 , ("e$ropepct", 1) |
|
123 , ("e$getawaytime", 1) |
|
124 ] |
|
125 |
|
126 |
|
127 gameFlagConsts :: [Word32] |
|
128 gameFlagConsts = [ |
|
129 0x00001000 |
|
130 , 0x00000010 |
|
131 , 0x00000004 |
|
132 , 0x00000008 |
|
133 , 0x00000020 |
|
134 , 0x00000040 |
|
135 , 0x00000080 |
|
136 , 0x00000100 |
|
137 , 0x00000200 |
|
138 , 0x00000400 |
|
139 , 0x00000800 |
|
140 , 0x00002000 |
|
141 , 0x00004000 |
|
142 , 0x00008000 |
|
143 , 0x00010000 |
|
144 , 0x00020000 |
|
145 , 0x00040000 |
|
146 , 0x00080000 |
|
147 , 0x00100000 |
|
148 , 0x00200000 |
|
149 , 0x00400000 |
|
150 , 0x00800000 |
|
151 , 0x01000000 |
|
152 , 0x02000000 |
|
153 , 0x04000000 |
|
154 ] |
|
155 |
|
156 |
|
157 |