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.Map as Map |
10 import qualified Data.Map as Map |
|
11 import qualified Data.List as L |
11 import Data.Word |
12 import Data.Word |
12 import Data.Bits |
13 import Data.Bits |
13 import Control.Arrow |
14 import Control.Arrow |
14 ------------- |
15 ------------- |
15 import CoreTypes |
16 import CoreTypes |
25 where |
26 where |
26 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 |
27 removeLength _ = Nothing |
28 removeLength _ = Nothing |
28 |
29 |
29 |
30 |
30 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) |
31 checkNetCmd msg = check decoded |
36 checkNetCmd msg = check decoded |
32 where |
37 where |
33 decoded = fromEngineMsg msg |
38 decoded = liftM splitMessages $ fromEngineMsg msg |
34 check Nothing = (False, False) |
39 check Nothing = (B.empty, B.empty) |
35 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) |
36 | otherwise = (False, False) |
41 encode = B.pack . Base64.encode . BW.unpack . B.concat |
|
42 isLegal = flip Set.member legalMessages . B.head |
|
43 isNonEmpty = (/=) '+' . B.head |
37 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
44 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
38 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" |
39 |
46 |
40 |
47 |
41 replayToDemo :: [TeamInfo] |
48 replayToDemo :: [TeamInfo] |