author | koda |
Wed, 20 Feb 2013 01:55:23 +0100 | |
changeset 8518 | 24d2bdc6deff |
parent 8506 | 3889dab021b8 |
child 8527 | bf671ddf467c |
permissions | -rw-r--r-- |
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
2 |
|
6068 | 3 |
module EngineInteraction where |
4 |
||
5 |
import qualified Data.Set as Set |
|
6 |
import Control.Monad |
|
7 |
import qualified Codec.Binary.Base64 as Base64 |
|
8 |
import qualified Data.ByteString.Char8 as B |
|
9 |
import qualified Data.ByteString as BW |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
10 |
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
|
11 |
import qualified Data.List as L |
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
12 |
import Data.Word |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
13 |
import Data.Bits |
8481 | 14 |
import Control.Arrow |
6069 | 15 |
------------- |
16 |
import CoreTypes |
|
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
17 |
import Utils |
6068 | 18 |
|
19 |
||
20 |
toEngineMsg :: B.ByteString -> B.ByteString |
|
21 |
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
|
22 |
||
23 |
||
24 |
fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
|
25 |
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
|
26 |
where |
|
27 |
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
|
28 |
removeLength _ = Nothing |
|
29 |
||
30 |
||
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
31 |
splitMessages :: B.ByteString -> [B.ByteString] |
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
32 |
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
|
33 |
|
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
34 |
|
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
35 |
checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString) |
6068 | 36 |
checkNetCmd msg = check decoded |
37 |
where |
|
8485 | 38 |
decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg |
8484
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
39 |
check Nothing = (B.empty, B.empty) |
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
40 |
check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b) |
99c14f14f788
New checker of engine messages which is aware of glued together messages
unc0rr
parents:
8483
diff
changeset
|
41 |
encode = B.pack . Base64.encode . BW.unpack . B.concat |
8485 | 42 |
isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m) |
8506 | 43 |
isNonEmpty = (/=) '+' . B.head . B.tail |
6206
75e0d8169ba2
As sheepluva pointed out, allowing this message to be legal allows naughtiness. The server usage of this message does not seem to use this check.
nemo
parents:
6070
diff
changeset
|
44 |
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages |
6068 | 45 |
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
46 |
||
7766 | 47 |
|
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
48 |
replayToDemo :: [TeamInfo] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
49 |
-> Map.Map B.ByteString B.ByteString |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
50 |
-> Map.Map B.ByteString [B.ByteString] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
51 |
-> [B.ByteString] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
52 |
-> [B.ByteString] |
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
53 |
replayToDemo teams mapParams params msgs = concat [ |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
54 |
[em "TD"] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
55 |
, maybeScript |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
56 |
, maybeMap |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
57 |
, [eml ["etheme ", head $ params Map.! "THEME"]] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
58 |
, [eml ["eseed ", mapParams Map.! "SEED"]] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
59 |
, [eml ["e$gmflags ", showB gameFlags]] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
60 |
, schemeFlags |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
61 |
, [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]] |
8481 | 62 |
, [eml ["e$mapgen ", mapgen]] |
63 |
, mapgenSpecific |
|
64 |
, concatMap teamSetup teams |
|
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
65 |
, msgs |
8483 | 66 |
, [em "!"] |
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
67 |
] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
68 |
where |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
69 |
em = toEngineMsg |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
70 |
eml = em . B.concat |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
71 |
mapGenTypes = ["+rnd+", "+maze+", "+drawn+"] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
72 |
maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
73 |
maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
74 |
scheme = tail $ params Map.! "SCHEME" |
8481 | 75 |
mapgen = mapParams Map.! "MAPGEN" |
76 |
mapgenSpecific = case mapgen of |
|
77 |
"+maze+" -> [eml ["e$maze_size ", head $ params Map.! "MAZE_SIZE"]] |
|
78 |
"+drawn" -> drawnMapData . head $ params Map.! "DRAWNMAP" |
|
79 |
_ -> [] |
|
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
80 |
gameFlags :: Word32 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
81 |
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
|
82 |
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
|
83 |
$ filter (\(_, (n, _)) -> not $ B.null n) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
84 |
$ zip (drop (length gameFlagConsts) scheme) schemeParams |
8481 | 85 |
ammoStr :: B.ByteString |
86 |
ammoStr = head . tail $ params Map.! "AMMO" |
|
87 |
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 | 88 |
(map (\(x, y) -> eml [x, " ", y]) $ zip ["eammloadt", "eammprob", "eammdelay", "eammreinf"] [a, b, c, d]) |
89 |
++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"] |
|
90 |
initHealth = scheme !! 27 |
|
8481 | 91 |
teamSetup :: TeamInfo -> [B.ByteString] |
8499 | 92 |
teamSetup t = (++) ammo $ |
93 |
eml ["eaddteam <hash> ", showB $ (1 + (readInt_ $ teamcolor t) :: Int) * 1234, " ", teamname t] |
|
8483 | 94 |
: em "erdriven" |
95 |
: eml ["efort ", teamfort t] |
|
8503 | 96 |
: take (hhnum t) ( |
97 |
concatMap (\(HedgehogInfo hname hhat) -> [ |
|
98 |
eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname] |
|
99 |
, eml ["ehat ", hhat] |
|
100 |
]) |
|
101 |
$ hedgehogs t |
|
102 |
) |
|
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
103 |
|
8481 | 104 |
drawnMapData :: B.ByteString -> [B.ByteString] |
8483 | 105 |
drawnMapData = error "drawnMapData" |
8480
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
106 |
|
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
107 |
schemeParams :: [(B.ByteString, Int)] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
108 |
schemeParams = [ |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
109 |
("e$damagepct", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
110 |
, ("e$turntime", 1000) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
111 |
, ("", 0) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
112 |
, ("e$sd_turns", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
113 |
, ("e$casefreq", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
114 |
, ("e$minestime", 1000) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
115 |
, ("e$minesnum", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
116 |
, ("e$minedudpct", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
117 |
, ("e$explosives", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
118 |
, ("e$healthprob", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
119 |
, ("e$hcaseamount", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
120 |
, ("e$waterrise", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
121 |
, ("e$healthdec", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
122 |
, ("e$ropepct", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
123 |
, ("e$getawaytime", 1) |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
124 |
] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
125 |
|
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
126 |
|
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
127 |
gameFlagConsts :: [Word32] |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
128 |
gameFlagConsts = [ |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
129 |
0x00001000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
130 |
, 0x00000010 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
131 |
, 0x00000004 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
132 |
, 0x00000008 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
133 |
, 0x00000020 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
134 |
, 0x00000040 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
135 |
, 0x00000080 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
136 |
, 0x00000100 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
137 |
, 0x00000200 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
138 |
, 0x00000400 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
139 |
, 0x00000800 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
140 |
, 0x00002000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
141 |
, 0x00004000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
142 |
, 0x00008000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
143 |
, 0x00010000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
144 |
, 0x00020000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
145 |
, 0x00040000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
146 |
, 0x00080000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
147 |
, 0x00100000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
148 |
, 0x00200000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
149 |
, 0x00400000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
150 |
, 0x00800000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
151 |
, 0x01000000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
152 |
, 0x02000000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
153 |
, 0x04000000 |
42d2565b5700
Converter from game parameters to engine commands, not finished yet
unc0rr
parents:
8479
diff
changeset
|
154 |
] |
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
155 |
|
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
156 |
|
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
7766
diff
changeset
|
157 |