gameServer/EngineInteraction.hs
changeset 9304 3f4c3fc146c2
parent 8541 0cd63b963330
child 9401 2af7bea32e5e
equal deleted inserted replaced
9303:457efde100b5 9304:3f4c3fc146c2
    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 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]