30 |
30 |
31 splitMessages :: B.ByteString -> [B.ByteString] |
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) |
32 splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b) |
33 |
33 |
34 |
34 |
35 checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString) |
35 checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString, Maybe (Maybe B.ByteString)) |
36 checkNetCmd msg = check decoded |
36 checkNetCmd msg = check decoded |
37 where |
37 where |
38 decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg |
38 decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg |
39 check Nothing = (B.empty, B.empty) |
39 check Nothing = (B.empty, B.empty, Nothing) |
40 check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b) |
40 check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b, lft a) |
41 encode = B.pack . Base64.encode . BW.unpack . B.concat |
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) |
42 isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m) |
|
43 lft = foldr l Nothing |
|
44 l m n = let m' = B.head $ B.tail m; tst = flip Set.member in |
|
45 if not $ tst timedMessages m' then n |
|
46 else if '+' /= m' then Just Nothing else Just . Just . B.pack . Base64.encode . BW.unpack $ m |
43 isNonEmpty = (/=) '+' . B.head . B.tail |
47 isNonEmpty = (/=) '+' . B.head . B.tail |
44 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
48 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
45 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
49 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
|
50 timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgc12345" ++ slotMessages |
46 |
51 |
47 |
52 |
48 replayToDemo :: [TeamInfo] |
53 replayToDemo :: [TeamInfo] |
49 -> Map.Map B.ByteString B.ByteString |
54 -> Map.Map B.ByteString B.ByteString |
50 -> Map.Map B.ByteString [B.ByteString] |
55 -> Map.Map B.ByteString [B.ByteString] |
51 -> [B.ByteString] |
56 -> [B.ByteString] |
52 -> [B.ByteString] |
57 -> [B.ByteString] |
53 replayToDemo teams mapParams params msgs = concat [ |
58 replayToDemo ti mParams prms msgs = concat [ |
54 [em "TD"] |
59 [em "TD"] |
55 , maybeScript |
60 , maybeScript |
56 , maybeMap |
61 , maybeMap |
57 , [eml ["etheme ", head $ params Map.! "THEME"]] |
62 , [eml ["etheme ", head $ prms Map.! "THEME"]] |
58 , [eml ["eseed ", mapParams Map.! "SEED"]] |
63 , [eml ["eseed ", mParams Map.! "SEED"]] |
59 , [eml ["e$gmflags ", showB gameFlags]] |
64 , [eml ["e$gmflags ", showB gameFlags]] |
60 , schemeFlags |
65 , schemeFlags |
61 , [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]] |
66 , [eml ["e$template_filter ", mParams Map.! "TEMPLATE"]] |
62 , [eml ["e$mapgen ", mapgen]] |
67 , [eml ["e$mapgen ", mapgen]] |
63 , mapgenSpecific |
68 , mapgenSpecific |
64 , concatMap teamSetup teams |
69 , concatMap teamSetup ti |
65 , msgs |
70 , msgs |
66 , [em "!"] |
71 , [em "!"] |
67 ] |
72 ] |
68 where |
73 where |
69 em = toEngineMsg |
74 em = toEngineMsg |
70 eml = em . B.concat |
75 eml = em . B.concat |
71 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
76 mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
72 maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
77 maybeScript = let s = head $ prms 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]] |
78 maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
74 scheme = tail $ params Map.! "SCHEME" |
79 scheme = tail $ prms Map.! "SCHEME" |
75 mapgen = mapParams Map.! "MAPGEN" |
80 mapgen = mParams Map.! "MAPGEN" |
76 mapgenSpecific = case mapgen of |
81 mapgenSpecific = case mapgen of |
77 "+maze+" -> [eml ["e$maze_size ", head $ params Map.! "MAZE_SIZE"]] |
82 "+maze+" -> [eml ["e$maze_size ", head $ prms Map.! "MAZE_SIZE"]] |
78 "+drawn" -> drawnMapData . head $ params Map.! "DRAWNMAP" |
83 "+drawn" -> drawnMapData . head $ prms Map.! "DRAWNMAP" |
79 _ -> [] |
84 _ -> [] |
80 gameFlags :: Word32 |
85 gameFlags :: Word32 |
81 gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts |
86 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]) |
87 schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m]) |
83 $ filter (\(_, (n, _)) -> not $ B.null n) |
88 $ filter (\(_, (n, _)) -> not $ B.null n) |
84 $ zip (drop (length gameFlagConsts) scheme) schemeParams |
89 $ zip (drop (length gameFlagConsts) scheme) schemeParams |
85 ammoStr :: B.ByteString |
90 ammoStr :: B.ByteString |
86 ammoStr = head . tail $ params Map.! "AMMO" |
91 ammoStr = head . tail $ prms 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 |
92 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]) |
93 (map (\(x, y) -> eml [x, " ", y]) $ zip ["eammloadt", "eammprob", "eammdelay", "eammreinf"] [a, b, c, d]) |
89 ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"] |
94 ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"] |
90 initHealth = scheme !! 27 |
95 initHealth = scheme !! 27 |
91 teamSetup :: TeamInfo -> [B.ByteString] |
96 teamSetup :: TeamInfo -> [B.ByteString] |