This commit changes many aspect of our cmake build system
- shared libraries are compiled by default:
* this modifies RPATH of unix executables;
* this will prevent a lot of linking issues, esp. from pascal world;
* the old behaviour (static libs) is still available with -DBUILD_SHARED_LIBS=off;
* of course in this case you have to provide the full list of dependencies with FPFLAGS and CMAKE_C_FLAGS;
- pascal is now fully integrated with cmake, meaning you can just do add_sources and use CMAKE_Pascal_FLAGS:
* some of the language features are only partially implemented, for example .inc files will not get rebuilt if you modify them;
* target_link_libraries for pascal targets is just dummy as linking is determined within pascal files;
* universal builds for osx are not available any more;
- bundled libraries and system libraries are addressed using the target name:
* this avoids depedency tracking;
* this allows to name output as we wish.
{-# LANGUAGE OverloadedStrings #-}
module EngineInteraction where
import qualified Data.Set as Set
import Control.Monad
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
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
where
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
removeLength _ = Nothing
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 = 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"
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
]