gameServer/EngineInteraction.hs
author nemo
Mon, 08 Dec 2014 09:35:14 -0500
changeset 10634 35d059bd0932
parent 10460 8dcea9087d75
child 10740 c9db53de9c3b
child 10771 ac06370b7436
permissions -rw-r--r--
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     2
 * Hedgewars, a free turn based strategy game
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     3
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10343
diff changeset
    18
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    19
{-# LANGUAGE OverloadedStrings #-}
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    20
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    21
module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData) where
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    22
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    23
import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    24
import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    25
import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
import qualified Data.ByteString as BW
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    28
import qualified Data.ByteString.Lazy as BL
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    29
import qualified Data.Map as Map
8484
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    30
import qualified Data.List as L
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    31
import Data.Word
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    32
import Data.Bits
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
    33
import Control.Arrow
9690
6a1748b71df2 Handle absence of "SCRIPT" in replay
unc0rr
parents: 9401
diff changeset
    34
import Data.Maybe
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    35
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    36
import CoreTypes
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    37
import Utils
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    38
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    39
{-
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    40
    this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    41
    because standard 'catch' doesn't seem to catch decompression errors for some reason
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    42
-}
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    43
import qualified Codec.Compression.Zlib.Internal as Z
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    44
10060
bcf2e1ca2971 Use zlibFormat
unc0rr
parents: 10058
diff changeset
    45
decompressWithoutExceptions :: BL.ByteString -> Either String BL.ByteString
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    46
decompressWithoutExceptions = finalise
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    47
                            . Z.foldDecompressStream cons nil err
10060
bcf2e1ca2971 Use zlibFormat
unc0rr
parents: 10058
diff changeset
    48
                            . Z.decompressWithErrors Z.zlibFormat Z.defaultDecompressParams
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
    49
  where err _ msg = Left msg
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    50
        nil = Right []
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    51
        cons chunk = right (chunk :)
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    52
        finalise = right BL.fromChunks
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    53
{- end snippet  -}
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    54
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    55
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    56
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    57
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    58
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    59
{-fromEngineMsg :: B.ByteString -> Maybe B.ByteString
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    60
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    61
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    62
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    63
        removeLength _ = Nothing-}
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    64
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    65
em :: B.ByteString -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    66
em = toEngineMsg
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    67
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    68
eml :: [B.ByteString] -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    69
eml = em . B.concat
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    70
8484
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    71
splitMessages :: B.ByteString -> [B.ByteString]
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    72
splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b)
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    73
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    74
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
    75
checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString, Maybe (Maybe B.ByteString))
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    76
checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    77
    where
8485
7cae79214537 Fix the checker after some testing
unc0rr
parents: 8484
diff changeset
    78
        decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
    79
        check Nothing = (B.empty, B.empty, Nothing)
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
    80
        check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b, lft a)
8484
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    81
        encode = B.pack . Base64.encode . BW.unpack . B.concat
8485
7cae79214537 Fix the checker after some testing
unc0rr
parents: 8484
diff changeset
    82
        isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m)
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
    83
        lft = foldr l Nothing
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9690
diff changeset
    84
        l m n = let m' = B.head $ B.tail m; tst = flip Set.member in
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
    85
                      if not $ tst timedMessages m' then n
9401
2af7bea32e5e - Some fixes to official server build
unc0rr
parents: 9304
diff changeset
    86
                        else if '+' /= m' then Just Nothing else Just . Just . B.pack . Base64.encode . BW.unpack $ m
8506
3889dab021b8 - Fix check for void message
unc0rr
parents: 8503
diff changeset
    87
        isNonEmpty = (/=) '+' . B.head . B.tail
10343
fe9853dea6c4 Finish implementation of ability to take control over your team after being disconnected. Completely untested.
unc0rr
parents: 10067
diff changeset
    88
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtgfhbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    89
        slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
10343
fe9853dea6c4 Finish implementation of ability to take control over your team after being disconnected. Completely untested.
unc0rr
parents: 10067
diff changeset
    90
        timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgfc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    91
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    92
replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    93
        -> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    94
        -> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    95
        -> [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    96
        -> [B.ByteString]
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
    97
replayToDemo ti mParams prms msgs = if not sane then [] else concat [
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    98
        [em "TD"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    99
        , maybeScript
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   100
        , maybeMap
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   101
        , [eml ["etheme ", head $ prms Map.! "THEME"]]
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   102
        , [eml ["eseed ", mParams Map.! "SEED"]]
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   103
        , [eml ["e$gmflags ", showB gameFlags]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   104
        , schemeFlags
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   105
        , [eml ["e$template_filter ", mParams Map.! "TEMPLATE"]]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   106
        , [eml ["e$mapgen ", mapgen]]
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   107
        , mapgenSpecific
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   108
        , concatMap teamSetup ti
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   109
        , msgs
8483
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   110
        , [em "!"]
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   111
        ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   112
    where
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   113
        keys1, keys2 :: Set.Set B.ByteString
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   114
        keys1 = Set.fromList ["MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
10066
1a6e1aad58d6 - Add SCHEME which is needed in room config
unc0rr
parents: 10065
diff changeset
   115
        keys2 = Set.fromList ["AMMO", "SCHEME", "SCRIPT", "THEME"]
10067
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   116
        sane = Set.null (keys1 Set.\\ Map.keysSet mParams)
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   117
            && Set.null (keys2 Set.\\ Map.keysSet prms)
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   118
            && (not . null . drop 27 $ scheme)
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   119
            && (not . null . tail $ prms Map.! "AMMO")
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   120
        mapGenTypes = ["+rnd+", "+maze+", "+drawn+"]
9690
6a1748b71df2 Handle absence of "SCRIPT" in replay
unc0rr
parents: 9401
diff changeset
   121
        maybeScript = let s = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   122
        maybeMap = let m = mParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   123
        scheme = tail $ prms Map.! "SCHEME"
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   124
        mapgen = mParams Map.! "MAPGEN"
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   125
        mapgenSpecific = case mapgen of
10066
1a6e1aad58d6 - Add SCHEME which is needed in room config
unc0rr
parents: 10065
diff changeset
   126
            "1" -> [eml ["e$maze_size ", mParams Map.! "MAZE_SIZE"]]
1a6e1aad58d6 - Add SCHEME which is needed in room config
unc0rr
parents: 10065
diff changeset
   127
            "2" -> let d = head . fromMaybe [""] $ Map.lookup "DRAWNMAP" prms in if BW.length d <= 4 then [] else drawnMapData d
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   128
            _ -> []
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   129
        gameFlags :: Word32
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   130
        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
   131
        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
   132
            $ filter (\(_, (n, _)) -> not $ B.null n)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   133
            $ zip (drop (length gameFlagConsts) scheme) schemeParams
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   134
        ammoStr :: B.ByteString
9304
3f4c3fc146c2 Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents: 8541
diff changeset
   135
        ammoStr = head . tail $ prms Map.! "AMMO"
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   136
        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
8483
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   137
                   (map (\(x, y) -> eml [x, " ", y]) $ zip ["eammloadt", "eammprob", "eammdelay", "eammreinf"] [a, b, c, d])
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   138
                   ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"]
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   139
        initHealth = scheme !! 27
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   140
        teamSetup :: TeamInfo -> [B.ByteString]
8499
da5394a3eb0e - Add forgotten ammo definitions
unc0rr
parents: 8496
diff changeset
   141
        teamSetup t = (++) ammo $
8541
0cd63b963330 Try to prevent hedgehogs number in team desync
unc0rr
parents: 8527
diff changeset
   142
                eml ["eaddteam <hash> ", showB $ (1 + (readInt_ $ teamcolor t) :: Int) * 2113696, " ", teamname t]
8483
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   143
                : em "erdriven"
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   144
                : eml ["efort ", teamfort t]
8527
bf671ddf467c Fix stupid mistake which made checker desync almost always
unc0rr
parents: 8506
diff changeset
   145
                : take (2 * hhnum t) (
8503
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   146
                    concatMap (\(HedgehogInfo hname hhat) -> [
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   147
                            eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   148
                            , eml ["ehat ", hhat]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   149
                            ])
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   150
                        $ hedgehogs t
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   151
                        )
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   152
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   153
drawnMapData :: B.ByteString -> [B.ByteString]
10040
koda
parents: 10017 10034
diff changeset
   154
drawnMapData =
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   155
          L.map (\m -> eml ["edraw ", BW.pack m])
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   156
        . L.unfoldr by200
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   157
        . BL.unpack
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
   158
        . either (const BL.empty) id
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
   159
        . decompressWithoutExceptions
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   160
        . BL.pack
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   161
        . L.drop 4
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   162
        . fromMaybe []
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   163
        . Base64.decode
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   164
        . B.unpack
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   165
    where
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   166
        by200 :: [a] -> Maybe ([a], [a])
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   167
        by200 [] = Nothing
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   168
        by200 m = Just $ L.splitAt 200 m
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   169
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   170
schemeParams :: [(B.ByteString, Int)]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   171
schemeParams = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   172
      ("e$damagepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   173
    , ("e$turntime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   174
    , ("", 0)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   175
    , ("e$sd_turns", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   176
    , ("e$casefreq", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   177
    , ("e$minestime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   178
    , ("e$minesnum", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   179
    , ("e$minedudpct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   180
    , ("e$explosives", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   181
    , ("e$healthprob", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   182
    , ("e$hcaseamount", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   183
    , ("e$waterrise", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   184
    , ("e$healthdec", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   185
    , ("e$ropepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   186
    , ("e$getawaytime", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   187
    ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   188
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   189
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   190
gameFlagConsts :: [Word32]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   191
gameFlagConsts = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   192
          0x00001000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   193
        , 0x00000010
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   194
        , 0x00000004
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   195
        , 0x00000008
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   196
        , 0x00000020
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   197
        , 0x00000040
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   198
        , 0x00000080
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   199
        , 0x00000100
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   200
        , 0x00000200
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   201
        , 0x00000400
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   202
        , 0x00000800
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   203
        , 0x00002000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   204
        , 0x00004000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   205
        , 0x00008000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   206
        , 0x00010000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   207
        , 0x00020000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   208
        , 0x00040000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   209
        , 0x00080000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   210
        , 0x00100000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   211
        , 0x00200000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   212
        , 0x00400000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   213
        , 0x00800000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   214
        , 0x01000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   215
        , 0x02000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   216
        , 0x04000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   217
        ]
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   218
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   219
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   220