gameServer/EngineInteraction.hs
author sheepluva
Wed, 27 Apr 2016 16:20:59 +0200
changeset 11744 ac58a063d26a
parent 11586 2963c85c6de4
child 11855 ad435d95ca4b
permissions -rw-r--r--
Added "Forts" to map type selection. This makes the mode easier selectable/discoverable. Also the slider can be used to adjust the distance between forts.
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
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 11031
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
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
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
    19
{-# LANGUAGE CPP, OverloadedStrings #-}
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    20
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
    21
#if defined(OFFICIAL_SERVER)
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    22
module EngineInteraction(replayToDemo, checkNetCmd, toEngineMsg, drawnMapData, prependGhostPoints) where
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
    23
#else
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
    24
module EngineInteraction(checkNetCmd, toEngineMsg) where
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
    25
#endif
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    28
import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    29
import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    30
import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    31
import qualified Data.ByteString as BW
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    32
import qualified Data.ByteString.Lazy as BL
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    33
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
    34
import qualified Data.List as L
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    35
import Data.Word
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    36
import Data.Int
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    37
import Data.Bits
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
    38
import Control.Arrow
9690
6a1748b71df2 Handle absence of "SCRIPT" in replay
unc0rr
parents: 9401
diff changeset
    39
import Data.Maybe
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    40
import Data.Binary
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    41
import Data.Binary.Put
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    42
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    43
import CoreTypes
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
    44
import Utils
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    45
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
    46
#if defined(OFFICIAL_SERVER)
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    47
{-
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    48
    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
    49
    because standard 'catch' doesn't seem to catch decompression errors for some reason
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    50
-}
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    51
import qualified Codec.Compression.Zlib.Internal as ZI
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    52
import qualified Codec.Compression.Zlib as Z
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    53
10060
bcf2e1ca2971 Use zlibFormat
unc0rr
parents: 10058
diff changeset
    54
decompressWithoutExceptions :: BL.ByteString -> Either String BL.ByteString
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    55
decompressWithoutExceptions = finalise
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    56
                            . ZI.foldDecompressStream cons nil err
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    57
                            . ZI.decompressWithErrors ZI.zlibFormat ZI.defaultDecompressParams
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
    58
  where err _ msg = Left msg
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    59
        nil = Right []
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    60
        cons chunk = right (chunk :)
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    61
        finalise = right BL.fromChunks
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    62
{- end snippet  -}
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
    63
#endif
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    65
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    66
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    67
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    68
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    69
{-fromEngineMsg :: B.ByteString -> Maybe B.ByteString
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    70
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    71
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    72
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    73
        removeLength _ = Nothing-}
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    74
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    75
em :: B.ByteString -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    76
em = toEngineMsg
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    77
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    78
eml :: [B.ByteString] -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    79
eml = em . B.concat
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    80
8484
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    81
splitMessages :: B.ByteString -> [B.ByteString]
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    82
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
    83
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    84
11556
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    85
checkNetCmd :: [Word8] -> B.ByteString -> (B.ByteString, B.ByteString, Maybe (Maybe B.ByteString))
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    86
checkNetCmd teamsIndexes msg = check decoded
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    87
    where
8485
7cae79214537 Fix the checker after some testing
unc0rr
parents: 8484
diff changeset
    88
        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
    89
        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
    90
        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
    91
        encode = B.pack . Base64.encode . BW.unpack . B.concat
11556
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    92
        isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m) && not (isMalformed (B.head m) (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
    93
        lft = foldr l Nothing
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9690
diff changeset
    94
        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
    95
                      if not $ tst timedMessages m' then n
9401
2af7bea32e5e - Some fixes to official server build
unc0rr
parents: 9304
diff changeset
    96
                        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
    97
        isNonEmpty = (/=) '+' . B.head . B.tail
11586
2963c85c6de4 Don't see a good reason for it to be here
unC0Rr
parents: 11577
diff changeset
    98
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,NpPwtgfhbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    99
        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
   100
        timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgfc12345" ++ slotMessages
11556
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
   101
        isMalformed 'h' m | B.length m >= 3 = let hognum = m `B.index` 1; teamnum = m `BW.index` 2 in hognum < '1' || hognum > '8' || teamnum `L.notElem` teamsIndexes
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
   102
                          | otherwise = True
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
   103
        isMalformed _ _ = False
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
   104
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
   105
#if defined(OFFICIAL_SERVER)
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   106
replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   107
        -> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   108
        -> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   109
        -> [B.ByteString]
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   110
        -> (Maybe GameDetails, [B.ByteString])
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   111
replayToDemo ti mParams prms msgs = if not sane then (Nothing, []) else (Just $ GameDetails scriptName infRopes vamp infattacks, concat [
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   112
        [em "TD"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   113
        , maybeScript
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   114
        , 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
   115
        , [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
   116
        , [eml ["eseed ", mParams Map.! "SEED"]]
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   117
        , [eml ["e$gmflags ", showB gameFlags]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   118
        , schemeFlags
10740
c9db53de9c3b Generate config for 'world edge' and 'script param' scheme options
unc0rr
parents: 10460
diff changeset
   119
        , schemeAdditional
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
   120
        , [eml ["e$template_filter ", mParams Map.! "TEMPLATE"]]
10755
f78a5ca6e0af Include feature_size to demos for checker
unc0rr
parents: 10740
diff changeset
   121
        , [eml ["e$feature_size ", mParams Map.! "FEATURE_SIZE"]]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   122
        , [eml ["e$mapgen ", mapgen]]
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   123
        , 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
   124
        , concatMap teamSetup ti
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   125
        , msgs
8483
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   126
        , [em "!"]
11246
09a2d3988569 Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
unc0rr
parents: 11046
diff changeset
   127
        ])
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   128
    where
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   129
        keys1, keys2 :: Set.Set B.ByteString
10755
f78a5ca6e0af Include feature_size to demos for checker
unc0rr
parents: 10740
diff changeset
   130
        keys1 = Set.fromList ["FEATURE_SIZE", "MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
10066
1a6e1aad58d6 - Add SCHEME which is needed in room config
unc0rr
parents: 10065
diff changeset
   131
        keys2 = Set.fromList ["AMMO", "SCHEME", "SCRIPT", "THEME"]
10067
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   132
        sane = Set.null (keys1 Set.\\ Map.keysSet mParams)
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   133
            && Set.null (keys2 Set.\\ Map.keysSet prms)
10760
fcef7d62d3c4 Eh, faulty check
unc0rr
parents: 10755
diff changeset
   134
            && (not . null . drop 41 $ scheme)
11321
71a46315c2d4 Fix replay sanity check
unc0rr
parents: 11320
diff changeset
   135
            && (not . null . tail $ prms Map.! "AMMO")
11328
2400c9496288 Oops, fix the fix
unc0rr
parents: 11321
diff changeset
   136
            && ((B.length . head . tail $ prms Map.! "AMMO") > 200)
10779
d85fe0cb5df2 Fix handling of perlin mapgen
unc0rr
parents: 10777
diff changeset
   137
        mapGenTypes = ["+rnd+", "+maze+", "+drawn+", "+perlin+"]
11246
09a2d3988569 Also pass script information alongwith winner/achievements info, so that we could potentially have per mode ratings
unc0rr
parents: 11046
diff changeset
   138
        scriptName = head . fromMaybe ["Normal"] $ Map.lookup "SCRIPT" prms
11337
41ca5f8ace18 Pass correct script name for scripts with spaces in name
unc0rr
parents: 11328
diff changeset
   139
        maybeScript = let s = scriptName in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", spaces2Underlining 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
   140
        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
   141
        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
   142
        mapgen = mParams Map.! "MAPGEN"
11031
4ad0252470dd Fixes to 10760 to reduce desyncs on checkers and better heat my room during long dark winter nights
unc0rr
parents: 10984
diff changeset
   143
        mazeSizeMsg = eml ["e$maze_size ", mParams Map.! "MAZE_SIZE"]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   144
        mapgenSpecific = case mapgen of
11031
4ad0252470dd Fixes to 10760 to reduce desyncs on checkers and better heat my room during long dark winter nights
unc0rr
parents: 10984
diff changeset
   145
            "1" -> [mazeSizeMsg]
4ad0252470dd Fixes to 10760 to reduce desyncs on checkers and better heat my room during long dark winter nights
unc0rr
parents: 10984
diff changeset
   146
            "2" -> [mazeSizeMsg]
10777
18afcfaa4d5a - Send maze_size command in other mapgen modes too
unc0rr
parents: 10760
diff changeset
   147
            "3" -> let d = head . fromMaybe [""] $ Map.lookup "DRAWNMAP" prms in if BW.length d <= 4 then [] else drawnMapData d
11031
4ad0252470dd Fixes to 10760 to reduce desyncs on checkers and better heat my room during long dark winter nights
unc0rr
parents: 10984
diff changeset
   148
            _ -> []
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   149
        gameFlags :: Word32
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   150
        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
   151
        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
   152
            $ filter (\(_, (n, _)) -> not $ B.null n)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   153
            $ zip (drop (length gameFlagConsts) scheme) schemeParams
11547
2bbbe9cb2980 Fix index of script param
unc0rr
parents: 11355
diff changeset
   154
        schemeAdditional = let scriptParam = B.tail $ scheme !! 42 in [eml ["e$scriptparam ", scriptParam] | not $ B.null scriptParam]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   155
        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
   156
        ammoStr = head . tail $ prms Map.! "AMMO"
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   157
        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
   158
                   (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
   159
                   ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"]
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   160
        initHealth = scheme !! 27
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   161
        teamSetup :: TeamInfo -> [B.ByteString]
8499
da5394a3eb0e - Add forgotten ammo definitions
unc0rr
parents: 8496
diff changeset
   162
        teamSetup t = (++) ammo $
8541
0cd63b963330 Try to prevent hedgehogs number in team desync
unc0rr
parents: 8527
diff changeset
   163
                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
   164
                : em "erdriven"
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   165
                : eml ["efort ", teamfort t]
8527
bf671ddf467c Fix stupid mistake which made checker desync almost always
unc0rr
parents: 8506
diff changeset
   166
                : take (2 * hhnum t) (
8503
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   167
                    concatMap (\(HedgehogInfo hname hhat) -> [
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   168
                            eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   169
                            , eml ["ehat ", hhat]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   170
                            ])
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   171
                        $ hedgehogs t
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   172
                        )
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   173
        infRopes = ammoStr `B.index` 7  == '9'
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   174
        vamp = gameFlags .&. 0x00000200 /= 0
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   175
        infattacks = gameFlags .&. 0x00100000 /= 0
11337
41ca5f8ace18 Pass correct script name for scripts with spaces in name
unc0rr
parents: 11328
diff changeset
   176
        spaces2Underlining = B.map (\c -> if c == ' ' then '_' else c)
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   177
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   178
drawnMapData :: B.ByteString -> [B.ByteString]
10040
koda
parents: 10017 10034
diff changeset
   179
drawnMapData =
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   180
          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
   181
        . L.unfoldr by200
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   182
        . BL.unpack
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   183
        . unpackDrawnMap
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   184
    where
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   185
        by200 :: [a] -> Maybe ([a], [a])
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   186
        by200 [] = Nothing
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   187
        by200 m = Just $ L.splitAt 200 m
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   188
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   189
unpackDrawnMap :: B.ByteString -> BL.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   190
unpackDrawnMap = either (const BL.empty) id
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
   191
        . decompressWithoutExceptions
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   192
        . BL.pack
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   193
        . L.drop 4
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   194
        . fromMaybe []
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   195
        . Base64.decode
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   196
        . B.unpack
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   197
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   198
compressWithLength :: BL.ByteString -> BL.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   199
compressWithLength b = BL.drop 8 . encode . runPut $ do
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   200
    put $ ((fromIntegral $ BL.length b)::Word32)
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   201
    mapM_ putWord8 $ BW.unpack $ BL.toStrict $ Z.compress b
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   202
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   203
packDrawnMap :: BL.ByteString -> B.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   204
packDrawnMap = B.pack
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   205
    . Base64.encode
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   206
    . BW.unpack
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   207
    . BL.toStrict
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   208
    . compressWithLength
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   209
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   210
prependGhostPoints :: [(Int16, Int16)] -> B.ByteString -> B.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   211
prependGhostPoints pts dm = packDrawnMap $ (runPut $ forM_ pts $ \(x, y) -> put x >> put y >> putWord8 99) `BL.append` unpackDrawnMap dm
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   212
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   213
schemeParams :: [(B.ByteString, Int)]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   214
schemeParams = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   215
      ("e$damagepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   216
    , ("e$turntime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   217
    , ("", 0)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   218
    , ("e$sd_turns", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   219
    , ("e$casefreq", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   220
    , ("e$minestime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   221
    , ("e$minesnum", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   222
    , ("e$minedudpct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   223
    , ("e$explosives", 1)
11355
d94f65b66c60 Oops, zero multiplier
unc0rr
parents: 11345
diff changeset
   224
    , ("e$airmines", 1)
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   225
    , ("e$healthprob", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   226
    , ("e$hcaseamount", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   227
    , ("e$waterrise", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   228
    , ("e$healthdec", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   229
    , ("e$ropepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   230
    , ("e$getawaytime", 1)
10740
c9db53de9c3b Generate config for 'world edge' and 'script param' scheme options
unc0rr
parents: 10460
diff changeset
   231
    , ("e$worldedge", 1)
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   232
    ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   233
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   234
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   235
gameFlagConsts :: [Word32]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   236
gameFlagConsts = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   237
          0x00001000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   238
        , 0x00000010
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   239
        , 0x00000004
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   240
        , 0x00000008
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   241
        , 0x00000020
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   242
        , 0x00000040
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   243
        , 0x00000080
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   244
        , 0x00000100
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   245
        , 0x00000200
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   246
        , 0x00000400
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   247
        , 0x00000800
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   248
        , 0x00002000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   249
        , 0x00004000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   250
        , 0x00008000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   251
        , 0x00010000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   252
        , 0x00020000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   253
        , 0x00040000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   254
        , 0x00080000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   255
        , 0x00100000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   256
        , 0x00200000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   257
        , 0x00400000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   258
        , 0x00800000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   259
        , 0x01000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   260
        , 0x02000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   261
        , 0x04000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   262
        ]
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
   263
#endif