gameServer/EngineInteraction.hs
author Wuzzy <Wuzzy2@mail.ru>
Sat, 28 Jul 2018 13:15:59 +0200
changeset 13567 8f9b84d6991d
parent 12113 72f5d670bbee
permissions -rw-r--r--
Fix DrawHLinesExplosions setting invalid map pixels if called at wrap world edge This caused an errror message after the game when using hammer or pickhammer at wrap world edge.
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)
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    47
import qualified Codec.Compression.Zlib.Internal as ZI
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
    48
import qualified Codec.Compression.Zlib as Z
10055
f738693be9be More robust implementation of decompression
unc0rr
parents: 10053
diff changeset
    49
12113
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    50
decompressWithoutExceptions :: BL.ByteString -> BL.ByteString
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    51
decompressWithoutExceptions = BL.fromChunks . ZI.foldDecompressStreamWithInput chunk end err decomp
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    52
    where
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    53
        decomp = ZI.decompressST ZI.zlibFormat ZI.defaultDecompressParams
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    54
        chunk = (:)
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    55
        end _ = []
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
    56
        err = const $ [BW.empty]
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
    57
#endif
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    58
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    59
toEngineMsg :: B.ByteString -> B.ByteString
11855
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    60
toEngineMsg msg = Base64.encode (fromIntegral (BW.length msg) `BW.cons` msg)
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    61
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    62
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    63
{-fromEngineMsg :: B.ByteString -> Maybe B.ByteString
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    64
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    65
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    66
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
10058
4ed428389c4e - Implement /callvote
unc0rr
parents: 10055
diff changeset
    67
        removeLength _ = Nothing-}
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    68
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    69
em :: B.ByteString -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    70
em = toEngineMsg
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    71
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    72
eml :: [B.ByteString] -> B.ByteString
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
    73
eml = em . B.concat
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    74
8484
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    75
splitMessages :: B.ByteString -> [B.ByteString]
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    76
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
    77
99c14f14f788 New checker of engine messages which is aware of glued together messages
unc0rr
parents: 8483
diff changeset
    78
11556
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    79
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
    80
checkNetCmd teamsIndexes msg = check decoded
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    81
    where
11855
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    82
        decoded = liftM splitMessages $ Base64.decode msg
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    83
        check (Left _) = (B.empty, B.empty, Nothing)
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    84
        check (Right msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b, lft a)
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    85
        encode = Base64.encode . B.concat
11556
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    86
        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
    87
        lft = foldr l Nothing
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9690
diff changeset
    88
        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
    89
                      if not $ tst timedMessages m' then n
11855
ad435d95ca4b - Use sandi instead of dataenc (bugs.debian.org/836686)
unc0rr
parents: 11586
diff changeset
    90
                        else if '+' /= m' then Just Nothing else Just . Just . Base64.encode $ m
8506
3889dab021b8 - Fix check for void message
unc0rr
parents: 8503
diff changeset
    91
        isNonEmpty = (/=) '+' . B.head . B.tail
11586
2963c85c6de4 Don't see a good reason for it to be here
unC0Rr
parents: 11577
diff changeset
    92
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,NpPwtgfhbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    93
        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
    94
        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
    95
        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
    96
                          | otherwise = True
af9aa8d5863c Filter out hog speech messages with non-local team index (not tested)
unc0rr
parents: 11547
diff changeset
    97
        isMalformed _ _ = False
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    98
10983
6aba07ea908b Lazy fix for server build
unc0rr
parents: 10779
diff changeset
    99
#if defined(OFFICIAL_SERVER)
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   100
replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   101
        -> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   102
        -> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
   103
        -> [B.ByteString]
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   104
        -> (Maybe GameDetails, [B.ByteString])
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   105
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
   106
        [em "TD"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   107
        , maybeScript
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   108
        , 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
   109
        , [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
   110
        , [eml ["eseed ", mParams Map.! "SEED"]]
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   111
        , [eml ["e$gmflags ", showB gameFlags]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   112
        , schemeFlags
10740
c9db53de9c3b Generate config for 'world edge' and 'script param' scheme options
unc0rr
parents: 10460
diff changeset
   113
        , 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
   114
        , [eml ["e$template_filter ", mParams Map.! "TEMPLATE"]]
10755
f78a5ca6e0af Include feature_size to demos for checker
unc0rr
parents: 10740
diff changeset
   115
        , [eml ["e$feature_size ", mParams Map.! "FEATURE_SIZE"]]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   116
        , [eml ["e$mapgen ", mapgen]]
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   117
        , 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
   118
        , concatMap teamSetup ti
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   119
        , msgs
8483
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   120
        , [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
   121
        ])
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   122
    where
10065
35bd559c1973 Some basic sanity tests for replay files
unc0rr
parents: 10060
diff changeset
   123
        keys1, keys2 :: Set.Set B.ByteString
10755
f78a5ca6e0af Include feature_size to demos for checker
unc0rr
parents: 10740
diff changeset
   124
        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
   125
        keys2 = Set.fromList ["AMMO", "SCHEME", "SCRIPT", "THEME"]
10067
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   126
        sane = Set.null (keys1 Set.\\ Map.keysSet mParams)
8df84ec62600 Must not code at late night (fix sanity check)
unc0rr
parents: 10066
diff changeset
   127
            && Set.null (keys2 Set.\\ Map.keysSet prms)
10760
fcef7d62d3c4 Eh, faulty check
unc0rr
parents: 10755
diff changeset
   128
            && (not . null . drop 41 $ scheme)
11321
71a46315c2d4 Fix replay sanity check
unc0rr
parents: 11320
diff changeset
   129
            && (not . null . tail $ prms Map.! "AMMO")
11328
2400c9496288 Oops, fix the fix
unc0rr
parents: 11321
diff changeset
   130
            && ((B.length . head . tail $ prms Map.! "AMMO") > 200)
10779
d85fe0cb5df2 Fix handling of perlin mapgen
unc0rr
parents: 10777
diff changeset
   131
        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
   132
        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
   133
        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
   134
        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
   135
        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
   136
        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
   137
        mazeSizeMsg = eml ["e$maze_size ", mParams Map.! "MAZE_SIZE"]
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   138
        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
   139
            "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
   140
            "2" -> [mazeSizeMsg]
10777
18afcfaa4d5a - Send maze_size command in other mapgen modes too
unc0rr
parents: 10760
diff changeset
   141
            "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
   142
            _ -> []
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   143
        gameFlags :: Word32
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   144
        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
   145
        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
   146
            $ filter (\(_, (n, _)) -> not $ B.null n)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   147
            $ zip (drop (length gameFlagConsts) scheme) schemeParams
11547
2bbbe9cb2980 Fix index of script param
unc0rr
parents: 11355
diff changeset
   148
        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
   149
        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
   150
        ammoStr = head . tail $ prms Map.! "AMMO"
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   151
        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
   152
                   (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
   153
                   ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"]
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   154
        initHealth = scheme !! 27
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   155
        teamSetup :: TeamInfo -> [B.ByteString]
8499
da5394a3eb0e - Add forgotten ammo definitions
unc0rr
parents: 8496
diff changeset
   156
        teamSetup t = (++) ammo $
8541
0cd63b963330 Try to prevent hedgehogs number in team desync
unc0rr
parents: 8527
diff changeset
   157
                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
   158
                : em "erdriven"
d5fd4d7a0bcc Also convert teams to complete game config.
unc0rr
parents: 8481
diff changeset
   159
                : eml ["efort ", teamfort t]
8527
bf671ddf467c Fix stupid mistake which made checker desync almost always
unc0rr
parents: 8506
diff changeset
   160
                : take (2 * hhnum t) (
8503
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   161
                    concatMap (\(HedgehogInfo hname hhat) -> [
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   162
                            eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   163
                            , eml ["ehat ", hhat]
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   164
                            ])
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   165
                        $ hedgehogs t
e60c84b42f4d Pass hogs names and hats
unc0rr
parents: 8499
diff changeset
   166
                        )
11320
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   167
        infRopes = ammoStr `B.index` 7  == '9'
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   168
        vamp = gameFlags .&. 0x00000200 /= 0
556eafd1443a Store some more details on game config in the database
unc0rr
parents: 11246
diff changeset
   169
        infattacks = gameFlags .&. 0x00100000 /= 0
11337
41ca5f8ace18 Pass correct script name for scripts with spaces in name
unc0rr
parents: 11328
diff changeset
   170
        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
   171
8481
692ff6468b63 - Handle mapgen-specific parameters
unc0rr
parents: 8480
diff changeset
   172
drawnMapData :: B.ByteString -> [B.ByteString]
10040
koda
parents: 10017 10034
diff changeset
   173
drawnMapData =
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   174
          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
   175
        . L.unfoldr by200
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   176
        . BL.unpack
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   177
        . unpackDrawnMap
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   178
    where
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   179
        by200 :: [a] -> Maybe ([a], [a])
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   180
        by200 [] = Nothing
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   181
        by200 m = Just $ L.splitAt 200 m
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   182
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   183
unpackDrawnMap :: B.ByteString -> BL.ByteString
12113
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
   184
unpackDrawnMap = either
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
   185
        (const BL.empty) 
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
   186
        (decompressWithoutExceptions . BL.pack . drop 4 . BW.unpack)
10027
403b86a1d05f Implement drawnMapData function so checker could check replays with drawn maps
unc0rr
parents: 9690
diff changeset
   187
        . Base64.decode
11577
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
compressWithLength :: BL.ByteString -> BL.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   190
compressWithLength b = BL.drop 8 . encode . runPut $ do
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   191
    put $ ((fromIntegral $ BL.length b)::Word32)
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   192
    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
   193
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   194
packDrawnMap :: BL.ByteString -> B.ByteString
12113
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
   195
packDrawnMap =
72f5d670bbee Fix official server build
unc0rr
parents: 11855
diff changeset
   196
      Base64.encode
11577
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   197
    . BL.toStrict
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   198
    . compressWithLength
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   199
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   200
prependGhostPoints :: [(Int16, Int16)] -> B.ByteString -> B.ByteString
bee3a2f8e117 Finish implementation of ghost points served from server, not tested
unc0rr
parents: 11556
diff changeset
   201
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
   202
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   203
schemeParams :: [(B.ByteString, Int)]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   204
schemeParams = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   205
      ("e$damagepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   206
    , ("e$turntime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   207
    , ("", 0)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   208
    , ("e$sd_turns", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   209
    , ("e$casefreq", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   210
    , ("e$minestime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   211
    , ("e$minesnum", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   212
    , ("e$minedudpct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   213
    , ("e$explosives", 1)
11355
d94f65b66c60 Oops, zero multiplier
unc0rr
parents: 11345
diff changeset
   214
    , ("e$airmines", 1)
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   215
    , ("e$healthprob", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   216
    , ("e$hcaseamount", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   217
    , ("e$waterrise", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   218
    , ("e$healthdec", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   219
    , ("e$ropepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   220
    , ("e$getawaytime", 1)
10740
c9db53de9c3b Generate config for 'world edge' and 'script param' scheme options
unc0rr
parents: 10460
diff changeset
   221
    , ("e$worldedge", 1)
8480
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   222
    ]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   223
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   224
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   225
gameFlagConsts :: [Word32]
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   226
gameFlagConsts = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   227
          0x00001000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   228
        , 0x00000010
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   229
        , 0x00000004
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   230
        , 0x00000008
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   231
        , 0x00000020
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   232
        , 0x00000040
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   233
        , 0x00000080
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   234
        , 0x00000100
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   235
        , 0x00000200
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   236
        , 0x00000400
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   237
        , 0x00000800
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   238
        , 0x00002000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   239
        , 0x00004000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   240
        , 0x00008000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   241
        , 0x00010000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   242
        , 0x00020000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   243
        , 0x00040000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   244
        , 0x00080000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   245
        , 0x00100000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   246
        , 0x00200000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   247
        , 0x00400000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   248
        , 0x00800000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   249
        , 0x01000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   250
        , 0x02000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   251
        , 0x04000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet
unc0rr
parents: 8479
diff changeset
   252
        ]
10984
c828cabe33af More ifdefs \o/ (fix build even more)
unc0rr
parents: 10983
diff changeset
   253
#endif