gameServer/EngineInteraction.hs
author Xeli
Fri, 17 Feb 2012 21:34:33 +0100
changeset 6701 58a43c2064ad
parent 6206 75e0d8169ba2
child 7766 98edc0724a28
permissions -rw-r--r--
the onScreenwidgets are multitouch now, frequently (alternating) tapping left and right still causes it to bug though, but you have to try hard to duplicate it, works ok for now
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)
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
    31
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
6068
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