gameServer/EngineInteraction.hs
branchqmlfrontend
changeset 11071 3851ce4f2061
parent 11046 47a8c19ecb60
child 11246 09a2d3988569
equal deleted inserted replaced
11050:9b7c8c5a94e0 11071:3851ce4f2061
     1 {-
     1 {-
     2  * Hedgewars, a free turn based strategy game
     2  * Hedgewars, a free turn based strategy game
     3  * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
     3  * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
     4  *
     4  *
     5  * This program is free software; you can redistribute it and/or modify
     5  * This program is free software; you can redistribute it and/or modify
     6  * it under the terms of the GNU General Public License as published by
     6  * it under the terms of the GNU General Public License as published by
     7  * the Free Software Foundation; version 2 of the License
     7  * the Free Software Foundation; version 2 of the License
     8  *
     8  *
    14  * You should have received a copy of the GNU General Public License
    14  * You should have received a copy of the GNU General Public License
    15  * along with this program; if not, write to the Free Software
    15  * along with this program; if not, write to the Free Software
    16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    17  \-}
    17  \-}
    18 
    18 
    19 {-# LANGUAGE OverloadedStrings #-}
    19 {-# LANGUAGE CPP, OverloadedStrings #-}
    20 
    20 
       
    21 #if defined(OFFICIAL_SERVER)
    21 module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where
    22 module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where
       
    23 #else
       
    24 module EngineInteraction(checkNetCmd, toEngineMsg) where
       
    25 #endif
    22 
    26 
    23 import qualified Data.Set as Set
    27 import qualified Data.Set as Set
    24 import Control.Monad
    28 import Control.Monad
    25 import qualified Codec.Binary.Base64 as Base64
    29 import qualified Codec.Binary.Base64 as Base64
    26 import qualified Data.ByteString.Char8 as B
    30 import qualified Data.ByteString.Char8 as B
    34 import Data.Maybe
    38 import Data.Maybe
    35 -------------
    39 -------------
    36 import CoreTypes
    40 import CoreTypes
    37 import Utils
    41 import Utils
    38 
    42 
       
    43 #if defined(OFFICIAL_SERVER)
    39 {-
    44 {-
    40     this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror
    45     this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror
    41     because standard 'catch' doesn't seem to catch decompression errors for some reason
    46     because standard 'catch' doesn't seem to catch decompression errors for some reason
    42 -}
    47 -}
    43 import qualified Codec.Compression.Zlib.Internal as Z
    48 import qualified Codec.Compression.Zlib.Internal as Z
    49   where err _ msg = Left msg
    54   where err _ msg = Left msg
    50         nil = Right []
    55         nil = Right []
    51         cons chunk = right (chunk :)
    56         cons chunk = right (chunk :)
    52         finalise = right BL.fromChunks
    57         finalise = right BL.fromChunks
    53 {- end snippet  -}
    58 {- end snippet  -}
       
    59 #endif
    54 
    60 
    55 toEngineMsg :: B.ByteString -> B.ByteString
    61 toEngineMsg :: B.ByteString -> B.ByteString
    56 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
    62 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
    57 
    63 
    58 
    64 
    87         isNonEmpty = (/=) '+' . B.head . B.tail
    93         isNonEmpty = (/=) '+' . B.head . B.tail
    88         legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtgfhbc12345" ++ slotMessages
    94         legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtgfhbc12345" ++ slotMessages
    89         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
    95         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
    90         timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgfc12345" ++ slotMessages
    96         timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgfc12345" ++ slotMessages
    91 
    97 
       
    98 #if defined(OFFICIAL_SERVER)
    92 replayToDemo :: [TeamInfo]
    99 replayToDemo :: [TeamInfo]
    93         -> Map.Map B.ByteString B.ByteString
   100         -> Map.Map B.ByteString B.ByteString
    94         -> Map.Map B.ByteString [B.ByteString]
   101         -> Map.Map B.ByteString [B.ByteString]
    95         -> [B.ByteString]
   102         -> [B.ByteString]
    96         -> [B.ByteString]
   103         -> [B.ByteString]
   122         mapGenTypes = ["+rnd+", "+maze+", "+drawn+", "+perlin+"]
   129         mapGenTypes = ["+rnd+", "+maze+", "+drawn+", "+perlin+"]
   123         maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
   130         maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
   124         maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
   131         maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
   125         scheme = tail $ prms Map.! "SCHEME"
   132         scheme = tail $ prms Map.! "SCHEME"
   126         mapgen = mParams Map.! "MAPGEN"
   133         mapgen = mParams Map.! "MAPGEN"
   127         templateFilterMsg = eml ["e$maze_size ", mParams Map.! "MAZE_SIZE"]
   134         mazeSizeMsg = eml ["e$maze_size ", mParams Map.! "MAZE_SIZE"]
   128         mapgenSpecific = case mapgen of
   135         mapgenSpecific = case mapgen of
       
   136             "1" -> [mazeSizeMsg]
       
   137             "2" -> [mazeSizeMsg]
   129             "3" -> let d = head . fromMaybe [""] $ Map.lookup "DRAWNMAP" prms in if BW.length d <= 4 then [] else drawnMapData d
   138             "3" -> let d = head . fromMaybe [""] $ Map.lookup "DRAWNMAP" prms in if BW.length d <= 4 then [] else drawnMapData d
   130             _ -> [templateFilterMsg]
   139             _ -> []
   131         gameFlags :: Word32
   140         gameFlags :: Word32
   132         gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts
   141         gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts
   133         schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m])
   142         schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m])
   134             $ filter (\(_, (n, _)) -> not $ B.null n)
   143             $ filter (\(_, (n, _)) -> not $ B.null n)
   135             $ zip (drop (length gameFlagConsts) scheme) schemeParams
   144             $ zip (drop (length gameFlagConsts) scheme) schemeParams
   217         , 0x00800000
   226         , 0x00800000
   218         , 0x01000000
   227         , 0x01000000
   219         , 0x02000000
   228         , 0x02000000
   220         , 0x04000000
   229         , 0x04000000
   221         ]
   230         ]
   222 
   231 #endif
   223 
       
   224