diff -r 404ddce27b23 -r c13ebed437cb gameServer/EngineInteraction.hs
--- a/gameServer/EngineInteraction.hs	Wed Feb 20 02:21:58 2013 +0100
+++ b/gameServer/EngineInteraction.hs	Tue Apr 02 21:00:57 2013 +0200
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module EngineInteraction where
 
 import qualified Data.Set as Set
@@ -5,8 +7,14 @@
 import qualified Codec.Binary.Base64 as Base64
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString as BW
+import qualified Data.Map as Map
+import qualified Data.List as L
+import Data.Word
+import Data.Bits
+import Control.Arrow
 -------------
 import CoreTypes
+import Utils
 
 
 toEngineMsg :: B.ByteString -> B.ByteString
@@ -20,19 +28,130 @@
         removeLength _ = Nothing
 
 
-checkNetCmd :: B.ByteString -> (Bool, Bool)
+splitMessages :: B.ByteString -> [B.ByteString]
+splitMessages = L.unfoldr (\b -> if B.null b then Nothing else Just $ B.splitAt (1 + fromIntegral (BW.head b)) b)
+
+
+checkNetCmd :: B.ByteString -> (B.ByteString, B.ByteString)
 checkNetCmd msg = check decoded
     where
-        decoded = fromEngineMsg msg
-        check Nothing = (False, False)
-        check (Just ms) | B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+')
-                        | otherwise        = (False, False)
+        decoded = liftM (splitMessages . BW.pack) $ Base64.decode $ B.unpack msg
+        check Nothing = (B.empty, B.empty)
+        check (Just msgs) = let (a, b) = (filter isLegal msgs, filter isNonEmpty a) in (encode a, encode b)
+        encode = B.pack . Base64.encode . BW.unpack . B.concat
+        isLegal m = (B.length m > 1) && (flip Set.member legalMessages . B.head . B.tail $ m)
+        isNonEmpty = (/=) '+' . B.head . B.tail
         legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
 
 
-gameInfo2Replay :: GameInfo -> B.ByteString
-gameInfo2Replay GameInfo{roundMsgs = rm,
-        teamsAtStart = teams,
-        giMapParams = params1,
-        giParams = params2} = undefined
+replayToDemo :: [TeamInfo]
+        -> Map.Map B.ByteString B.ByteString
+        -> Map.Map B.ByteString [B.ByteString]
+        -> [B.ByteString]
+        -> [B.ByteString]
+replayToDemo teams mapParams params msgs = concat [
+        [em "TD"]
+        , maybeScript
+        , maybeMap
+        , [eml ["etheme ", head $ params Map.! "THEME"]]
+        , [eml ["eseed ", mapParams Map.! "SEED"]]
+        , [eml ["e$gmflags ", showB gameFlags]]
+        , schemeFlags
+        , [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]]
+        , [eml ["e$mapgen ", mapgen]]
+        , mapgenSpecific
+        , concatMap teamSetup teams
+        , msgs
+        , [em "!"]
+        ]
+    where
+        em = toEngineMsg
+        eml = em . B.concat
+        mapGenTypes = ["+rnd+", "+maze+", "+drawn+"]
+        maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
+        maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
+        scheme = tail $ params Map.! "SCHEME"
+        mapgen = mapParams Map.! "MAPGEN"
+        mapgenSpecific = case mapgen of
+            "+maze+" -> [eml ["e$maze_size ", head $ params Map.! "MAZE_SIZE"]]
+            "+drawn" -> drawnMapData . head $ params Map.! "DRAWNMAP"
+            _ -> []
+        gameFlags :: Word32
+        gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .|. f) 0 $ zip scheme gameFlagConsts
+        schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m])
+            $ filter (\(_, (n, _)) -> not $ B.null n)
+            $ zip (drop (length gameFlagConsts) scheme) schemeParams
+        ammoStr :: B.ByteString
+        ammoStr = head . tail $ params Map.! "AMMO"
+        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
+                   (map (\(x, y) -> eml [x, " ", y]) $ zip ["eammloadt", "eammprob", "eammdelay", "eammreinf"] [a, b, c, d])
+                   ++ [em "eammstore" | scheme !! 14 == "true" || scheme !! 20 == "false"]
+        initHealth = scheme !! 27
+        teamSetup :: TeamInfo -> [B.ByteString]
+        teamSetup t = (++) ammo $
+                eml ["eaddteam <hash> ", showB $ (1 + (readInt_ $ teamcolor t) :: Int) * 2113696, " ", teamname t]
+                : em "erdriven"
+                : eml ["efort ", teamfort t]
+                : take (2 * hhnum t) (
+                    concatMap (\(HedgehogInfo hname hhat) -> [
+                            eml ["eaddhh ", showB $ difficulty t, " ", initHealth, " ", hname]
+                            , eml ["ehat ", hhat]
+                            ])
+                        $ hedgehogs t
+                        )
+
+drawnMapData :: B.ByteString -> [B.ByteString]
+drawnMapData = error "drawnMapData"
+
+schemeParams :: [(B.ByteString, Int)]
+schemeParams = [
+      ("e$damagepct", 1)
+    , ("e$turntime", 1000)
+    , ("", 0)
+    , ("e$sd_turns", 1)
+    , ("e$casefreq", 1)
+    , ("e$minestime", 1000)
+    , ("e$minesnum", 1)
+    , ("e$minedudpct", 1)
+    , ("e$explosives", 1)
+    , ("e$healthprob", 1)
+    , ("e$hcaseamount", 1)
+    , ("e$waterrise", 1)
+    , ("e$healthdec", 1)
+    , ("e$ropepct", 1)
+    , ("e$getawaytime", 1)
+    ]
+
+
+gameFlagConsts :: [Word32]
+gameFlagConsts = [
+          0x00001000
+        , 0x00000010
+        , 0x00000004
+        , 0x00000008
+        , 0x00000020
+        , 0x00000040
+        , 0x00000080
+        , 0x00000100
+        , 0x00000200
+        , 0x00000400
+        , 0x00000800
+        , 0x00002000
+        , 0x00004000
+        , 0x00008000
+        , 0x00010000
+        , 0x00020000
+        , 0x00040000
+        , 0x00080000
+        , 0x00100000
+        , 0x00200000
+        , 0x00400000
+        , 0x00800000
+        , 0x01000000
+        , 0x02000000
+        , 0x04000000
+        ]
+
+
+