gameServer/EngineInteraction.hs
author nemo
Fri, 30 Sep 2011 22:33:28 -0400
changeset 6077 d8fa5a85d24f
parent 6070 429b4637c8ad
child 6206 75e0d8169ba2
permissions -rw-r--r--
This prevents girders from erasing landbacktex (square windows in tunnels and such), at the cost of requiring lfBasic and lfObject to be treated the same apart from graphically
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     1
module EngineInteraction where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     2
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     3
import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     4
import qualified Data.List as List
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     5
import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     6
import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     7
import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     8
import qualified Data.ByteString as BW
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
     9
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    10
import CoreTypes
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    11
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    12
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    13
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    14
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    15
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    16
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    17
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    18
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    19
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    20
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    21
        removeLength _ = Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    22
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    23
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    24
checkNetCmd :: B.ByteString -> (Bool, Bool)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    25
checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
        decoded = fromEngineMsg msg
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    28
        check Nothing = (False, False)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    29
        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
    30
                        | otherwise        = (False, False)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    31
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghbc12345" ++ slotMessages
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    32
        slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    33
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    34
gameInfo2Replay :: GameInfo -> B.ByteString
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    35
gameInfo2Replay GameInfo{roundMsgs = rm,
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    36
        teamsAtStart = teams,
6070
429b4637c8ad Oops, fix build
unc0rr
parents: 6069
diff changeset
    37
        giMapParams = params1,
429b4637c8ad Oops, fix build
unc0rr
parents: 6069
diff changeset
    38
        giParams = params2} = undefined