gameServer/EngineInteraction.hs
author unc0rr
Thu, 07 Feb 2013 00:07:32 +0400
changeset 8480 42d2565b5700
parent 8479 8d71109b04d2
child 8481 692ff6468b63
permissions -rw-r--r--
Converter from game parameters to engine commands, not finished yet
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
     2
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     3
module EngineInteraction where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     4
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     5
import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     6
import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     7
import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     8
import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     9
import qualified Data.ByteString as BW
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    10
import qualified Data.Map as Map
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    11
import Data.Word
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    12
import Data.Bits
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    13
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    14
import CoreTypes
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    15
import Utils
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    16
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    17
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    18
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    19
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    20
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    21
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    22
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    23
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    24
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    25
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
        removeLength _ = Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    28
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    29
checkNetCmd :: B.ByteString -> (Bool, Bool)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    30
checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    31
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    32
        decoded = fromEngineMsg msg
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    33
        check Nothing = (False, False)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    34
        check (Just ms) | B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+')
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    35
                        | otherwise        = (False, False)
6206
75e0d8169ba2 As sheepluva pointed out, allowing this message to be legal allows naughtiness. The server usage of this message does not seem to use this check.
nemo
parents: 6070
diff changeset
    36
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    37
        slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    38
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 6206
diff changeset
    39
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    40
replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    41
        -> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    42
        -> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    43
        -> [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    44
        -> [B.ByteString]
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    45
replayToDemo teams mapParams params msgs = concat [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    46
        [em "TD"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    47
        , maybeScript
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    48
        , maybeMap
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    49
        , [eml ["etheme ", head $ params Map.! "THEME"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    50
        , [eml ["eseed ", mapParams Map.! "SEED"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    51
        , [eml ["e$gmflags ", showB gameFlags]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    52
        , schemeFlags
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    53
        , [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    54
        , [eml ["e$mapgen ", mapParams Map.! "MAPGEN"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    55
        , msgs
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    56
        ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    57
    where
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    58
        em = toEngineMsg
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    59
        eml = em . B.concat
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    60
        mapGenTypes = ["+rnd+", "+maze+", "+drawn+"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    61
        maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    62
        maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    63
        scheme = tail $ params Map.! "SCHEME"
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    64
        gameFlags :: Word32
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    65
        gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    66
        schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m])
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    67
            $ filter (\(_, (n, _)) -> not $ B.null n)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    68
            $ zip (drop (length gameFlagConsts) scheme) schemeParams
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    69
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    70
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    71
schemeParams :: [(B.ByteString, Int)]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    72
schemeParams = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    73
      ("e$damagepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    74
    , ("e$turntime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    75
    , ("", 0)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    76
    , ("e$sd_turns", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    77
    , ("e$casefreq", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    78
    , ("e$minestime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    79
    , ("e$minesnum", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    80
    , ("e$minedudpct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    81
    , ("e$explosives", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    82
    , ("e$healthprob", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    83
    , ("e$hcaseamount", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    84
    , ("e$waterrise", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    85
    , ("e$healthdec", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    86
    , ("e$ropepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    87
    , ("e$getawaytime", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    88
    ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    89
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    90
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    91
gameFlagConsts :: [Word32]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    92
gameFlagConsts = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    93
          0x00001000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    94
        , 0x00000010
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    95
        , 0x00000004
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    96
        , 0x00000008
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    97
        , 0x00000020
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    98
        , 0x00000040
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    99
        , 0x00000080
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   100
        , 0x00000100
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   101
        , 0x00000200
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   102
        , 0x00000400
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   103
        , 0x00000800
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   104
        , 0x00002000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   105
        , 0x00004000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   106
        , 0x00008000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   107
        , 0x00010000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   108
        , 0x00020000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   109
        , 0x00040000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   110
        , 0x00080000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   111
        , 0x00100000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   112
        , 0x00200000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   113
        , 0x00400000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   114
        , 0x00800000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   115
        , 0x01000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   116
        , 0x02000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   117
        , 0x04000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   118
        ]
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   119
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   120
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   121