gameServer/EngineInteraction.hs
changeset 8484 99c14f14f788
parent 8483 d5fd4d7a0bcc
child 8485 7cae79214537
equal deleted inserted replaced
8483:d5fd4d7a0bcc 8484:99c14f14f788
     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]