diff --git a/HLint.hs b/HLint.hs --- a/HLint.hs +++ b/HLint.hs @@ -1,10 +1,12 @@ -module HLint - ( - ) where +module HLint where import "hint" HLint.Default import "hint" HLint.Dollar +ignore "Eta reduce" + ignore "Use &&&" ignore "Use <|>" + +ignore "Use uncurry" diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,7 +1,3 @@ -module Main - ( main - ) where - import qualified Distribution.Simple main :: IO () diff --git a/executable/Main.hs b/executable/Main.hs --- a/executable/Main.hs +++ b/executable/Main.hs @@ -1,129 +1,5 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - module Main - ( main + ( module Rattletrap ) where -import Rattletrap - -import qualified Control.Monad as Monad -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Casing as Casing -import qualified Data.Aeson.TH as Aeson -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Version as Version -import qualified Language.Haskell.TH as TH -import qualified System.Environment as Environment - -main :: IO () -main = do - args <- Environment.getArgs - mainWithArgs args - -mainWithArgs :: [String] -> IO () -mainWithArgs args = - case args of - ["version"] -> putStrLn (Version.showVersion version) - "decode":files -> do - (getInput, putOutput) <- getIO files - input <- getInput - let replay = Binary.runGet getReplay input - let output = Aeson.encode replay - putOutput output - "encode":files -> do - (getInput, putOutput) <- getIO files - input <- getInput - case Aeson.eitherDecode input of - Left message -> fail ("could not parse JSON: " ++ message) - Right replay -> do - let output = Binary.runPut (putReplay replay) - putOutput output - _ -> fail ("unexpected arguments " ++ show args) - -getIO - :: Monad m - => [FilePath] -> m (IO ByteString.ByteString, ByteString.ByteString -> IO ()) -getIO files = - case files of - [] -> pure (ByteString.getContents, ByteString.putStr) - [i] -> pure (ByteString.readFile i, ByteString.putStr) - [i, o] -> pure (ByteString.readFile i, ByteString.writeFile o) - _ -> fail ("unexpected arguments " ++ show files) - -$(let optionsFor name = - (Casing.aesonDrop (length (TH.nameBase name)) Casing.snakeCase) - { Aeson.constructorTagModifier = Casing.snakeCase - , Aeson.omitNothingFields = True - , Aeson.sumEncoding = Aeson.ObjectWithSingleField - , Aeson.unwrapUnaryRecords = True - } - deriveJSON declarations name = do - newDeclarations <- Aeson.deriveJSON (optionsFor name) name - pure (newDeclarations ++ declarations) - names = - [ ''Attribute - , ''AttributeMapping - , ''AttributeValue - , ''BooleanAttributeValue - , ''ByteAttributeValue - , ''Cache - , ''CamSettingsAttributeValue - , ''ClassMapping - , ''ClubColorsAttributeValue - , ''CompressedWord - , ''CompressedWordVector - , ''Content - , ''DemolishAttributeValue - , ''DestroyedReplicationValue - , ''Dictionary - , ''EnumAttributeValue - , ''ExplosionAttributeValue - , ''FlaggedIntAttributeValue - , ''Float32 - , ''FloatAttributeValue - , ''Frame - , ''GameModeAttributeValue - , ''Header - , ''Initialization - , ''Int32 - , ''Int8 - , ''Int8Vector - , ''IntAttributeValue - , ''KeyFrame - , ''List - , ''LoadoutAttributeValue - , ''LoadoutOnlineAttributeValue - , ''LoadoutsAttributeValue - , ''LoadoutsOnlineAttributeValue - , ''LocationAttributeValue - , ''Mark - , ''Message - , ''MusicStingerAttributeValue - , ''PartyLeaderAttributeValue - , ''PickupAttributeValue - , ''PrivateMatchSettingsAttributeValue - , ''Property - , ''PropertyValue - , ''QWordAttributeValue - , ''RemoteId - , ''Replay - , ''Replication - , ''ReplicationValue - , ''ReservationAttributeValue - , ''RigidBodyStateAttributeValue - , ''SpawnedReplicationValue - , ''StringAttributeValue - , ''TeamPaintAttributeValue - , ''Text - , ''UniqueIdAttributeValue - , ''UpdatedReplicationValue - , ''Vector - , ''WeldedInfoAttributeValue - , ''Word32 - , ''Word64 - , ''Word8 - ] - in Monad.foldM deriveJSON [] names) +import Rattletrap (main) diff --git a/library/Rattletrap.hs b/library/Rattletrap.hs --- a/library/Rattletrap.hs +++ b/library/Rattletrap.hs @@ -2,78 +2,57 @@ ( module Rattletrap.ActorMap , module Rattletrap.Attribute , module Rattletrap.AttributeMapping + , module Rattletrap.AttributeType , module Rattletrap.AttributeValue - , module Rattletrap.AttributeValueType , module Rattletrap.Cache , module Rattletrap.ClassAttributeMap , module Rattletrap.ClassMapping - , module Rattletrap.CompressedWord - , module Rattletrap.CompressedWordVector , module Rattletrap.Content , module Rattletrap.Crc , module Rattletrap.Data - , module Rattletrap.Dictionary - , module Rattletrap.Float32 , module Rattletrap.Frame , module Rattletrap.Header , module Rattletrap.Initialization - , module Rattletrap.Int32 - , module Rattletrap.Int8 - , module Rattletrap.Int8Vector , module Rattletrap.KeyFrame - , module Rattletrap.List + , module Rattletrap.Main , module Rattletrap.Mark , module Rattletrap.Message + , module Rattletrap.Primitive , module Rattletrap.Property , module Rattletrap.PropertyValue , module Rattletrap.RemoteId , module Rattletrap.Replay , module Rattletrap.Replication , module Rattletrap.ReplicationValue - , module Rattletrap.Text , module Rattletrap.Utility - , module Rattletrap.Vector , module Rattletrap.Version - , module Rattletrap.Word32 - , module Rattletrap.Word64 - , module Rattletrap.Word8 ) where import Rattletrap.ActorMap import Rattletrap.Attribute import Rattletrap.AttributeMapping +import Rattletrap.AttributeType import Rattletrap.AttributeValue -import Rattletrap.AttributeValueType import Rattletrap.Cache import Rattletrap.ClassAttributeMap import Rattletrap.ClassMapping -import Rattletrap.CompressedWord -import Rattletrap.CompressedWordVector import Rattletrap.Content import Rattletrap.Crc import Rattletrap.Data -import Rattletrap.Dictionary -import Rattletrap.Float32 import Rattletrap.Frame import Rattletrap.Header import Rattletrap.Initialization -import Rattletrap.Int32 -import Rattletrap.Int8 -import Rattletrap.Int8Vector +import Rattletrap.Json () import Rattletrap.KeyFrame -import Rattletrap.List +import Rattletrap.Main import Rattletrap.Mark import Rattletrap.Message +import Rattletrap.Primitive import Rattletrap.Property import Rattletrap.PropertyValue import Rattletrap.RemoteId import Rattletrap.Replay import Rattletrap.Replication import Rattletrap.ReplicationValue -import Rattletrap.Text import Rattletrap.Utility -import Rattletrap.Vector import Rattletrap.Version -import Rattletrap.Word32 -import Rattletrap.Word64 -import Rattletrap.Word8 diff --git a/library/Rattletrap/ActorMap.hs b/library/Rattletrap/ActorMap.hs --- a/library/Rattletrap/ActorMap.hs +++ b/library/Rattletrap/ActorMap.hs @@ -1,7 +1,6 @@ module Rattletrap.ActorMap where -import Rattletrap.CompressedWord -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Map as Map @@ -11,4 +10,4 @@ makeActorMap = Map.empty updateActorMap :: CompressedWord -> Word32 -> ActorMap -> ActorMap -updateActorMap = Map.insert +updateActorMap actorId objectId actorMap = Map.insert actorId objectId actorMap diff --git a/library/Rattletrap/Attribute.hs b/library/Rattletrap/Attribute.hs --- a/library/Rattletrap/Attribute.hs +++ b/library/Rattletrap/Attribute.hs @@ -3,7 +3,7 @@ import Rattletrap.ActorMap import Rattletrap.AttributeValue import Rattletrap.ClassAttributeMap -import Rattletrap.CompressedWord +import Rattletrap.Primitive import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit @@ -48,7 +48,7 @@ Nothing -> fail ("could not get attribute name for " ++ show id_) Just name -> do value <- getAttributeValue version name - pure Attribute {attributeId = id_, attributeValue = value} + pure (Attribute id_ value) putAttribute :: Attribute -> BinaryBit.BitPut () putAttribute attribute = do diff --git a/library/Rattletrap/Attribute/Boolean.hs b/library/Rattletrap/Attribute/Boolean.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Boolean.hs @@ -0,0 +1,17 @@ +module Rattletrap.Attribute.Boolean where + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype BooleanAttribute = BooleanAttribute + { booleanAttributeValue :: Bool + } deriving (Eq, Ord, Show) + +getBooleanAttribute :: BinaryBit.BitGet BooleanAttribute +getBooleanAttribute = do + value <- BinaryBit.getBool + pure (BooleanAttribute value) + +putBooleanAttribute :: BooleanAttribute -> BinaryBit.BitPut () +putBooleanAttribute booleanAttribute = + BinaryBit.putBool (booleanAttributeValue booleanAttribute) diff --git a/library/Rattletrap/Attribute/Byte.hs b/library/Rattletrap/Attribute/Byte.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Byte.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.Byte where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype ByteAttribute = ByteAttribute + { byteAttributeValue :: Word8 + } deriving (Eq, Ord, Show) + +getByteAttribute :: BinaryBit.BitGet ByteAttribute +getByteAttribute = do + value <- getWord8Bits + pure (ByteAttribute value) + +putByteAttribute :: ByteAttribute -> BinaryBit.BitPut () +putByteAttribute byteAttribute = + putWord8Bits (byteAttributeValue byteAttribute) diff --git a/library/Rattletrap/Attribute/CamSettings.hs b/library/Rattletrap/Attribute/CamSettings.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/CamSettings.hs @@ -0,0 +1,36 @@ +module Rattletrap.Attribute.CamSettings where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data CamSettingsAttribute = CamSettingsAttribute + { camSettingsAttributeFov :: Float32 + , camSettingsAttributeHeight :: Float32 + , camSettingsAttributeAngle :: Float32 + , camSettingsAttributeDistance :: Float32 + , camSettingsAttributeStiffness :: Float32 + , camSettingsAttributeSwivelSpeed :: Float32 + } deriving (Eq, Ord, Show) + +getCamSettingsAttribute :: BinaryBit.BitGet CamSettingsAttribute +getCamSettingsAttribute = do + fov <- getFloat32Bits + height <- getFloat32Bits + angle <- getFloat32Bits + distance <- getFloat32Bits + stiffness <- getFloat32Bits + swivelSpeed <- getFloat32Bits + pure + (CamSettingsAttribute fov height angle distance stiffness swivelSpeed) + +putCamSettingsAttribute :: CamSettingsAttribute -> BinaryBit.BitPut () +putCamSettingsAttribute camSettingsAttribute = do + putFloat32Bits (camSettingsAttributeFov camSettingsAttribute) + putFloat32Bits (camSettingsAttributeHeight camSettingsAttribute) + putFloat32Bits (camSettingsAttributeAngle camSettingsAttribute) + putFloat32Bits (camSettingsAttributeDistance camSettingsAttribute) + putFloat32Bits (camSettingsAttributeStiffness camSettingsAttribute) + putFloat32Bits + (camSettingsAttributeSwivelSpeed camSettingsAttribute) diff --git a/library/Rattletrap/Attribute/ClubColors.hs b/library/Rattletrap/Attribute/ClubColors.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/ClubColors.hs @@ -0,0 +1,29 @@ +module Rattletrap.Attribute.ClubColors where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data ClubColorsAttribute = ClubColorsAttribute + { clubColorsAttributeBlueFlag :: Bool + , clubColorsAttributeBlueColor :: Word8 + , clubColorsAttributeOrangeFlag :: Bool + , clubColorsAttributeOrangeColor :: Word8 + } deriving (Eq, Ord, Show) + +getClubColorsAttribute :: BinaryBit.BitGet ClubColorsAttribute +getClubColorsAttribute = do + blueFlag <- BinaryBit.getBool + blueColor <- getWord8Bits + orangeFlag <- BinaryBit.getBool + orangeColor <- getWord8Bits + pure (ClubColorsAttribute blueFlag blueColor orangeFlag orangeColor) + +putClubColorsAttribute :: ClubColorsAttribute -> BinaryBit.BitPut () +putClubColorsAttribute clubColorsAttribute = do + BinaryBit.putBool (clubColorsAttributeBlueFlag clubColorsAttribute) + putWord8Bits (clubColorsAttributeBlueColor clubColorsAttribute) + BinaryBit.putBool + (clubColorsAttributeOrangeFlag clubColorsAttribute) + putWord8Bits (clubColorsAttributeOrangeColor clubColorsAttribute) diff --git a/library/Rattletrap/Attribute/Demolish.hs b/library/Rattletrap/Attribute/Demolish.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Demolish.hs @@ -0,0 +1,41 @@ +module Rattletrap.Attribute.Demolish where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data DemolishAttribute = DemolishAttribute + { demolishAttributeAttackerFlag :: Bool + , demolishAttributeAttackerActorId :: Word32 + , demolishAttributeVictimFlag :: Bool + , demolishAttributeVictimActorId :: Word32 + , demolishAttributeAttackerVelocity :: Vector + , demolishAttributeVictimVelocity :: Vector + } deriving (Eq, Ord, Show) + +getDemolishAttribute :: BinaryBit.BitGet DemolishAttribute +getDemolishAttribute = do + attackerFlag <- BinaryBit.getBool + attackerActorId <- getWord32Bits + victimFlag <- BinaryBit.getBool + victimActorId <- getWord32Bits + attackerVelocity <- getVector + victimVelocity <- getVector + pure + (DemolishAttribute + attackerFlag + attackerActorId + victimFlag + victimActorId + attackerVelocity + victimVelocity) + +putDemolishAttribute :: DemolishAttribute -> BinaryBit.BitPut () +putDemolishAttribute demolishAttribute = do + BinaryBit.putBool (demolishAttributeAttackerFlag demolishAttribute) + putWord32Bits (demolishAttributeAttackerActorId demolishAttribute) + BinaryBit.putBool (demolishAttributeVictimFlag demolishAttribute) + putWord32Bits (demolishAttributeVictimActorId demolishAttribute) + putVector (demolishAttributeAttackerVelocity demolishAttribute) + putVector (demolishAttributeVictimVelocity demolishAttribute) diff --git a/library/Rattletrap/Attribute/Enum.hs b/library/Rattletrap/Attribute/Enum.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Enum.hs @@ -0,0 +1,18 @@ +module Rattletrap.Attribute.Enum where + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Word as Word + +newtype EnumAttribute = EnumAttribute + { enumAttributeValue :: Word.Word16 + } deriving (Eq, Ord, Show) + +getEnumAttribute :: BinaryBit.BitGet EnumAttribute +getEnumAttribute = do + value <- BinaryBit.getWord16be 11 + pure (EnumAttribute value) + +putEnumAttribute :: EnumAttribute -> BinaryBit.BitPut () +putEnumAttribute enumAttribute = + BinaryBit.putWord16be 11 (enumAttributeValue enumAttribute) diff --git a/library/Rattletrap/Attribute/Explosion.hs b/library/Rattletrap/Attribute/Explosion.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Explosion.hs @@ -0,0 +1,24 @@ +module Rattletrap.Attribute.Explosion where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data ExplosionAttribute = ExplosionAttribute + { explosionAttributeActorId :: Int32 + , explosionAttributeLocation :: Vector + } deriving (Eq, Ord, Show) + +getExplosionAttribute :: BinaryBit.BitGet ExplosionAttribute +getExplosionAttribute = do + False <- BinaryBit.getBool + actorId <- getInt32Bits + location <- getVector + pure (ExplosionAttribute actorId location) + +putExplosionAttribute :: ExplosionAttribute -> BinaryBit.BitPut () +putExplosionAttribute explosionAttribute = do + BinaryBit.putBool False + putInt32Bits (explosionAttributeActorId explosionAttribute) + putVector (explosionAttributeLocation explosionAttribute) diff --git a/library/Rattletrap/Attribute/FlaggedInt.hs b/library/Rattletrap/Attribute/FlaggedInt.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/FlaggedInt.hs @@ -0,0 +1,22 @@ +module Rattletrap.Attribute.FlaggedInt where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data FlaggedIntAttribute = FlaggedIntAttribute + { flaggedIntAttributeFlag :: Bool + , flaggedIntAttributeInt :: Int32 + } deriving (Eq, Ord, Show) + +getFlaggedIntAttribute :: BinaryBit.BitGet FlaggedIntAttribute +getFlaggedIntAttribute = do + flag <- BinaryBit.getBool + int <- getInt32Bits + pure (FlaggedIntAttribute flag int) + +putFlaggedIntAttribute :: FlaggedIntAttribute -> BinaryBit.BitPut () +putFlaggedIntAttribute flaggedIntAttribute = do + BinaryBit.putBool (flaggedIntAttributeFlag flaggedIntAttribute) + putInt32Bits (flaggedIntAttributeInt flaggedIntAttribute) diff --git a/library/Rattletrap/Attribute/Float.hs b/library/Rattletrap/Attribute/Float.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Float.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.Float where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype FloatAttribute = FloatAttribute + { floatAttributeValue :: Float32 + } deriving (Eq, Ord, Show) + +getFloatAttribute :: BinaryBit.BitGet FloatAttribute +getFloatAttribute = do + value <- getFloat32Bits + pure (FloatAttribute value) + +putFloatAttribute :: FloatAttribute -> BinaryBit.BitPut () +putFloatAttribute floatAttribute = + putFloat32Bits (floatAttributeValue floatAttribute) diff --git a/library/Rattletrap/Attribute/GameMode.hs b/library/Rattletrap/Attribute/GameMode.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/GameMode.hs @@ -0,0 +1,26 @@ +module Rattletrap.Attribute.GameMode where + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Word as Word + +data GameModeAttribute = GameModeAttribute + { gameModeAttributeNumBits :: Int + , gameModeAttributeWord :: Word.Word8 + } deriving (Eq, Ord, Show) + +getGameModeAttribute :: (Int, Int) + -> BinaryBit.BitGet GameModeAttribute +getGameModeAttribute version = do + let numBits = + if version < (868, 12) + then 2 + else 8 + word <- BinaryBit.getWord8 numBits + pure (GameModeAttribute numBits word) + +putGameModeAttribute :: GameModeAttribute -> BinaryBit.BitPut () +putGameModeAttribute gameModeAttribute = do + let numBits = gameModeAttributeNumBits gameModeAttribute + let word = gameModeAttributeWord gameModeAttribute + BinaryBit.putWord8 numBits word diff --git a/library/Rattletrap/Attribute/Int.hs b/library/Rattletrap/Attribute/Int.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Int.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.Int where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype IntAttribute = IntAttribute + { intAttributeValue :: Int32 + } deriving (Eq, Ord, Show) + +getIntAttribute :: BinaryBit.BitGet IntAttribute +getIntAttribute = do + value <- getInt32Bits + pure (IntAttribute value) + +putIntAttribute :: IntAttribute -> BinaryBit.BitPut () +putIntAttribute intAttribute = + putInt32Bits (intAttributeValue intAttribute) diff --git a/library/Rattletrap/Attribute/Loadout.hs b/library/Rattletrap/Attribute/Loadout.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Loadout.hs @@ -0,0 +1,60 @@ +module Rattletrap.Attribute.Loadout where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data LoadoutAttribute = LoadoutAttribute + { loadoutAttributeVersion :: Word8 + , loadoutAttributeBody :: Word32 + , loadoutAttributeDecal :: Word32 + , loadoutAttributeWheels :: Word32 + , loadoutAttributeRocketTrail :: Word32 + , loadoutAttributeAntenna :: Word32 + , loadoutAttributeTopper :: Word32 + , loadoutAttributeUnknown1 :: Word32 + , loadoutAttributeUnknown2 :: Maybe Word32 + } deriving (Eq, Ord, Show) + +getLoadoutAttribute :: BinaryBit.BitGet LoadoutAttribute +getLoadoutAttribute = do + version <- getWord8Bits + body <- getWord32Bits + decal <- getWord32Bits + wheels <- getWord32Bits + rocketTrail <- getWord32Bits + antenna <- getWord32Bits + topper <- getWord32Bits + g <- getWord32Bits + h <- + if version > Word8 10 + then do + h <- getWord32Bits + pure (Just h) + else pure Nothing + pure + (LoadoutAttribute + version + body + decal + wheels + rocketTrail + antenna + topper + g + h) + +putLoadoutAttribute :: LoadoutAttribute -> BinaryBit.BitPut () +putLoadoutAttribute loadoutAttribute = do + putWord8Bits (loadoutAttributeVersion loadoutAttribute) + putWord32Bits (loadoutAttributeBody loadoutAttribute) + putWord32Bits (loadoutAttributeDecal loadoutAttribute) + putWord32Bits (loadoutAttributeWheels loadoutAttribute) + putWord32Bits (loadoutAttributeRocketTrail loadoutAttribute) + putWord32Bits (loadoutAttributeAntenna loadoutAttribute) + putWord32Bits (loadoutAttributeTopper loadoutAttribute) + putWord32Bits (loadoutAttributeUnknown1 loadoutAttribute) + case loadoutAttributeUnknown2 loadoutAttribute of + Nothing -> pure () + Just x -> putWord32Bits x diff --git a/library/Rattletrap/Attribute/LoadoutOnline.hs b/library/Rattletrap/Attribute/LoadoutOnline.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/LoadoutOnline.hs @@ -0,0 +1,39 @@ +module Rattletrap.Attribute.LoadoutOnline where + +import Rattletrap.Primitive + +import qualified Control.Monad as Monad +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype LoadoutOnlineAttribute = LoadoutOnlineAttribute + { loadoutAttributeValue :: [[(Word32, CompressedWord)]] + } deriving (Eq, Ord, Show) + +getLoadoutOnlineAttribute :: BinaryBit.BitGet LoadoutOnlineAttribute +getLoadoutOnlineAttribute = do + size <- getWord8Bits + values <- + Monad.replicateM + (fromIntegral (word8Value size)) + (do innerSize <- getWord8Bits + Monad.replicateM + (fromIntegral (word8Value innerSize)) + (do x <- getWord32Bits + y <- getCompressedWord 27 + pure (x, y))) + pure (LoadoutOnlineAttribute values) + +putLoadoutOnlineAttribute :: LoadoutOnlineAttribute -> BinaryBit.BitPut () +putLoadoutOnlineAttribute loadoutAttribute = do + let values = loadoutAttributeValue loadoutAttribute + putWord8Bits (Word8 (fromIntegral (length values))) + mapM_ + (\xs -> do + putWord8Bits (Word8 (fromIntegral (length xs))) + mapM_ + (\(x, y) -> do + putWord32Bits x + putCompressedWord y) + xs) + values diff --git a/library/Rattletrap/Attribute/Loadouts.hs b/library/Rattletrap/Attribute/Loadouts.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Loadouts.hs @@ -0,0 +1,22 @@ +module Rattletrap.Attribute.Loadouts where + +import Rattletrap.Attribute.Loadout + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data LoadoutsAttribute = LoadoutsAttribute + { loadoutsAttributeBlue :: LoadoutAttribute + , loadoutsAttributeOrange :: LoadoutAttribute + } deriving (Eq, Ord, Show) + +getLoadoutsAttribute :: BinaryBit.BitGet LoadoutsAttribute +getLoadoutsAttribute = do + blue <- getLoadoutAttribute + orange <- getLoadoutAttribute + pure (LoadoutsAttribute blue orange) + +putLoadoutsAttribute :: LoadoutsAttribute -> BinaryBit.BitPut () +putLoadoutsAttribute loadoutsAttribute = do + putLoadoutAttribute (loadoutsAttributeBlue loadoutsAttribute) + putLoadoutAttribute (loadoutsAttributeOrange loadoutsAttribute) diff --git a/library/Rattletrap/Attribute/LoadoutsOnline.hs b/library/Rattletrap/Attribute/LoadoutsOnline.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/LoadoutsOnline.hs @@ -0,0 +1,34 @@ +module Rattletrap.Attribute.LoadoutsOnline where + +import Rattletrap.Attribute.LoadoutOnline + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data LoadoutsOnlineAttribute = LoadoutsOnlineAttribute + { loadoutsOnlineAttributeBlue :: LoadoutOnlineAttribute + , loadoutsOnlineAttributeOrange :: LoadoutOnlineAttribute + , loadoutsOnlineAttributeUnknown1 :: Bool + , loadoutsOnlineAttributeUnknown2 :: Bool + } deriving (Eq, Ord, Show) + +getLoadoutsOnlineAttribute :: BinaryBit.BitGet LoadoutsOnlineAttribute +getLoadoutsOnlineAttribute = do + blueLoadout <- getLoadoutOnlineAttribute + orangeLoadout <- getLoadoutOnlineAttribute + unknown1 <- BinaryBit.getBool + unknown2 <- BinaryBit.getBool + pure + (LoadoutsOnlineAttribute blueLoadout orangeLoadout unknown1 unknown2) + +putLoadoutsOnlineAttribute :: LoadoutsOnlineAttribute + -> BinaryBit.BitPut () +putLoadoutsOnlineAttribute loadoutsOnlineAttribute = do + putLoadoutOnlineAttribute + (loadoutsOnlineAttributeBlue loadoutsOnlineAttribute) + putLoadoutOnlineAttribute + (loadoutsOnlineAttributeOrange loadoutsOnlineAttribute) + BinaryBit.putBool + (loadoutsOnlineAttributeUnknown1 loadoutsOnlineAttribute) + BinaryBit.putBool + (loadoutsOnlineAttributeUnknown2 loadoutsOnlineAttribute) diff --git a/library/Rattletrap/Attribute/Location.hs b/library/Rattletrap/Attribute/Location.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Location.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.Location where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype LocationAttribute = LocationAttribute + { locationAttributeValue :: Vector + } deriving (Eq, Ord, Show) + +getLocationAttribute :: BinaryBit.BitGet LocationAttribute +getLocationAttribute = do + value <- getVector + pure (LocationAttribute value) + +putLocationAttribute :: LocationAttribute -> BinaryBit.BitPut () +putLocationAttribute locationAttribute = + putVector (locationAttributeValue locationAttribute) diff --git a/library/Rattletrap/Attribute/MusicStinger.hs b/library/Rattletrap/Attribute/MusicStinger.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/MusicStinger.hs @@ -0,0 +1,26 @@ +module Rattletrap.Attribute.MusicStinger where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data MusicStingerAttribute = MusicStingerAttribute + { musicStingerAttributeFlag :: Bool + , musicStingerAttributeCue :: Word32 + , musicStingerAttributeTrigger :: Word8 + } deriving (Eq, Ord, Show) + +getMusicStingerAttribute :: BinaryBit.BitGet MusicStingerAttribute +getMusicStingerAttribute = do + flag <- BinaryBit.getBool + cue <- getWord32Bits + trigger <- getWord8Bits + pure (MusicStingerAttribute flag cue trigger) + +putMusicStingerAttribute :: MusicStingerAttribute + -> BinaryBit.BitPut () +putMusicStingerAttribute musicStingerAttribute = do + BinaryBit.putBool (musicStingerAttributeFlag musicStingerAttribute) + putWord32Bits (musicStingerAttributeCue musicStingerAttribute) + putWord8Bits (musicStingerAttributeTrigger musicStingerAttribute) diff --git a/library/Rattletrap/Attribute/PartyLeader.hs b/library/Rattletrap/Attribute/PartyLeader.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/PartyLeader.hs @@ -0,0 +1,33 @@ +module Rattletrap.Attribute.PartyLeader where + +import Rattletrap.Primitive +import Rattletrap.RemoteId + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data PartyLeaderAttribute = PartyLeaderAttribute + { partyLeaderAttributeSystemId :: Word8 + , partyLeaderAttributeId :: Maybe (RemoteId, Word8) + } deriving (Eq, Ord, Show) + +getPartyLeaderAttribute :: BinaryBit.BitGet PartyLeaderAttribute +getPartyLeaderAttribute = do + systemId <- getWord8Bits + maybeRemoteAndLocalId <- + if systemId == Word8 0 + then pure Nothing + else do + remoteId <- getRemoteId systemId + localId <- getWord8Bits + pure (Just (remoteId, localId)) + pure (PartyLeaderAttribute systemId maybeRemoteAndLocalId) + +putPartyLeaderAttribute :: PartyLeaderAttribute -> BinaryBit.BitPut () +putPartyLeaderAttribute partyLeaderAttribute = do + putWord8Bits (partyLeaderAttributeSystemId partyLeaderAttribute) + case partyLeaderAttributeId partyLeaderAttribute of + Nothing -> pure () + Just (remoteId, localId) -> do + putRemoteId remoteId + putWord8Bits localId diff --git a/library/Rattletrap/Attribute/Pickup.hs b/library/Rattletrap/Attribute/Pickup.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Pickup.hs @@ -0,0 +1,32 @@ +module Rattletrap.Attribute.Pickup where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data PickupAttribute = PickupAttribute + { pickupAttributeInstigatorId :: Maybe Word32 + , pickupAttributePickedUp :: Bool + } deriving (Eq, Ord, Show) + +getPickupAttribute :: BinaryBit.BitGet PickupAttribute +getPickupAttribute = do + instigator <- BinaryBit.getBool + maybeInstigatorId <- + if instigator + then do + instigatorId <- getWord32Bits + pure (Just instigatorId) + else pure Nothing + pickedUp <- BinaryBit.getBool + pure (PickupAttribute maybeInstigatorId pickedUp) + +putPickupAttribute :: PickupAttribute -> BinaryBit.BitPut () +putPickupAttribute pickupAttribute = do + case pickupAttributeInstigatorId pickupAttribute of + Nothing -> BinaryBit.putBool False + Just instigatorId -> do + BinaryBit.putBool True + putWord32Bits instigatorId + BinaryBit.putBool (pickupAttributePickedUp pickupAttribute) diff --git a/library/Rattletrap/Attribute/PrivateMatchSettings.hs b/library/Rattletrap/Attribute/PrivateMatchSettings.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/PrivateMatchSettings.hs @@ -0,0 +1,53 @@ +module Rattletrap.Attribute.PrivateMatchSettings where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data PrivateMatchSettingsAttribute = PrivateMatchSettingsAttribute + { privateMatchSettingsAttributeMutators :: Text + , privateMatchSettingsAttributeJoinableBy :: Word32 + , privateMatchSettingsAttributeMaxPlayers :: Word32 + , privateMatchSettingsAttributeGameName :: Text + , privateMatchSettingsAttributePassword :: Text + , privateMatchSettingsAttributeFlag :: Bool + } deriving (Eq, Ord, Show) + +getPrivateMatchSettingsAttribute :: BinaryBit.BitGet PrivateMatchSettingsAttribute +getPrivateMatchSettingsAttribute = do + mutators <- getTextBits + joinableBy <- getWord32Bits + maxPlayers <- getWord32Bits + gameName <- getTextBits + password <- getTextBits + flag <- BinaryBit.getBool + pure + (PrivateMatchSettingsAttribute + mutators + joinableBy + maxPlayers + gameName + password + flag) + +putPrivateMatchSettingsAttribute :: PrivateMatchSettingsAttribute + -> BinaryBit.BitPut () +putPrivateMatchSettingsAttribute privateMatchSettingsAttribute = do + putTextBits + (privateMatchSettingsAttributeMutators + privateMatchSettingsAttribute) + putWord32Bits + (privateMatchSettingsAttributeJoinableBy + privateMatchSettingsAttribute) + putWord32Bits + (privateMatchSettingsAttributeMaxPlayers + privateMatchSettingsAttribute) + putTextBits + (privateMatchSettingsAttributeGameName + privateMatchSettingsAttribute) + putTextBits + (privateMatchSettingsAttributePassword + privateMatchSettingsAttribute) + BinaryBit.putBool + (privateMatchSettingsAttributeFlag privateMatchSettingsAttribute) diff --git a/library/Rattletrap/Attribute/QWord.hs b/library/Rattletrap/Attribute/QWord.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/QWord.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.QWord where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype QWordAttribute = QWordAttribute + { qWordAttributeValue :: Word64 + } deriving (Eq, Ord, Show) + +getQWordAttribute :: BinaryBit.BitGet QWordAttribute +getQWordAttribute = do + value <- getWord64Bits + pure (QWordAttribute value) + +putQWordAttribute :: QWordAttribute -> BinaryBit.BitPut () +putQWordAttribute qWordAttribute = + putWord64Bits (qWordAttributeValue qWordAttribute) diff --git a/library/Rattletrap/Attribute/Reservation.hs b/library/Rattletrap/Attribute/Reservation.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Reservation.hs @@ -0,0 +1,54 @@ +module Rattletrap.Attribute.Reservation where + +import Rattletrap.Attribute.UniqueId +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Word as Word + +data ReservationAttribute = ReservationAttribute + { reservationAttributeNumber :: CompressedWord + , reservationAttributeUniqueId :: UniqueIdAttribute + , reservationAttributeName :: Maybe Text + , reservationAttributeUnknown1 :: Bool + , reservationAttributeUnknown2 :: Bool + , reservationAttributeUnknown3 :: Maybe Word.Word8 + } deriving (Eq, Ord, Show) + +getReservationAttribute :: (Int, Int) + -> BinaryBit.BitGet ReservationAttribute +getReservationAttribute version = do + number <- getCompressedWord 7 + uniqueId <- getUniqueIdAttribute + name <- + if uniqueIdAttributeSystemId uniqueId == Word8 0 + then pure Nothing + else do + name <- getTextBits + pure (Just name) + a <- BinaryBit.getBool + b <- BinaryBit.getBool + mc <- + if version < (868, 12) + then pure Nothing + else do + c <- BinaryBit.getWord8 6 + pure (Just c) + pure (ReservationAttribute number uniqueId name a b mc) + +putReservationAttribute :: ReservationAttribute -> BinaryBit.BitPut () +putReservationAttribute reservationAttribute = do + putCompressedWord (reservationAttributeNumber reservationAttribute) + putUniqueIdAttribute + (reservationAttributeUniqueId reservationAttribute) + case reservationAttributeName reservationAttribute of + Nothing -> pure () + Just name -> putTextBits name + BinaryBit.putBool + (reservationAttributeUnknown1 reservationAttribute) + BinaryBit.putBool + (reservationAttributeUnknown2 reservationAttribute) + case reservationAttributeUnknown3 reservationAttribute of + Nothing -> pure () + Just c -> BinaryBit.putWord8 6 c diff --git a/library/Rattletrap/Attribute/RigidBodyState.hs b/library/Rattletrap/Attribute/RigidBodyState.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/RigidBodyState.hs @@ -0,0 +1,54 @@ +module Rattletrap.Attribute.RigidBodyState where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data RigidBodyStateAttribute = RigidBodyStateAttribute + { rigidBodyStateAttributeSleeping :: Bool + , rigidBodyStateAttributeLocation :: Vector + , rigidBodyStateAttributeRotation :: CompressedWordVector + , rigidBodyStateAttributeLinearVelocity :: Maybe Vector + , rigidBodyStateAttributeAngularVelocity :: Maybe Vector + } deriving (Eq, Ord, Show) + +getRigidBodyStateAttribute :: BinaryBit.BitGet RigidBodyStateAttribute +getRigidBodyStateAttribute = do + sleeping <- BinaryBit.getBool + location <- getVector + rotation <- getCompressedWordVector + linearVelocity <- + if sleeping + then pure Nothing + else do + linearVelocity <- getVector + pure (Just linearVelocity) + angularVelocity <- + if sleeping + then pure Nothing + else do + angularVelocity <- getVector + pure (Just angularVelocity) + pure + (RigidBodyStateAttribute + sleeping + location + rotation + linearVelocity + angularVelocity) + +putRigidBodyStateAttribute :: RigidBodyStateAttribute + -> BinaryBit.BitPut () +putRigidBodyStateAttribute rigidBodyStateAttribute = do + BinaryBit.putBool + (rigidBodyStateAttributeSleeping rigidBodyStateAttribute) + putVector (rigidBodyStateAttributeLocation rigidBodyStateAttribute) + putCompressedWordVector + (rigidBodyStateAttributeRotation rigidBodyStateAttribute) + case rigidBodyStateAttributeLinearVelocity rigidBodyStateAttribute of + Nothing -> pure () + Just linearVelocity -> putVector linearVelocity + case rigidBodyStateAttributeAngularVelocity rigidBodyStateAttribute of + Nothing -> pure () + Just angularVelocity -> putVector angularVelocity diff --git a/library/Rattletrap/Attribute/String.hs b/library/Rattletrap/Attribute/String.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/String.hs @@ -0,0 +1,19 @@ +module Rattletrap.Attribute.String where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype StringAttribute = StringAttribute + { stringAttributeValue :: Text + } deriving (Eq, Ord, Show) + +getStringAttribute :: BinaryBit.BitGet StringAttribute +getStringAttribute = do + value <- getTextBits + pure (StringAttribute value) + +putStringAttribute :: StringAttribute -> BinaryBit.BitPut () +putStringAttribute stringAttribute = + putTextBits (stringAttributeValue stringAttribute) diff --git a/library/Rattletrap/Attribute/TeamPaint.hs b/library/Rattletrap/Attribute/TeamPaint.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/TeamPaint.hs @@ -0,0 +1,37 @@ +module Rattletrap.Attribute.TeamPaint where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data TeamPaintAttribute = TeamPaintAttribute + { teamPaintAttributeTeam :: Word8 + , teamPaintAttributePrimaryColor :: Word8 + , teamPaintAttributeAccentColor :: Word8 + , teamPaintAttributePrimaryFinish :: Word32 + , teamPaintAttributeAccentFinish :: Word32 + } deriving (Eq, Ord, Show) + +getTeamPaintAttribute :: BinaryBit.BitGet TeamPaintAttribute +getTeamPaintAttribute = do + team <- getWord8Bits + primaryColor <- getWord8Bits + accentColor <- getWord8Bits + primaryFinish <- getWord32Bits + accentFinish <- getWord32Bits + pure + (TeamPaintAttribute + team + primaryColor + accentColor + primaryFinish + accentFinish) + +putTeamPaintAttribute :: TeamPaintAttribute -> BinaryBit.BitPut () +putTeamPaintAttribute teamPaintAttribute = do + putWord8Bits (teamPaintAttributeTeam teamPaintAttribute) + putWord8Bits (teamPaintAttributePrimaryColor teamPaintAttribute) + putWord8Bits (teamPaintAttributeAccentColor teamPaintAttribute) + putWord32Bits (teamPaintAttributePrimaryFinish teamPaintAttribute) + putWord32Bits (teamPaintAttributeAccentFinish teamPaintAttribute) diff --git a/library/Rattletrap/Attribute/UniqueId.hs b/library/Rattletrap/Attribute/UniqueId.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/UniqueId.hs @@ -0,0 +1,26 @@ +module Rattletrap.Attribute.UniqueId where + +import Rattletrap.Primitive +import Rattletrap.RemoteId + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data UniqueIdAttribute = UniqueIdAttribute + { uniqueIdAttributeSystemId :: Word8 + , uniqueIdAttributeRemoteId :: RemoteId + , uniqueIdAttributeLocalId :: Word8 + } deriving (Eq, Ord, Show) + +getUniqueIdAttribute :: BinaryBit.BitGet UniqueIdAttribute +getUniqueIdAttribute = do + systemId <- getWord8Bits + remoteId <- getRemoteId systemId + localId <- getWord8Bits + pure (UniqueIdAttribute systemId remoteId localId) + +putUniqueIdAttribute :: UniqueIdAttribute -> BinaryBit.BitPut () +putUniqueIdAttribute uniqueIdAttribute = do + putWord8Bits (uniqueIdAttributeSystemId uniqueIdAttribute) + putRemoteId (uniqueIdAttributeRemoteId uniqueIdAttribute) + putWord8Bits (uniqueIdAttributeLocalId uniqueIdAttribute) diff --git a/library/Rattletrap/Attribute/WeldedInfo.hs b/library/Rattletrap/Attribute/WeldedInfo.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/WeldedInfo.hs @@ -0,0 +1,31 @@ +module Rattletrap.Attribute.WeldedInfo where + +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data WeldedInfoAttribute = WeldedInfoAttribute + { weldedInfoAttributeActive :: Bool + , weldedInfoAttributeActorId :: Int32 + , weldedInfoAttributeOffset :: Vector + , weldedInfoAttributeMass :: Float32 + , weldedInfoAttributeRotation :: Int8Vector + } deriving (Eq, Ord, Show) + +getWeldedInfoAttribute :: BinaryBit.BitGet WeldedInfoAttribute +getWeldedInfoAttribute = do + active <- BinaryBit.getBool + actorId <- getInt32Bits + offset <- getVector + mass <- getFloat32Bits + rotation <- getInt8Vector + pure (WeldedInfoAttribute active actorId offset mass rotation) + +putWeldedInfoAttribute :: WeldedInfoAttribute -> BinaryBit.BitPut () +putWeldedInfoAttribute weldedInfoAttribute = do + BinaryBit.putBool (weldedInfoAttributeActive weldedInfoAttribute) + putInt32Bits (weldedInfoAttributeActorId weldedInfoAttribute) + putVector (weldedInfoAttributeOffset weldedInfoAttribute) + putFloat32Bits (weldedInfoAttributeMass weldedInfoAttribute) + putInt8Vector (weldedInfoAttributeRotation weldedInfoAttribute) diff --git a/library/Rattletrap/AttributeMapping.hs b/library/Rattletrap/AttributeMapping.hs --- a/library/Rattletrap/AttributeMapping.hs +++ b/library/Rattletrap/AttributeMapping.hs @@ -1,6 +1,6 @@ module Rattletrap.AttributeMapping where -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -13,9 +13,7 @@ getAttributeMapping = do objectId <- getWord32 streamId <- getWord32 - pure - AttributeMapping - {attributeMappingObjectId = objectId, attributeMappingStreamId = streamId} + pure (AttributeMapping objectId streamId) putAttributeMapping :: AttributeMapping -> Binary.Put putAttributeMapping attributeMapping = do diff --git a/library/Rattletrap/AttributeType.hs b/library/Rattletrap/AttributeType.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/AttributeType.hs @@ -0,0 +1,31 @@ +module Rattletrap.AttributeType where + +data AttributeType + = BooleanAttributeType + | ByteAttributeType + | CamSettingsAttributeType + | ClubColorsAttributeType + | DemolishAttributeType + | EnumAttributeType + | ExplosionAttributeType + | FlaggedIntAttributeType + | FloatAttributeType + | GameModeAttributeType + | IntAttributeType + | LoadoutAttributeType + | LoadoutOnlineAttributeType + | LoadoutsAttributeType + | LoadoutsOnlineAttributeType + | LocationAttributeType + | MusicStingerAttributeType + | PartyLeaderAttributeType + | PickupAttributeType + | PrivateMatchSettingsAttributeType + | QWordAttributeType + | ReservationAttributeType + | RigidBodyStateAttributeType + | StringAttributeType + | TeamPaintAttributeType + | UniqueIdAttributeType + | WeldedInfoAttributeType + deriving (Eq, Ord, Show) diff --git a/library/Rattletrap/AttributeValue.hs b/library/Rattletrap/AttributeValue.hs --- a/library/Rattletrap/AttributeValue.hs +++ b/library/Rattletrap/AttributeValue.hs @@ -1,218 +1,217 @@ module Rattletrap.AttributeValue ( module Rattletrap.AttributeValue - , module Rattletrap.AttributeValue.Boolean - , module Rattletrap.AttributeValue.Byte - , module Rattletrap.AttributeValue.CamSettings - , module Rattletrap.AttributeValue.ClubColors - , module Rattletrap.AttributeValue.Demolish - , module Rattletrap.AttributeValue.Enum - , module Rattletrap.AttributeValue.Explosion - , module Rattletrap.AttributeValue.FlaggedInt - , module Rattletrap.AttributeValue.Float - , module Rattletrap.AttributeValue.GameMode - , module Rattletrap.AttributeValue.Int - , module Rattletrap.AttributeValue.Loadout - , module Rattletrap.AttributeValue.LoadoutOnline - , module Rattletrap.AttributeValue.Loadouts - , module Rattletrap.AttributeValue.LoadoutsOnline - , module Rattletrap.AttributeValue.Location - , module Rattletrap.AttributeValue.MusicStinger - , module Rattletrap.AttributeValue.PartyLeader - , module Rattletrap.AttributeValue.Pickup - , module Rattletrap.AttributeValue.PrivateMatchSettings - , module Rattletrap.AttributeValue.QWord - , module Rattletrap.AttributeValue.Reservation - , module Rattletrap.AttributeValue.RigidBodyState - , module Rattletrap.AttributeValue.String - , module Rattletrap.AttributeValue.TeamPaint - , module Rattletrap.AttributeValue.UniqueId - , module Rattletrap.AttributeValue.WeldedInfo + , module Rattletrap.Attribute.Boolean + , module Rattletrap.Attribute.Byte + , module Rattletrap.Attribute.CamSettings + , module Rattletrap.Attribute.ClubColors + , module Rattletrap.Attribute.Demolish + , module Rattletrap.Attribute.Enum + , module Rattletrap.Attribute.Explosion + , module Rattletrap.Attribute.FlaggedInt + , module Rattletrap.Attribute.Float + , module Rattletrap.Attribute.GameMode + , module Rattletrap.Attribute.Int + , module Rattletrap.Attribute.Loadout + , module Rattletrap.Attribute.LoadoutOnline + , module Rattletrap.Attribute.Loadouts + , module Rattletrap.Attribute.LoadoutsOnline + , module Rattletrap.Attribute.Location + , module Rattletrap.Attribute.MusicStinger + , module Rattletrap.Attribute.PartyLeader + , module Rattletrap.Attribute.Pickup + , module Rattletrap.Attribute.PrivateMatchSettings + , module Rattletrap.Attribute.QWord + , module Rattletrap.Attribute.Reservation + , module Rattletrap.Attribute.RigidBodyState + , module Rattletrap.Attribute.String + , module Rattletrap.Attribute.TeamPaint + , module Rattletrap.Attribute.UniqueId + , module Rattletrap.Attribute.WeldedInfo ) where -import Rattletrap.AttributeValue.Boolean -import Rattletrap.AttributeValue.Byte -import Rattletrap.AttributeValue.CamSettings -import Rattletrap.AttributeValue.ClubColors -import Rattletrap.AttributeValue.Demolish -import Rattletrap.AttributeValue.Enum -import Rattletrap.AttributeValue.Explosion -import Rattletrap.AttributeValue.FlaggedInt -import Rattletrap.AttributeValue.Float -import Rattletrap.AttributeValue.GameMode -import Rattletrap.AttributeValue.Int -import Rattletrap.AttributeValue.Loadout -import Rattletrap.AttributeValue.LoadoutOnline -import Rattletrap.AttributeValue.Loadouts -import Rattletrap.AttributeValue.LoadoutsOnline -import Rattletrap.AttributeValue.Location -import Rattletrap.AttributeValue.MusicStinger -import Rattletrap.AttributeValue.PartyLeader -import Rattletrap.AttributeValue.Pickup -import Rattletrap.AttributeValue.PrivateMatchSettings -import Rattletrap.AttributeValue.QWord -import Rattletrap.AttributeValue.Reservation -import Rattletrap.AttributeValue.RigidBodyState -import Rattletrap.AttributeValue.String -import Rattletrap.AttributeValue.TeamPaint -import Rattletrap.AttributeValue.UniqueId -import Rattletrap.AttributeValue.WeldedInfo -import Rattletrap.AttributeValueType +import Rattletrap.Attribute.Boolean +import Rattletrap.Attribute.Byte +import Rattletrap.Attribute.CamSettings +import Rattletrap.Attribute.ClubColors +import Rattletrap.Attribute.Demolish +import Rattletrap.Attribute.Enum +import Rattletrap.Attribute.Explosion +import Rattletrap.Attribute.FlaggedInt +import Rattletrap.Attribute.Float +import Rattletrap.Attribute.GameMode +import Rattletrap.Attribute.Int +import Rattletrap.Attribute.Loadout +import Rattletrap.Attribute.LoadoutOnline +import Rattletrap.Attribute.Loadouts +import Rattletrap.Attribute.LoadoutsOnline +import Rattletrap.Attribute.Location +import Rattletrap.Attribute.MusicStinger +import Rattletrap.Attribute.PartyLeader +import Rattletrap.Attribute.Pickup +import Rattletrap.Attribute.PrivateMatchSettings +import Rattletrap.Attribute.QWord +import Rattletrap.Attribute.Reservation +import Rattletrap.Attribute.RigidBodyState +import Rattletrap.Attribute.String +import Rattletrap.Attribute.TeamPaint +import Rattletrap.Attribute.UniqueId +import Rattletrap.Attribute.WeldedInfo +import Rattletrap.AttributeType import Rattletrap.Data -import Rattletrap.Text +import Rattletrap.Primitive import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit import qualified Data.Map as Map data AttributeValue - = BooleanAttribute BooleanAttributeValue - | ByteAttribute ByteAttributeValue - | CamSettingsAttribute CamSettingsAttributeValue - | ClubColorsAttribute ClubColorsAttributeValue - | DemolishAttribute DemolishAttributeValue - | EnumAttribute EnumAttributeValue - | ExplosionAttribute ExplosionAttributeValue - | FlaggedIntAttribute FlaggedIntAttributeValue - | FloatAttribute FloatAttributeValue - | GameModeAttribute GameModeAttributeValue - | IntAttribute IntAttributeValue - | LoadoutAttribute LoadoutAttributeValue - | LoadoutOnlineAttribute LoadoutOnlineAttributeValue - | LoadoutsAttribute LoadoutsAttributeValue - | LoadoutsOnlineAttribute LoadoutsOnlineAttributeValue - | LocationAttribute LocationAttributeValue - | MusicStingerAttribute MusicStingerAttributeValue - | PartyLeaderAttribute PartyLeaderAttributeValue - | PickupAttribute PickupAttributeValue - | PrivateMatchSettingsAttribute PrivateMatchSettingsAttributeValue - | QWordAttribute QWordAttributeValue - | ReservationAttribute ReservationAttributeValue - | RigidBodyStateAttribute RigidBodyStateAttributeValue - | StringAttribute StringAttributeValue - | TeamPaintAttribute TeamPaintAttributeValue - | UniqueIdAttribute UniqueIdAttributeValue - | WeldedInfoAttribute WeldedInfoAttributeValue + = BooleanAttributeValue BooleanAttribute + | ByteAttributeValue ByteAttribute + | CamSettingsAttributeValue CamSettingsAttribute + | ClubColorsAttributeValue ClubColorsAttribute + | DemolishAttributeValue DemolishAttribute + | EnumAttributeValue EnumAttribute + | ExplosionAttributeValue ExplosionAttribute + | FlaggedIntAttributeValue FlaggedIntAttribute + | FloatAttributeValue FloatAttribute + | GameModeAttributeValue GameModeAttribute + | IntAttributeValue IntAttribute + | LoadoutAttributeValue LoadoutAttribute + | LoadoutOnlineAttributeValue LoadoutOnlineAttribute + | LoadoutsAttributeValue LoadoutsAttribute + | LoadoutsOnlineAttributeValue LoadoutsOnlineAttribute + | LocationAttributeValue LocationAttribute + | MusicStingerAttributeValue MusicStingerAttribute + | PartyLeaderAttributeValue PartyLeaderAttribute + | PickupAttributeValue PickupAttribute + | PrivateMatchSettingsAttributeValue PrivateMatchSettingsAttribute + | QWordAttributeValue QWordAttribute + | ReservationAttributeValue ReservationAttribute + | RigidBodyStateAttributeValue RigidBodyStateAttribute + | StringAttributeValue StringAttribute + | TeamPaintAttributeValue TeamPaintAttribute + | UniqueIdAttributeValue UniqueIdAttribute + | WeldedInfoAttributeValue WeldedInfoAttribute deriving (Eq, Ord, Show) getAttributeValue :: (Int, Int) -> Text -> BinaryBit.BitGet AttributeValue getAttributeValue version name = - case Map.lookup name attributeValueTypes of + case Map.lookup name attributeTypes of Just constructor -> case constructor of - AVBoolean -> do - x <- getBooleanAttributeValue - pure (BooleanAttribute x) - AVByte -> do - x <- getByteAttributeValue - pure (ByteAttribute x) - AVCamSettings -> do - x <- getCamSettingsAttributeValue - pure (CamSettingsAttribute x) - AVClubColors -> do - x <- getClubColorsAttributeValue - pure (ClubColorsAttribute x) - AVDemolish -> do - x <- getDemolishAttributeValue - pure (DemolishAttribute x) - AVEnum -> do - x <- getEnumAttributeValue - pure (EnumAttribute x) - AVExplosion -> do - x <- getExplosionAttributeValue - pure (ExplosionAttribute x) - AVFlaggedInt -> do - x <- getFlaggedIntAttributeValue - pure (FlaggedIntAttribute x) - AVFloat -> do - x <- getFloatAttributeValue - pure (FloatAttribute x) - AVGameMode -> do - x <- getGameModeAttributeValue version - pure (GameModeAttribute x) - AVInt -> do - x <- getIntAttributeValue - pure (IntAttribute x) - AVLoadout -> do - x <- getLoadoutAttributeValue - pure (LoadoutAttribute x) - AVLoadoutOnline -> do - x <- getLoadoutOnlineAttributeValue - pure (LoadoutOnlineAttribute x) - AVLoadouts -> do - x <- getLoadoutsAttributeValue - pure (LoadoutsAttribute x) - AVLoadoutsOnline -> do - x <- getLoadoutsOnlineAttributeValue - pure (LoadoutsOnlineAttribute x) - AVLocation -> do - x <- getLocationAttributeValue - pure (LocationAttribute x) - AVMusicStinger -> do - x <- getMusicStingerAttributeValue - pure (MusicStingerAttribute x) - AVPartyLeader -> do - x <- getPartyLeaderAttributeValue - pure (PartyLeaderAttribute x) - AVPickup -> do - x <- getPickupAttributeValue - pure (PickupAttribute x) - AVPrivateMatchSettings -> do - x <- getPrivateMatchSettingsAttributeValue - pure (PrivateMatchSettingsAttribute x) - AVQWord -> do - x <- getQWordAttributeValue - pure (QWordAttribute x) - AVReservation -> do - x <- getReservationAttributeValue version - pure (ReservationAttribute x) - AVRigidBodyState -> do - x <- getRigidBodyStateAttributeValue - pure (RigidBodyStateAttribute x) - AVString -> do - x <- getStringAttributeValue - pure (StringAttribute x) - AVTeamPaint -> do - x <- getTeamPaintAttributeValue - pure (TeamPaintAttribute x) - AVUniqueId -> do - x <- getUniqueIdAttributeValue - pure (UniqueIdAttribute x) - AVWeldedInfo -> do - x <- getWeldedInfoAttributeValue - pure (WeldedInfoAttribute x) + BooleanAttributeType -> do + x <- getBooleanAttribute + pure (BooleanAttributeValue x) + ByteAttributeType -> do + x <- getByteAttribute + pure (ByteAttributeValue x) + CamSettingsAttributeType -> do + x <- getCamSettingsAttribute + pure (CamSettingsAttributeValue x) + ClubColorsAttributeType -> do + x <- getClubColorsAttribute + pure (ClubColorsAttributeValue x) + DemolishAttributeType -> do + x <- getDemolishAttribute + pure (DemolishAttributeValue x) + EnumAttributeType -> do + x <- getEnumAttribute + pure (EnumAttributeValue x) + ExplosionAttributeType -> do + x <- getExplosionAttribute + pure (ExplosionAttributeValue x) + FlaggedIntAttributeType -> do + x <- getFlaggedIntAttribute + pure (FlaggedIntAttributeValue x) + FloatAttributeType -> do + x <- getFloatAttribute + pure (FloatAttributeValue x) + GameModeAttributeType -> do + x <- getGameModeAttribute version + pure (GameModeAttributeValue x) + IntAttributeType -> do + x <- getIntAttribute + pure (IntAttributeValue x) + LoadoutAttributeType -> do + x <- getLoadoutAttribute + pure (LoadoutAttributeValue x) + LoadoutOnlineAttributeType -> do + x <- getLoadoutOnlineAttribute + pure (LoadoutOnlineAttributeValue x) + LoadoutsAttributeType -> do + x <- getLoadoutsAttribute + pure (LoadoutsAttributeValue x) + LoadoutsOnlineAttributeType -> do + x <- getLoadoutsOnlineAttribute + pure (LoadoutsOnlineAttributeValue x) + LocationAttributeType -> do + x <- getLocationAttribute + pure (LocationAttributeValue x) + MusicStingerAttributeType -> do + x <- getMusicStingerAttribute + pure (MusicStingerAttributeValue x) + PartyLeaderAttributeType -> do + x <- getPartyLeaderAttribute + pure (PartyLeaderAttributeValue x) + PickupAttributeType -> do + x <- getPickupAttribute + pure (PickupAttributeValue x) + PrivateMatchSettingsAttributeType -> do + x <- getPrivateMatchSettingsAttribute + pure (PrivateMatchSettingsAttributeValue x) + QWordAttributeType -> do + x <- getQWordAttribute + pure (QWordAttributeValue x) + ReservationAttributeType -> do + x <- getReservationAttribute version + pure (ReservationAttributeValue x) + RigidBodyStateAttributeType -> do + x <- getRigidBodyStateAttribute + pure (RigidBodyStateAttributeValue x) + StringAttributeType -> do + x <- getStringAttribute + pure (StringAttributeValue x) + TeamPaintAttributeType -> do + x <- getTeamPaintAttribute + pure (TeamPaintAttributeValue x) + UniqueIdAttributeType -> do + x <- getUniqueIdAttribute + pure (UniqueIdAttributeValue x) + WeldedInfoAttributeType -> do + x <- getWeldedInfoAttribute + pure (WeldedInfoAttributeValue x) Nothing -> fail ("don't know how to get attribute value " ++ show name) -attributeValueTypes :: Map.Map Text AttributeValueType -attributeValueTypes = - Map.mapKeys stringToText (Map.fromList rawAttributeValueTypes) +attributeTypes :: Map.Map Text AttributeType +attributeTypes = Map.mapKeys stringToText (Map.fromList rawAttributeTypes) putAttributeValue :: AttributeValue -> BinaryBit.BitPut () putAttributeValue value = case value of - BooleanAttribute x -> putBooleanAttributeValue x - ByteAttribute x -> putByteAttributeValue x - CamSettingsAttribute x -> putCamSettingsAttributeValue x - ClubColorsAttribute x -> putClubColorsAttributeValue x - DemolishAttribute x -> putDemolishAttributeValue x - EnumAttribute x -> putEnumAttributeValue x - ExplosionAttribute x -> putExplosionAttributeValue x - FlaggedIntAttribute x -> putFlaggedIntAttributeValue x - FloatAttribute x -> putFloatAttributeValue x - GameModeAttribute x -> putGameModeAttributeValue x - IntAttribute x -> putIntAttributeValue x - LoadoutAttribute x -> putLoadoutAttributeValue x - LoadoutOnlineAttribute x -> putLoadoutOnlineAttributeValue x - LoadoutsAttribute x -> putLoadoutsAttributeValue x - LoadoutsOnlineAttribute x -> putLoadoutsOnlineAttributeValue x - LocationAttribute x -> putLocationAttributeValue x - MusicStingerAttribute x -> putMusicStingerAttributeValue x - PartyLeaderAttribute x -> putPartyLeaderAttributeValue x - PickupAttribute x -> putPickupAttributeValue x - PrivateMatchSettingsAttribute x -> putPrivateMatchSettingsAttributeValue x - QWordAttribute x -> putQWordAttributeValue x - ReservationAttribute x -> putReservationAttributeValue x - RigidBodyStateAttribute x -> putRigidBodyStateAttributeValue x - StringAttribute x -> putStringAttributeValue x - TeamPaintAttribute x -> putTeamPaintAttributeValue x - UniqueIdAttribute x -> putUniqueIdAttributeValue x - WeldedInfoAttribute x -> putWeldedInfoAttributeValue x + BooleanAttributeValue x -> putBooleanAttribute x + ByteAttributeValue x -> putByteAttribute x + CamSettingsAttributeValue x -> putCamSettingsAttribute x + ClubColorsAttributeValue x -> putClubColorsAttribute x + DemolishAttributeValue x -> putDemolishAttribute x + EnumAttributeValue x -> putEnumAttribute x + ExplosionAttributeValue x -> putExplosionAttribute x + FlaggedIntAttributeValue x -> putFlaggedIntAttribute x + FloatAttributeValue x -> putFloatAttribute x + GameModeAttributeValue x -> putGameModeAttribute x + IntAttributeValue x -> putIntAttribute x + LoadoutAttributeValue x -> putLoadoutAttribute x + LoadoutOnlineAttributeValue x -> putLoadoutOnlineAttribute x + LoadoutsAttributeValue x -> putLoadoutsAttribute x + LoadoutsOnlineAttributeValue x -> putLoadoutsOnlineAttribute x + LocationAttributeValue x -> putLocationAttribute x + MusicStingerAttributeValue x -> putMusicStingerAttribute x + PartyLeaderAttributeValue x -> putPartyLeaderAttribute x + PickupAttributeValue x -> putPickupAttribute x + PrivateMatchSettingsAttributeValue x -> putPrivateMatchSettingsAttribute x + QWordAttributeValue x -> putQWordAttribute x + ReservationAttributeValue x -> putReservationAttribute x + RigidBodyStateAttributeValue x -> putRigidBodyStateAttribute x + StringAttributeValue x -> putStringAttribute x + TeamPaintAttributeValue x -> putTeamPaintAttribute x + UniqueIdAttributeValue x -> putUniqueIdAttribute x + WeldedInfoAttributeValue x -> putWeldedInfoAttribute x diff --git a/library/Rattletrap/AttributeValue/Boolean.hs b/library/Rattletrap/AttributeValue/Boolean.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Boolean.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.AttributeValue.Boolean where - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype BooleanAttributeValue = BooleanAttributeValue - { booleanAttributeValueValue :: Bool - } deriving (Eq, Ord, Show) - -getBooleanAttributeValue :: BinaryBit.BitGet BooleanAttributeValue -getBooleanAttributeValue = do - value <- BinaryBit.getBool - pure (BooleanAttributeValue value) - -putBooleanAttributeValue :: BooleanAttributeValue -> BinaryBit.BitPut () -putBooleanAttributeValue booleanAttributeValue = - BinaryBit.putBool (booleanAttributeValueValue booleanAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Byte.hs b/library/Rattletrap/AttributeValue/Byte.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Byte.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.Byte where - -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype ByteAttributeValue = ByteAttributeValue - { byteAttributeValueValue :: Word8 - } deriving (Eq, Ord, Show) - -getByteAttributeValue :: BinaryBit.BitGet ByteAttributeValue -getByteAttributeValue = do - value <- getWord8Bits - pure (ByteAttributeValue value) - -putByteAttributeValue :: ByteAttributeValue -> BinaryBit.BitPut () -putByteAttributeValue byteAttributeValue = - putWord8Bits (byteAttributeValueValue byteAttributeValue) diff --git a/library/Rattletrap/AttributeValue/CamSettings.hs b/library/Rattletrap/AttributeValue/CamSettings.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/CamSettings.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Rattletrap.AttributeValue.CamSettings where - -import Rattletrap.Float32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data CamSettingsAttributeValue = CamSettingsAttributeValue - { camSettingsAttributeValueFov :: Float32 - , camSettingsAttributeValueHeight :: Float32 - , camSettingsAttributeValueAngle :: Float32 - , camSettingsAttributeValueDistance :: Float32 - , camSettingsAttributeValueStiffness :: Float32 - , camSettingsAttributeValueSwivelSpeed :: Float32 - } deriving (Eq, Ord, Show) - -getCamSettingsAttributeValue :: BinaryBit.BitGet CamSettingsAttributeValue -getCamSettingsAttributeValue = do - fov <- getFloat32Bits - height <- getFloat32Bits - angle <- getFloat32Bits - distance <- getFloat32Bits - stiffness <- getFloat32Bits - swivelSpeed <- getFloat32Bits - pure - (CamSettingsAttributeValue fov height angle distance stiffness swivelSpeed) - -putCamSettingsAttributeValue :: CamSettingsAttributeValue -> BinaryBit.BitPut () -putCamSettingsAttributeValue camSettingsAttributeValue = do - putFloat32Bits (camSettingsAttributeValueFov camSettingsAttributeValue) - putFloat32Bits (camSettingsAttributeValueHeight camSettingsAttributeValue) - putFloat32Bits (camSettingsAttributeValueAngle camSettingsAttributeValue) - putFloat32Bits (camSettingsAttributeValueDistance camSettingsAttributeValue) - putFloat32Bits (camSettingsAttributeValueStiffness camSettingsAttributeValue) - putFloat32Bits - (camSettingsAttributeValueSwivelSpeed camSettingsAttributeValue) diff --git a/library/Rattletrap/AttributeValue/ClubColors.hs b/library/Rattletrap/AttributeValue/ClubColors.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/ClubColors.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Rattletrap.AttributeValue.ClubColors where - -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data ClubColorsAttributeValue = ClubColorsAttributeValue - { clubColorsAttributeValueBlueFlag :: Bool - , clubColorsAttributeValueBlueColor :: Word8 - , clubColorsAttributeValueOrangeFlag :: Bool - , clubColorsAttributeValueOrangeColor :: Word8 - } deriving (Eq, Ord, Show) - -getClubColorsAttributeValue :: BinaryBit.BitGet ClubColorsAttributeValue -getClubColorsAttributeValue = do - blueFlag <- BinaryBit.getBool - blueColor <- getWord8Bits - orangeFlag <- BinaryBit.getBool - orangeColor <- getWord8Bits - pure (ClubColorsAttributeValue blueFlag blueColor orangeFlag orangeColor) - -putClubColorsAttributeValue :: ClubColorsAttributeValue -> BinaryBit.BitPut () -putClubColorsAttributeValue clubColorsAttributeValue = do - BinaryBit.putBool (clubColorsAttributeValueBlueFlag clubColorsAttributeValue) - putWord8Bits (clubColorsAttributeValueBlueColor clubColorsAttributeValue) - BinaryBit.putBool - (clubColorsAttributeValueOrangeFlag clubColorsAttributeValue) - putWord8Bits (clubColorsAttributeValueOrangeColor clubColorsAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Demolish.hs b/library/Rattletrap/AttributeValue/Demolish.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Demolish.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Rattletrap.AttributeValue.Demolish where - -import Rattletrap.Vector -import Rattletrap.Word32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data DemolishAttributeValue = DemolishAttributeValue - { demolishAttributeValueAttackerFlag :: Bool - , demolishAttributeValueAttackerActorId :: Word32 - , demolishAttributeValueVictimFlag :: Bool - , demolishAttributeValueVictimActorId :: Word32 - , demolishAttributeValueAttackerVelocity :: Vector - , demolishAttributeValueVictimVelocity :: Vector - } deriving (Eq, Ord, Show) - -getDemolishAttributeValue :: BinaryBit.BitGet DemolishAttributeValue -getDemolishAttributeValue = do - attackerFlag <- BinaryBit.getBool - attackerActorId <- getWord32Bits - victimFlag <- BinaryBit.getBool - victimActorId <- getWord32Bits - attackerVelocity <- getVector - victimVelocity <- getVector - pure - (DemolishAttributeValue - attackerFlag - attackerActorId - victimFlag - victimActorId - attackerVelocity - victimVelocity) - -putDemolishAttributeValue :: DemolishAttributeValue -> BinaryBit.BitPut () -putDemolishAttributeValue demolishAttributeValue = do - BinaryBit.putBool (demolishAttributeValueAttackerFlag demolishAttributeValue) - putWord32Bits (demolishAttributeValueAttackerActorId demolishAttributeValue) - BinaryBit.putBool (demolishAttributeValueVictimFlag demolishAttributeValue) - putWord32Bits (demolishAttributeValueVictimActorId demolishAttributeValue) - putVector (demolishAttributeValueAttackerVelocity demolishAttributeValue) - putVector (demolishAttributeValueVictimVelocity demolishAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Enum.hs b/library/Rattletrap/AttributeValue/Enum.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Enum.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.AttributeValue.Enum where - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Word as Word - -newtype EnumAttributeValue = EnumAttributeValue - { enumAttributeValueValue :: Word.Word16 - } deriving (Eq, Ord, Show) - -getEnumAttributeValue :: BinaryBit.BitGet EnumAttributeValue -getEnumAttributeValue = do - value <- BinaryBit.getWord16be 11 - pure (EnumAttributeValue value) - -putEnumAttributeValue :: EnumAttributeValue -> BinaryBit.BitPut () -putEnumAttributeValue enumAttributeValue = - BinaryBit.putWord16be 11 (enumAttributeValueValue enumAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Explosion.hs b/library/Rattletrap/AttributeValue/Explosion.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Explosion.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Rattletrap.AttributeValue.Explosion where - -import Rattletrap.Int32 -import Rattletrap.Vector - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data ExplosionAttributeValue = ExplosionAttributeValue - { explosionAttributeValueActorId :: Int32 - , explosionAttributeValueLocation :: Vector - } deriving (Eq, Ord, Show) - -getExplosionAttributeValue :: BinaryBit.BitGet ExplosionAttributeValue -getExplosionAttributeValue = do - False <- BinaryBit.getBool - actorId <- getInt32Bits - location <- getVector - pure (ExplosionAttributeValue actorId location) - -putExplosionAttributeValue :: ExplosionAttributeValue -> BinaryBit.BitPut () -putExplosionAttributeValue explosionAttributeValue = do - BinaryBit.putBool False - putInt32Bits (explosionAttributeValueActorId explosionAttributeValue) - putVector (explosionAttributeValueLocation explosionAttributeValue) diff --git a/library/Rattletrap/AttributeValue/FlaggedInt.hs b/library/Rattletrap/AttributeValue/FlaggedInt.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/FlaggedInt.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.AttributeValue.FlaggedInt where - -import Rattletrap.Int32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data FlaggedIntAttributeValue = FlaggedIntAttributeValue - { flaggedIntAttributeValueFlag :: Bool - , flaggedIntAttributeValueInt :: Int32 - } deriving (Eq, Ord, Show) - -getFlaggedIntAttributeValue :: BinaryBit.BitGet FlaggedIntAttributeValue -getFlaggedIntAttributeValue = do - flag <- BinaryBit.getBool - int <- getInt32Bits - pure (FlaggedIntAttributeValue flag int) - -putFlaggedIntAttributeValue :: FlaggedIntAttributeValue -> BinaryBit.BitPut () -putFlaggedIntAttributeValue flaggedIntAttributeValue = do - BinaryBit.putBool (flaggedIntAttributeValueFlag flaggedIntAttributeValue) - putInt32Bits (flaggedIntAttributeValueInt flaggedIntAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Float.hs b/library/Rattletrap/AttributeValue/Float.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Float.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.Float where - -import Rattletrap.Float32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype FloatAttributeValue = FloatAttributeValue - { floatAttributeValueValue :: Float32 - } deriving (Eq, Ord, Show) - -getFloatAttributeValue :: BinaryBit.BitGet FloatAttributeValue -getFloatAttributeValue = do - value <- getFloat32Bits - pure (FloatAttributeValue value) - -putFloatAttributeValue :: FloatAttributeValue -> BinaryBit.BitPut () -putFloatAttributeValue floatAttributeValue = - putFloat32Bits (floatAttributeValueValue floatAttributeValue) diff --git a/library/Rattletrap/AttributeValue/GameMode.hs b/library/Rattletrap/AttributeValue/GameMode.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/GameMode.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.AttributeValue.GameMode where - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Word as Word - -data GameModeAttributeValue = GameModeAttributeValue - { gameModeAttributeValueNumBits :: Int - , gameModeAttributeValueWord :: Word.Word8 - } deriving (Eq, Ord, Show) - -getGameModeAttributeValue :: (Int, Int) - -> BinaryBit.BitGet GameModeAttributeValue -getGameModeAttributeValue version = do - let numBits = - if version < (868, 12) - then 2 - else 8 - word <- BinaryBit.getWord8 numBits - pure (GameModeAttributeValue numBits word) - -putGameModeAttributeValue :: GameModeAttributeValue -> BinaryBit.BitPut () -putGameModeAttributeValue gameModeAttributeValue = do - let numBits = gameModeAttributeValueNumBits gameModeAttributeValue - let word = gameModeAttributeValueWord gameModeAttributeValue - BinaryBit.putWord8 numBits word diff --git a/library/Rattletrap/AttributeValue/Int.hs b/library/Rattletrap/AttributeValue/Int.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Int.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.Int where - -import Rattletrap.Int32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype IntAttributeValue = IntAttributeValue - { intAttributeValueValue :: Int32 - } deriving (Eq, Ord, Show) - -getIntAttributeValue :: BinaryBit.BitGet IntAttributeValue -getIntAttributeValue = do - value <- getInt32Bits - pure (IntAttributeValue value) - -putIntAttributeValue :: IntAttributeValue -> BinaryBit.BitPut () -putIntAttributeValue intAttributeValue = - putInt32Bits (intAttributeValueValue intAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Loadout.hs b/library/Rattletrap/AttributeValue/Loadout.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Loadout.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Rattletrap.AttributeValue.Loadout where - -import Rattletrap.Word32 -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data LoadoutAttributeValue = LoadoutAttributeValue - { loadoutAttributeValueVersion :: Word8 - , loadoutAttributeValueBody :: Word32 - , loadoutAttributeValueDecal :: Word32 - , loadoutAttributeValueWheels :: Word32 - , loadoutAttributeValueRocketTrail :: Word32 - , loadoutAttributeValueAntenna :: Word32 - , loadoutAttributeValueTopper :: Word32 - , loadoutAttributeValueUnknown1 :: Word32 - , loadoutAttributeValueUnknown2 :: Maybe Word32 - } deriving (Eq, Ord, Show) - -getLoadoutAttributeValue :: BinaryBit.BitGet LoadoutAttributeValue -getLoadoutAttributeValue = do - version <- getWord8Bits - body <- getWord32Bits - decal <- getWord32Bits - wheels <- getWord32Bits - rocketTrail <- getWord32Bits - antenna <- getWord32Bits - topper <- getWord32Bits - g <- getWord32Bits - h <- - if version > Word8 10 - then do - h <- getWord32Bits - pure (Just h) - else pure Nothing - pure - (LoadoutAttributeValue - version - body - decal - wheels - rocketTrail - antenna - topper - g - h) - -putLoadoutAttributeValue :: LoadoutAttributeValue -> BinaryBit.BitPut () -putLoadoutAttributeValue loadoutAttributeValue = do - putWord8Bits (loadoutAttributeValueVersion loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueBody loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueDecal loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueWheels loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueRocketTrail loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueAntenna loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueTopper loadoutAttributeValue) - putWord32Bits (loadoutAttributeValueUnknown1 loadoutAttributeValue) - case loadoutAttributeValueUnknown2 loadoutAttributeValue of - Nothing -> pure () - Just x -> putWord32Bits x diff --git a/library/Rattletrap/AttributeValue/LoadoutOnline.hs b/library/Rattletrap/AttributeValue/LoadoutOnline.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/LoadoutOnline.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Rattletrap.AttributeValue.LoadoutOnline where - -import Rattletrap.CompressedWord -import Rattletrap.Word32 -import Rattletrap.Word8 - -import qualified Control.Monad as Monad -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype LoadoutOnlineAttributeValue = LoadoutOnlineAttributeValue - { loadoutAttributeValueValue :: [[(Word32, CompressedWord)]] - } deriving (Eq, Ord, Show) - -getLoadoutOnlineAttributeValue :: BinaryBit.BitGet LoadoutOnlineAttributeValue -getLoadoutOnlineAttributeValue = do - size <- getWord8Bits - values <- - Monad.replicateM - (fromIntegral (word8Value size)) - (do innerSize <- getWord8Bits - Monad.replicateM - (fromIntegral (word8Value innerSize)) - (do x <- getWord32Bits - y <- getCompressedWord 27 - pure (x, y))) - pure (LoadoutOnlineAttributeValue values) - -putLoadoutOnlineAttributeValue :: LoadoutOnlineAttributeValue - -> BinaryBit.BitPut () -putLoadoutOnlineAttributeValue loadoutAttributeValue = do - let values = loadoutAttributeValueValue loadoutAttributeValue - putWord8Bits (Word8 (fromIntegral (length values))) - mapM_ - (\xs -> do - putWord8Bits (Word8 (fromIntegral (length xs))) - mapM_ - (\(x, y) -> do - putWord32Bits x - putCompressedWord y) - xs) - values diff --git a/library/Rattletrap/AttributeValue/Loadouts.hs b/library/Rattletrap/AttributeValue/Loadouts.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Loadouts.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.AttributeValue.Loadouts where - -import Rattletrap.AttributeValue.Loadout - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data LoadoutsAttributeValue = LoadoutsAttributeValue - { loadoutsAttributeValueBlue :: LoadoutAttributeValue - , loadoutsAttributeValueOrange :: LoadoutAttributeValue - } deriving (Eq, Ord, Show) - -getLoadoutsAttributeValue :: BinaryBit.BitGet LoadoutsAttributeValue -getLoadoutsAttributeValue = do - blue <- getLoadoutAttributeValue - orange <- getLoadoutAttributeValue - pure (LoadoutsAttributeValue blue orange) - -putLoadoutsAttributeValue :: LoadoutsAttributeValue -> BinaryBit.BitPut () -putLoadoutsAttributeValue loadoutsAttributeValue = do - putLoadoutAttributeValue (loadoutsAttributeValueBlue loadoutsAttributeValue) - putLoadoutAttributeValue (loadoutsAttributeValueOrange loadoutsAttributeValue) diff --git a/library/Rattletrap/AttributeValue/LoadoutsOnline.hs b/library/Rattletrap/AttributeValue/LoadoutsOnline.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/LoadoutsOnline.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Rattletrap.AttributeValue.LoadoutsOnline where - -import Rattletrap.AttributeValue.LoadoutOnline - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data LoadoutsOnlineAttributeValue = LoadoutsOnlineAttributeValue - { loadoutsOnlineAttributeValueBlue :: LoadoutOnlineAttributeValue - , loadoutsOnlineAttributeValueOrange :: LoadoutOnlineAttributeValue - , loadoutsOnlineAttributeValueUnknown1 :: Bool - , loadoutsOnlineAttributeValueUnknown2 :: Bool - } deriving (Eq, Ord, Show) - -getLoadoutsOnlineAttributeValue :: BinaryBit.BitGet LoadoutsOnlineAttributeValue -getLoadoutsOnlineAttributeValue = do - blueLoadout <- getLoadoutOnlineAttributeValue - orangeLoadout <- getLoadoutOnlineAttributeValue - unknown1 <- BinaryBit.getBool - unknown2 <- BinaryBit.getBool - pure - (LoadoutsOnlineAttributeValue blueLoadout orangeLoadout unknown1 unknown2) - -putLoadoutsOnlineAttributeValue :: LoadoutsOnlineAttributeValue - -> BinaryBit.BitPut () -putLoadoutsOnlineAttributeValue loadoutsOnlineAttributeValue = do - putLoadoutOnlineAttributeValue - (loadoutsOnlineAttributeValueBlue loadoutsOnlineAttributeValue) - putLoadoutOnlineAttributeValue - (loadoutsOnlineAttributeValueOrange loadoutsOnlineAttributeValue) - BinaryBit.putBool - (loadoutsOnlineAttributeValueUnknown1 loadoutsOnlineAttributeValue) - BinaryBit.putBool - (loadoutsOnlineAttributeValueUnknown2 loadoutsOnlineAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Location.hs b/library/Rattletrap/AttributeValue/Location.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Location.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.Location where - -import Rattletrap.Vector - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype LocationAttributeValue = LocationAttributeValue - { locationAttributeValueValue :: Vector - } deriving (Eq, Ord, Show) - -getLocationAttributeValue :: BinaryBit.BitGet LocationAttributeValue -getLocationAttributeValue = do - value <- getVector - pure (LocationAttributeValue value) - -putLocationAttributeValue :: LocationAttributeValue -> BinaryBit.BitPut () -putLocationAttributeValue locationAttributeValue = - putVector (locationAttributeValueValue locationAttributeValue) diff --git a/library/Rattletrap/AttributeValue/MusicStinger.hs b/library/Rattletrap/AttributeValue/MusicStinger.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/MusicStinger.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Rattletrap.AttributeValue.MusicStinger where - -import Rattletrap.Word32 -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data MusicStingerAttributeValue = MusicStingerAttributeValue - { musicStingerAttributeValueFlag :: Bool - , musicStingerAttributeValueCue :: Word32 - , musicStingerAttributeValueTrigger :: Word8 - } deriving (Eq, Ord, Show) - -getMusicStingerAttributeValue :: BinaryBit.BitGet MusicStingerAttributeValue -getMusicStingerAttributeValue = do - flag <- BinaryBit.getBool - cue <- getWord32Bits - trigger <- getWord8Bits - pure (MusicStingerAttributeValue flag cue trigger) - -putMusicStingerAttributeValue :: MusicStingerAttributeValue - -> BinaryBit.BitPut () -putMusicStingerAttributeValue musicStingerAttributeValue = do - BinaryBit.putBool (musicStingerAttributeValueFlag musicStingerAttributeValue) - putWord32Bits (musicStingerAttributeValueCue musicStingerAttributeValue) - putWord8Bits (musicStingerAttributeValueTrigger musicStingerAttributeValue) diff --git a/library/Rattletrap/AttributeValue/PartyLeader.hs b/library/Rattletrap/AttributeValue/PartyLeader.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/PartyLeader.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.AttributeValue.PartyLeader where - -import Rattletrap.RemoteId -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data PartyLeaderAttributeValue = PartyLeaderAttributeValue - { partyLeaderAttributeValueSystemId :: Word8 - , partyLeaderAttributeValueId :: Maybe (RemoteId, Word8) - } deriving (Eq, Ord, Show) - -getPartyLeaderAttributeValue :: BinaryBit.BitGet PartyLeaderAttributeValue -getPartyLeaderAttributeValue = do - systemId <- getWord8Bits - maybeRemoteAndLocalId <- - if systemId == Word8 0 - then pure Nothing - else do - remoteId <- getRemoteId systemId - localId <- getWord8Bits - pure (Just (remoteId, localId)) - pure (PartyLeaderAttributeValue systemId maybeRemoteAndLocalId) - -putPartyLeaderAttributeValue :: PartyLeaderAttributeValue -> BinaryBit.BitPut () -putPartyLeaderAttributeValue partyLeaderAttributeValue = do - putWord8Bits (partyLeaderAttributeValueSystemId partyLeaderAttributeValue) - case partyLeaderAttributeValueId partyLeaderAttributeValue of - Nothing -> pure () - Just (remoteId, localId) -> do - putRemoteId remoteId - putWord8Bits localId diff --git a/library/Rattletrap/AttributeValue/Pickup.hs b/library/Rattletrap/AttributeValue/Pickup.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Pickup.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Rattletrap.AttributeValue.Pickup where - -import Rattletrap.Word32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data PickupAttributeValue = PickupAttributeValue - { pickupAttributeValueInstigatorId :: Maybe Word32 - , pickupAttributeValuePickedUp :: Bool - } deriving (Eq, Ord, Show) - -getPickupAttributeValue :: BinaryBit.BitGet PickupAttributeValue -getPickupAttributeValue = do - instigator <- BinaryBit.getBool - maybeInstigatorId <- - if instigator - then do - instigatorId <- getWord32Bits - pure (Just instigatorId) - else pure Nothing - pickedUp <- BinaryBit.getBool - pure (PickupAttributeValue maybeInstigatorId pickedUp) - -putPickupAttributeValue :: PickupAttributeValue -> BinaryBit.BitPut () -putPickupAttributeValue pickupAttributeValue = do - case pickupAttributeValueInstigatorId pickupAttributeValue of - Nothing -> BinaryBit.putBool False - Just instigatorId -> do - BinaryBit.putBool True - putWord32Bits instigatorId - BinaryBit.putBool (pickupAttributeValuePickedUp pickupAttributeValue) diff --git a/library/Rattletrap/AttributeValue/PrivateMatchSettings.hs b/library/Rattletrap/AttributeValue/PrivateMatchSettings.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/PrivateMatchSettings.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Rattletrap.AttributeValue.PrivateMatchSettings where - -import Rattletrap.Text -import Rattletrap.Word32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data PrivateMatchSettingsAttributeValue = PrivateMatchSettingsAttributeValue - { privateMatchSettingsAttributeValueMutators :: Text - , privateMatchSettingsAttributeValueJoinableBy :: Word32 - , privateMatchSettingsAttributeValueMaxPlayers :: Word32 - , privateMatchSettingsAttributeValueGameName :: Text - , privateMatchSettingsAttributeValuePassword :: Text - , privateMatchSettingsAttributeValueFlag :: Bool - } deriving (Eq, Ord, Show) - -getPrivateMatchSettingsAttributeValue :: BinaryBit.BitGet PrivateMatchSettingsAttributeValue -getPrivateMatchSettingsAttributeValue = do - mutators <- getTextBits - joinableBy <- getWord32Bits - maxPlayers <- getWord32Bits - gameName <- getTextBits - password <- getTextBits - flag <- BinaryBit.getBool - pure - (PrivateMatchSettingsAttributeValue - mutators - joinableBy - maxPlayers - gameName - password - flag) - -putPrivateMatchSettingsAttributeValue :: PrivateMatchSettingsAttributeValue - -> BinaryBit.BitPut () -putPrivateMatchSettingsAttributeValue privateMatchSettingsAttributeValue = do - putTextBits - (privateMatchSettingsAttributeValueMutators - privateMatchSettingsAttributeValue) - putWord32Bits - (privateMatchSettingsAttributeValueJoinableBy - privateMatchSettingsAttributeValue) - putWord32Bits - (privateMatchSettingsAttributeValueMaxPlayers - privateMatchSettingsAttributeValue) - putTextBits - (privateMatchSettingsAttributeValueGameName - privateMatchSettingsAttributeValue) - putTextBits - (privateMatchSettingsAttributeValuePassword - privateMatchSettingsAttributeValue) - BinaryBit.putBool - (privateMatchSettingsAttributeValueFlag privateMatchSettingsAttributeValue) diff --git a/library/Rattletrap/AttributeValue/QWord.hs b/library/Rattletrap/AttributeValue/QWord.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/QWord.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.QWord where - -import Rattletrap.Word64 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype QWordAttributeValue = QWordAttributeValue - { qWordAttributeValueValue :: Word64 - } deriving (Eq, Ord, Show) - -getQWordAttributeValue :: BinaryBit.BitGet QWordAttributeValue -getQWordAttributeValue = do - value <- getWord64Bits - pure (QWordAttributeValue value) - -putQWordAttributeValue :: QWordAttributeValue -> BinaryBit.BitPut () -putQWordAttributeValue qWordAttributeValue = - putWord64Bits (qWordAttributeValueValue qWordAttributeValue) diff --git a/library/Rattletrap/AttributeValue/Reservation.hs b/library/Rattletrap/AttributeValue/Reservation.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/Reservation.hs +++ /dev/null @@ -1,56 +0,0 @@ -module Rattletrap.AttributeValue.Reservation where - -import Rattletrap.AttributeValue.UniqueId -import Rattletrap.CompressedWord -import Rattletrap.Text -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Word as Word - -data ReservationAttributeValue = ReservationAttributeValue - { reservationAttributeValueNumber :: CompressedWord - , reservationAttributeValueUniqueId :: UniqueIdAttributeValue - , reservationAttributeValueName :: Maybe Text - , reservationAttributeValueUnknown1 :: Bool - , reservationAttributeValueUnknown2 :: Bool - , reservationAttributeValueUnknown3 :: Maybe Word.Word8 - } deriving (Eq, Ord, Show) - -getReservationAttributeValue :: (Int, Int) - -> BinaryBit.BitGet ReservationAttributeValue -getReservationAttributeValue version = do - number <- getCompressedWord 7 - uniqueId <- getUniqueIdAttributeValue - name <- - if uniqueIdAttributeValueSystemId uniqueId == Word8 0 - then pure Nothing - else do - name <- getTextBits - pure (Just name) - a <- BinaryBit.getBool - b <- BinaryBit.getBool - mc <- - if version < (868, 12) - then pure Nothing - else do - c <- BinaryBit.getWord8 6 - pure (Just c) - pure (ReservationAttributeValue number uniqueId name a b mc) - -putReservationAttributeValue :: ReservationAttributeValue -> BinaryBit.BitPut () -putReservationAttributeValue reservationAttributeValue = do - putCompressedWord (reservationAttributeValueNumber reservationAttributeValue) - putUniqueIdAttributeValue - (reservationAttributeValueUniqueId reservationAttributeValue) - case reservationAttributeValueName reservationAttributeValue of - Nothing -> pure () - Just name -> putTextBits name - BinaryBit.putBool - (reservationAttributeValueUnknown1 reservationAttributeValue) - BinaryBit.putBool - (reservationAttributeValueUnknown2 reservationAttributeValue) - case reservationAttributeValueUnknown3 reservationAttributeValue of - Nothing -> pure () - Just c -> BinaryBit.putWord8 6 c diff --git a/library/Rattletrap/AttributeValue/RigidBodyState.hs b/library/Rattletrap/AttributeValue/RigidBodyState.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/RigidBodyState.hs +++ /dev/null @@ -1,55 +0,0 @@ -module Rattletrap.AttributeValue.RigidBodyState where - -import Rattletrap.CompressedWordVector -import Rattletrap.Vector - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data RigidBodyStateAttributeValue = RigidBodyStateAttributeValue - { rigidBodyStateAttributeValueSleeping :: Bool - , rigidBodyStateAttributeValueLocation :: Vector - , rigidBodyStateAttributeValueRotation :: CompressedWordVector - , rigidBodyStateAttributeValueLinearVelocity :: Maybe Vector - , rigidBodyStateAttributeValueAngularVelocity :: Maybe Vector - } deriving (Eq, Ord, Show) - -getRigidBodyStateAttributeValue :: BinaryBit.BitGet RigidBodyStateAttributeValue -getRigidBodyStateAttributeValue = do - sleeping <- BinaryBit.getBool - location <- getVector - rotation <- getCompressedWordVector - linearVelocity <- - if sleeping - then pure Nothing - else do - linearVelocity <- getVector - pure (Just linearVelocity) - angularVelocity <- - if sleeping - then pure Nothing - else do - angularVelocity <- getVector - pure (Just angularVelocity) - pure - (RigidBodyStateAttributeValue - sleeping - location - rotation - linearVelocity - angularVelocity) - -putRigidBodyStateAttributeValue :: RigidBodyStateAttributeValue - -> BinaryBit.BitPut () -putRigidBodyStateAttributeValue rigidBodyStateAttributeValue = do - BinaryBit.putBool - (rigidBodyStateAttributeValueSleeping rigidBodyStateAttributeValue) - putVector (rigidBodyStateAttributeValueLocation rigidBodyStateAttributeValue) - putCompressedWordVector - (rigidBodyStateAttributeValueRotation rigidBodyStateAttributeValue) - case rigidBodyStateAttributeValueLinearVelocity rigidBodyStateAttributeValue of - Nothing -> pure () - Just linearVelocity -> putVector linearVelocity - case rigidBodyStateAttributeValueAngularVelocity rigidBodyStateAttributeValue of - Nothing -> pure () - Just angularVelocity -> putVector angularVelocity diff --git a/library/Rattletrap/AttributeValue/String.hs b/library/Rattletrap/AttributeValue/String.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/String.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.AttributeValue.String where - -import Rattletrap.Text - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -newtype StringAttributeValue = StringAttributeValue - { stringAttributeValueValue :: Text - } deriving (Eq, Ord, Show) - -getStringAttributeValue :: BinaryBit.BitGet StringAttributeValue -getStringAttributeValue = do - value <- getTextBits - pure (StringAttributeValue value) - -putStringAttributeValue :: StringAttributeValue -> BinaryBit.BitPut () -putStringAttributeValue stringAttributeValue = - putTextBits (stringAttributeValueValue stringAttributeValue) diff --git a/library/Rattletrap/AttributeValue/TeamPaint.hs b/library/Rattletrap/AttributeValue/TeamPaint.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/TeamPaint.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Rattletrap.AttributeValue.TeamPaint where - -import Rattletrap.Word32 -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data TeamPaintAttributeValue = TeamPaintAttributeValue - { teamPaintAttributeValueTeam :: Word8 - , teamPaintAttributeValuePrimaryColor :: Word8 - , teamPaintAttributeValueAccentColor :: Word8 - , teamPaintAttributeValuePrimaryFinish :: Word32 - , teamPaintAttributeValueAccentFinish :: Word32 - } deriving (Eq, Ord, Show) - -getTeamPaintAttributeValue :: BinaryBit.BitGet TeamPaintAttributeValue -getTeamPaintAttributeValue = do - team <- getWord8Bits - primaryColor <- getWord8Bits - accentColor <- getWord8Bits - primaryFinish <- getWord32Bits - accentFinish <- getWord32Bits - pure - (TeamPaintAttributeValue - team - primaryColor - accentColor - primaryFinish - accentFinish) - -putTeamPaintAttributeValue :: TeamPaintAttributeValue -> BinaryBit.BitPut () -putTeamPaintAttributeValue teamPaintAttributeValue = do - putWord8Bits (teamPaintAttributeValueTeam teamPaintAttributeValue) - putWord8Bits (teamPaintAttributeValuePrimaryColor teamPaintAttributeValue) - putWord8Bits (teamPaintAttributeValueAccentColor teamPaintAttributeValue) - putWord32Bits (teamPaintAttributeValuePrimaryFinish teamPaintAttributeValue) - putWord32Bits (teamPaintAttributeValueAccentFinish teamPaintAttributeValue) diff --git a/library/Rattletrap/AttributeValue/UniqueId.hs b/library/Rattletrap/AttributeValue/UniqueId.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/UniqueId.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.AttributeValue.UniqueId where - -import Rattletrap.RemoteId -import Rattletrap.Word8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data UniqueIdAttributeValue = UniqueIdAttributeValue - { uniqueIdAttributeValueSystemId :: Word8 - , uniqueIdAttributeValueRemoteId :: RemoteId - , uniqueIdAttributeValueLocalId :: Word8 - } deriving (Eq, Ord, Show) - -getUniqueIdAttributeValue :: BinaryBit.BitGet UniqueIdAttributeValue -getUniqueIdAttributeValue = do - systemId <- getWord8Bits - remoteId <- getRemoteId systemId - localId <- getWord8Bits - pure (UniqueIdAttributeValue systemId remoteId localId) - -putUniqueIdAttributeValue :: UniqueIdAttributeValue -> BinaryBit.BitPut () -putUniqueIdAttributeValue uniqueIdAttributeValue = do - putWord8Bits (uniqueIdAttributeValueSystemId uniqueIdAttributeValue) - putRemoteId (uniqueIdAttributeValueRemoteId uniqueIdAttributeValue) - putWord8Bits (uniqueIdAttributeValueLocalId uniqueIdAttributeValue) diff --git a/library/Rattletrap/AttributeValue/WeldedInfo.hs b/library/Rattletrap/AttributeValue/WeldedInfo.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValue/WeldedInfo.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Rattletrap.AttributeValue.WeldedInfo where - -import Rattletrap.Float32 -import Rattletrap.Int32 -import Rattletrap.Int8Vector -import Rattletrap.Vector - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data WeldedInfoAttributeValue = WeldedInfoAttributeValue - { weldedInfoAttributeValueActive :: Bool - , weldedInfoAttributeValueActorId :: Int32 - , weldedInfoAttributeValueOffset :: Vector - , weldedInfoAttributeValueMass :: Float32 - , weldedInfoAttributeValueRotation :: Int8Vector - } deriving (Eq, Ord, Show) - -getWeldedInfoAttributeValue :: BinaryBit.BitGet WeldedInfoAttributeValue -getWeldedInfoAttributeValue = do - active <- BinaryBit.getBool - actorId <- getInt32Bits - offset <- getVector - mass <- getFloat32Bits - rotation <- getInt8Vector - pure (WeldedInfoAttributeValue active actorId offset mass rotation) - -putWeldedInfoAttributeValue :: WeldedInfoAttributeValue -> BinaryBit.BitPut () -putWeldedInfoAttributeValue weldedInfoAttributeValue = do - BinaryBit.putBool (weldedInfoAttributeValueActive weldedInfoAttributeValue) - putInt32Bits (weldedInfoAttributeValueActorId weldedInfoAttributeValue) - putVector (weldedInfoAttributeValueOffset weldedInfoAttributeValue) - putFloat32Bits (weldedInfoAttributeValueMass weldedInfoAttributeValue) - putInt8Vector (weldedInfoAttributeValueRotation weldedInfoAttributeValue) diff --git a/library/Rattletrap/AttributeValueType.hs b/library/Rattletrap/AttributeValueType.hs deleted file mode 100644 --- a/library/Rattletrap/AttributeValueType.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.AttributeValueType where - -data AttributeValueType - = AVBoolean - | AVByte - | AVCamSettings - | AVClubColors - | AVDemolish - | AVEnum - | AVExplosion - | AVFlaggedInt - | AVFloat - | AVGameMode - | AVInt - | AVLoadout - | AVLoadoutOnline - | AVLoadouts - | AVLoadoutsOnline - | AVLocation - | AVMusicStinger - | AVPartyLeader - | AVPickup - | AVPrivateMatchSettings - | AVQWord - | AVReservation - | AVRigidBodyState - | AVString - | AVTeamPaint - | AVUniqueId - | AVWeldedInfo - deriving (Eq, Ord, Show) diff --git a/library/Rattletrap/Cache.hs b/library/Rattletrap/Cache.hs --- a/library/Rattletrap/Cache.hs +++ b/library/Rattletrap/Cache.hs @@ -1,8 +1,7 @@ module Rattletrap.Cache where import Rattletrap.AttributeMapping -import Rattletrap.List -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -19,13 +18,7 @@ parentCacheId <- getWord32 cacheId <- getWord32 attributeMappings <- getList getAttributeMapping - pure - Cache - { cacheClassId = classId - , cacheParentCacheId = parentCacheId - , cacheCacheId = cacheId - , cacheAttributeMappings = attributeMappings - } + pure (Cache classId parentCacheId cacheId attributeMappings) putCache :: Cache -> Binary.Put putCache cache = do diff --git a/library/Rattletrap/ClassAttributeMap.hs b/library/Rattletrap/ClassAttributeMap.hs --- a/library/Rattletrap/ClassAttributeMap.hs +++ b/library/Rattletrap/ClassAttributeMap.hs @@ -4,12 +4,8 @@ import Rattletrap.AttributeMapping import Rattletrap.Cache import Rattletrap.ClassMapping -import Rattletrap.CompressedWord import Rattletrap.Data -import Rattletrap.Int32 -import Rattletrap.List -import Rattletrap.Text -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Bimap as Bimap import qualified Data.List as List @@ -24,39 +20,39 @@ , classAttributeMapValue :: Map.Map Word32 (Map.Map Word32 Word32) } deriving (Eq, Show) -makeClassAttributeMap :: List Text -> List ClassMapping -> List Cache -> ClassAttributeMap +makeClassAttributeMap :: List Text + -> List ClassMapping + -> List Cache + -> ClassAttributeMap makeClassAttributeMap objects classMappings caches = let objectMap = makeObjectMap objects classCache = makeClassCache classMappings caches attributeMap = makeAttributeMap caches classIds = map (\(_, classId, _, _) -> classId) classCache parentMap = makeParentMap classMappings caches + classMap = makeClassMap classMappings value = Map.fromList (map (\classId -> - let ownAttributes = - Maybe.fromMaybe - Map.empty - (Map.lookup classId attributeMap) - parentsAttributes = - case Map.lookup classId parentMap of - Nothing -> [] - Just parentClassIds -> - map - (\parentClassId -> - Maybe.fromMaybe - Map.empty - (Map.lookup parentClassId attributeMap)) - parentClassIds - attributes = ownAttributes : parentsAttributes - in (classId, Map.fromList (concatMap Map.toList attributes))) + let ownAttributes = + Maybe.fromMaybe + Map.empty + (Map.lookup classId attributeMap) + parentsAttributes = + case Map.lookup classId parentMap of + Nothing -> [] + Just parentClassIds -> + map + (\parentClassId -> + Maybe.fromMaybe + Map.empty + (Map.lookup parentClassId attributeMap)) + parentClassIds + attributes = ownAttributes : parentsAttributes + in (classId, Map.fromList (concatMap Map.toList attributes))) classIds) - in ClassAttributeMap - { classAttributeMapObjectMap = objectMap - , classAttributeMapClassMap = makeClassMap classMappings - , classAttributeMapValue = value - } + in ClassAttributeMap objectMap classMap value makeClassCache :: List ClassMapping -> List Cache @@ -65,11 +61,11 @@ let classMap = makeClassMap classMappings in map (\cache -> - let classId = cacheClassId cache - in ( Bimap.lookup classId classMap - , classId - , cacheCacheId cache - , cacheParentCacheId cache)) + let classId = cacheClassId cache + in ( Bimap.lookup classId classMap + , classId + , cacheCacheId cache + , cacheParentCacheId cache)) (listValue caches) makeClassMap :: List ClassMapping -> Bimap.Bimap Word32 Text @@ -77,7 +73,7 @@ Bimap.fromList (map (\classMapping -> - (classMappingStreamId classMapping, classMappingName classMapping)) + (classMappingStreamId classMapping, classMappingName classMapping)) (listValue classMappings)) makeAttributeMap :: List Cache -> Map.Map Word32 (Map.Map Word32 Word32) @@ -85,13 +81,13 @@ Map.fromList (map (\cache -> - ( cacheClassId cache - , Map.fromList - (map - (\attributeMapping -> - ( attributeMappingStreamId attributeMapping - , attributeMappingObjectId attributeMapping)) - (listValue (cacheAttributeMappings cache))))) + ( cacheClassId cache + , Map.fromList + (map + (\attributeMapping -> + ( attributeMappingStreamId attributeMapping + , attributeMappingObjectId attributeMapping)) + (listValue (cacheAttributeMappings cache))))) (listValue caches)) makeShallowParentMap :: List ClassMapping -> List Cache -> Map.Map Word32 Word32 @@ -100,23 +96,27 @@ in Map.fromList (Maybe.mapMaybe (\xs -> - case xs of - [] -> Nothing - (maybeClassName, classId, _, parentCacheId):rest -> do - parentClassId <- getParentClass maybeClassName parentCacheId rest - pure (classId, parentClassId)) + case xs of + [] -> Nothing + (maybeClassName, classId, _, parentCacheId):rest -> do + parentClassId <- + getParentClass maybeClassName parentCacheId rest + pure (classId, parentClassId)) (List.tails (reverse classCache))) makeParentMap :: List ClassMapping -> List Cache -> Map.Map Word32 [Word32] makeParentMap classMappings caches = let shallowParentMap = makeShallowParentMap classMappings caches - in Map.mapWithKey (\classId _ -> getParentClasses shallowParentMap classId) shallowParentMap + in Map.mapWithKey + (\classId _ -> getParentClasses shallowParentMap classId) + shallowParentMap getParentClasses :: Map.Map Word32 Word32 -> Word32 -> [Word32] getParentClasses shallowParentMap classId = case Map.lookup classId shallowParentMap of Nothing -> [] - Just parentClassId -> parentClassId : getParentClasses shallowParentMap parentClassId + Just parentClassId -> + parentClassId : getParentClasses shallowParentMap parentClassId getParentClass :: Maybe Text -> Word32 @@ -155,7 +155,8 @@ (filter (\(_, _, cacheId, _) -> cacheId == parentCacheId) (filter - (\(maybeClassName, _, _, _) -> maybeClassName == Just parentClassName) + (\(maybeClassName, _, _, _) -> + maybeClassName == Just parentClassName) xs)))) parentClasses :: Map.Map Text Text @@ -173,7 +174,8 @@ Map.lookup objectId (classAttributeMapObjectMap classAttributeMap) getClassName :: Text -> Maybe Text -getClassName rawObjectName = Map.lookup (normalizeObjectName rawObjectName) objectClasses +getClassName rawObjectName = + Map.lookup (normalizeObjectName rawObjectName) objectClasses normalizeObjectName :: Text -> Text normalizeObjectName objectName = diff --git a/library/Rattletrap/ClassMapping.hs b/library/Rattletrap/ClassMapping.hs --- a/library/Rattletrap/ClassMapping.hs +++ b/library/Rattletrap/ClassMapping.hs @@ -1,7 +1,6 @@ module Rattletrap.ClassMapping where -import Rattletrap.Text -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -14,7 +13,7 @@ getClassMapping = do name <- getText streamId <- getWord32 - pure ClassMapping {classMappingName = name, classMappingStreamId = streamId} + pure (ClassMapping name streamId) putClassMapping :: ClassMapping -> Binary.Put putClassMapping classMapping = do diff --git a/library/Rattletrap/CompressedWord.hs b/library/Rattletrap/CompressedWord.hs deleted file mode 100644 --- a/library/Rattletrap/CompressedWord.hs +++ /dev/null @@ -1,59 +0,0 @@ -module Rattletrap.CompressedWord where - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Bits as Bits - -data CompressedWord = CompressedWord - { compressedWordLimit :: Word - , compressedWordValue :: Word - } deriving (Eq, Ord, Show) - -getCompressedWord :: Word -> BinaryBit.BitGet CompressedWord -getCompressedWord limit = do - value <- getCompressedWordStep limit (getMaxBits limit) 0 0 - pure (CompressedWord limit value) - -putCompressedWord :: CompressedWord -> BinaryBit.BitPut () -putCompressedWord compressedWord = do - let limit = compressedWordLimit compressedWord - let value = compressedWordValue compressedWord - let maxBits = getMaxBits limit - let go position soFar = - if position < maxBits - then do - let x = Bits.shiftL 1 position - if maxBits > 1 && position == maxBits - 1 && soFar + x > limit - then pure () - else do - let bit = Bits.testBit value position - BinaryBit.putBool bit - let delta = - if bit - then x - else 0 - go (position + 1) (soFar + delta) - else pure () - go 0 0 - -getMaxBits - :: (Integral a, Integral b) - => a -> b -getMaxBits x = do - let n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) - if x < 1024 && x == 2 ^ n - then n + 1 - else n - -getCompressedWordStep :: Word -> Word -> Word -> Word -> BinaryBit.BitGet Word -getCompressedWordStep limit maxBits position value = do - let x = Bits.shiftL 1 (fromIntegral position) - if position < maxBits && value + x <= limit - then do - bit <- BinaryBit.getBool - let newValue = - if bit - then value + x - else value - getCompressedWordStep limit maxBits (position + 1) newValue - else pure value diff --git a/library/Rattletrap/CompressedWordVector.hs b/library/Rattletrap/CompressedWordVector.hs deleted file mode 100644 --- a/library/Rattletrap/CompressedWordVector.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.CompressedWordVector where - -import Rattletrap.CompressedWord - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data CompressedWordVector = CompressedWordVector - { compressedWordVectorX :: CompressedWord - , compressedWordVectorY :: CompressedWord - , compressedWordVectorZ :: CompressedWord - } deriving (Eq, Ord, Show) - -getCompressedWordVector :: BinaryBit.BitGet CompressedWordVector -getCompressedWordVector = do - let limit = 65536 - x <- getCompressedWord limit - y <- getCompressedWord limit - z <- getCompressedWord limit - pure - CompressedWordVector - { compressedWordVectorX = x - , compressedWordVectorY = y - , compressedWordVectorZ = z - } - -putCompressedWordVector :: CompressedWordVector -> BinaryBit.BitPut () -putCompressedWordVector compressedWordVector = do - putCompressedWord (compressedWordVectorX compressedWordVector) - putCompressedWord (compressedWordVectorY compressedWordVector) - putCompressedWord (compressedWordVectorZ compressedWordVector) diff --git a/library/Rattletrap/Content.hs b/library/Rattletrap/Content.hs --- a/library/Rattletrap/Content.hs +++ b/library/Rattletrap/Content.hs @@ -6,12 +6,10 @@ import Rattletrap.ClassMapping import Rattletrap.Frame import Rattletrap.KeyFrame -import Rattletrap.List import Rattletrap.Mark import Rattletrap.Message -import Rattletrap.Text +import Rattletrap.Primitive import Rattletrap.Utility -import Rattletrap.Word32 import qualified Data.Binary as Binary import qualified Data.Binary.Bits.Get as BinaryBit @@ -58,20 +56,19 @@ (reverseBytes stream) let trailingBits = reverse (dropWhile not (reverse remainingBits)) pure - Content - { contentLevels = levels - , contentKeyFrames = keyFrames - , contentStreamSize = streamSize - , contentFrames = frames - , contentTrailingBits = trailingBits - , contentMessages = messages - , contentMarks = marks - , contentPackages = packages - , contentObjects = objects - , contentNames = names - , contentClassMappings = classMappings - , contentCaches = caches - } + (Content + levels + keyFrames + streamSize + frames + trailingBits + messages + marks + packages + objects + names + classMappings + caches) putContent :: Content -> Binary.Put putContent content = do diff --git a/library/Rattletrap/Data.hs b/library/Rattletrap/Data.hs --- a/library/Rattletrap/Data.hs +++ b/library/Rattletrap/Data.hs @@ -1,6 +1,6 @@ module Rattletrap.Data where -import Rattletrap.AttributeValueType +import Rattletrap.AttributeType rawParentClasses :: [(String, String)] rawParentClasses = @@ -12,27 +12,27 @@ , ("Engine.ReplicationInfo", "Engine.Info") , ("Engine.TeamInfo", "Engine.ReplicationInfo") , ("ProjectX.GRI_X", "Engine.GameReplicationInfo") - , ("ProjectX.Pawn_X", "Engine.Pawn") , ("ProjectX.PRI_X", "Engine.PlayerReplicationInfo") + , ("ProjectX.Pawn_X", "Engine.Pawn") , ("TAGame.Ball_TA", "TAGame.RBActor_TA") , ("TAGame.CameraSettingsActor_TA", "Engine.ReplicationInfo") - , ("TAGame.Car_Season_TA", "TAGame.PRI_TA") - , ("TAGame.Car_TA", "TAGame.Vehicle_TA") , ("TAGame.CarComponent_Boost_TA", "TAGame.CarComponent_TA") , ("TAGame.CarComponent_Dodge_TA", "TAGame.CarComponent_TA") , ("TAGame.CarComponent_DoubleJump_TA", "TAGame.CarComponent_TA") , ("TAGame.CarComponent_FlipCar_TA", "TAGame.CarComponent_TA") , ("TAGame.CarComponent_Jump_TA", "TAGame.CarComponent_TA") , ("TAGame.CarComponent_TA", "Engine.ReplicationInfo") + , ("TAGame.Car_Season_TA", "TAGame.PRI_TA") + , ("TAGame.Car_TA", "TAGame.Vehicle_TA") , ("TAGame.CrowdActor_TA", "Engine.ReplicationInfo") , ("TAGame.CrowdManager_TA", "Engine.ReplicationInfo") + , ("TAGame.GRI_TA", "ProjectX.GRI_X") , ("TAGame.GameEvent_Season_TA", "TAGame.GameEvent_Soccar_TA") - , ("TAGame.GameEvent_Soccar_TA", "TAGame.GameEvent_Team_TA") , ("TAGame.GameEvent_SoccarPrivate_TA", "TAGame.GameEvent_Soccar_TA") , ("TAGame.GameEvent_SoccarSplitscreen_TA", "TAGame.GameEvent_SoccarPrivate_TA") + , ("TAGame.GameEvent_Soccar_TA", "TAGame.GameEvent_Team_TA") , ("TAGame.GameEvent_TA", "Engine.ReplicationInfo") , ("TAGame.GameEvent_Team_TA", "TAGame.GameEvent_TA") - , ("TAGame.GRI_TA", "ProjectX.GRI_X") , ("TAGame.InMapScoreboard_TA", "Engine.Actor") , ("TAGame.PRI_TA", "ProjectX.PRI_X") , ("TAGame.RBActor_TA", "ProjectX.Pawn_X") @@ -52,9 +52,9 @@ , ("TAGame.SpecialPickup_Tornado_TA", "TAGame.SpecialPickup_TA") , ("TAGame.Team_Soccar_TA", "TAGame.Team_TA") , ("TAGame.Team_TA", "Engine.TeamInfo") - , ("TAGame.Vehicle_TA", "TAGame.RBActor_TA") , ("TAGame.VehiclePickup_Boost_TA", "TAGame.VehiclePickup_TA") , ("TAGame.VehiclePickup_TA", "Engine.ReplicationInfo") + , ("TAGame.Vehicle_TA", "TAGame.RBActor_TA") , ("TAGame.VoteActor_TA", "Engine.Actor") ] @@ -62,18 +62,18 @@ rawClassesWithLocation = [ "TAGame.Ball_TA" , "TAGame.CameraSettingsActor_TA" - , "TAGame.Car_Season_TA" - , "TAGame.Car_TA" , "TAGame.CarComponent_Boost_TA" , "TAGame.CarComponent_Dodge_TA" , "TAGame.CarComponent_DoubleJump_TA" , "TAGame.CarComponent_FlipCar_TA" , "TAGame.CarComponent_Jump_TA" + , "TAGame.Car_Season_TA" + , "TAGame.Car_TA" + , "TAGame.GRI_TA" , "TAGame.GameEvent_Season_TA" - , "TAGame.GameEvent_Soccar_TA" , "TAGame.GameEvent_SoccarPrivate_TA" , "TAGame.GameEvent_SoccarSplitscreen_TA" - , "TAGame.GRI_TA" + , "TAGame.GameEvent_Soccar_TA" , "TAGame.PRI_TA" , "TAGame.SpecialPickup_BallCarSpring_TA" , "TAGame.SpecialPickup_BallFreeze_TA" @@ -116,8 +116,8 @@ , ("Archetypes.GameEvent.GameEvent_HockeyPrivate", "TAGame.GameEvent_SoccarPrivate_TA") , ("Archetypes.GameEvent.GameEvent_HockeySplitscreen", "TAGame.GameEvent_SoccarSplitscreen_TA") , ("Archetypes.GameEvent.GameEvent_Items", "TAGame.GameEvent_Soccar_TA") - , ("Archetypes.GameEvent.GameEvent_Season:CarArchetype", "TAGame.Car_TA") , ("Archetypes.GameEvent.GameEvent_Season", "TAGame.GameEvent_Season_TA") + , ("Archetypes.GameEvent.GameEvent_Season:CarArchetype", "TAGame.Car_TA") , ("Archetypes.GameEvent.GameEvent_Soccar", "TAGame.GameEvent_Soccar_TA") , ("Archetypes.GameEvent.GameEvent_SoccarPrivate", "TAGame.GameEvent_SoccarPrivate_TA") , ("Archetypes.GameEvent.GameEvent_SoccarSplitscreen", "TAGame.GameEvent_SoccarSplitscreen_TA") @@ -136,10 +136,10 @@ , ("Archetypes.Teams.Team0", "TAGame.Team_Soccar_TA") , ("Archetypes.Teams.Team1", "TAGame.Team_Soccar_TA") , ("GameInfo_Basketball.GameInfo.GameInfo_Basketball:GameReplicationInfoArchetype", "TAGame.GRI_TA") - , ("Gameinfo_Hockey.GameInfo.Gameinfo_Hockey:GameReplicationInfoArchetype", "TAGame.GRI_TA") , ("GameInfo_Items.GameInfo.GameInfo_Items:GameReplicationInfoArchetype", "TAGame.GRI_TA") , ("GameInfo_Season.GameInfo.GameInfo_Season:GameReplicationInfoArchetype", "TAGame.GRI_TA") , ("GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype", "TAGame.GRI_TA") + , ("Gameinfo_Hockey.GameInfo.Gameinfo_Hockey:GameReplicationInfoArchetype", "TAGame.GRI_TA") , ("TAGame.Default__CameraSettingsActor_TA", "TAGame.CameraSettingsActor_TA") , ("TAGame.Default__PRI_TA", "TAGame.PRI_TA") , ("TAGame.Default__VoteActor_TA", "TAGame.VoteActor_TA") @@ -149,137 +149,137 @@ , ("TheWorld:PersistentLevel.VehiclePickup_Boost_TA", "TAGame.VehiclePickup_Boost_TA") ] -rawAttributeValueTypes :: [(String, AttributeValueType)] -rawAttributeValueTypes = - [ ("Engine.Actor:bBlockActors", AVBoolean) - , ("Engine.Actor:DrawScale", AVFloat) - , ("Engine.Actor:Role", AVEnum) - , ("Engine.Actor:bCollideActors", AVBoolean) - , ("Engine.Actor:bHidden", AVBoolean) - , ("Engine.GameReplicationInfo:GameClass", AVFlaggedInt) - , ("Engine.GameReplicationInfo:ServerName", AVString) - , ("Engine.GameReplicationInfo:bMatchIsOver", AVBoolean) - , ("Engine.Pawn:PlayerReplicationInfo", AVFlaggedInt) - , ("Engine.PlayerReplicationInfo:Ping", AVByte) - , ("Engine.PlayerReplicationInfo:PlayerID", AVInt) - , ("Engine.PlayerReplicationInfo:PlayerName", AVString) - , ("Engine.PlayerReplicationInfo:RemoteUserData", AVString) - , ("Engine.PlayerReplicationInfo:Score", AVInt) - , ("Engine.PlayerReplicationInfo:Team", AVFlaggedInt) - , ("Engine.PlayerReplicationInfo:UniqueId", AVUniqueId) - , ("Engine.PlayerReplicationInfo:bBot", AVBoolean) - , ("Engine.PlayerReplicationInfo:bIsSpectator", AVBoolean) - , ("Engine.PlayerReplicationInfo:bReadyToPlay", AVBoolean) - , ("Engine.PlayerReplicationInfo:bWaitingPlayer", AVBoolean) - , ("Engine.TeamInfo:Score", AVInt) - , ("ProjectX.GRI_X:GameServerID", AVQWord) - , ("ProjectX.GRI_X:ReplicatedGameMutatorIndex", AVInt) - , ("ProjectX.GRI_X:ReplicatedGamePlaylist", AVInt) - , ("ProjectX.GRI_X:Reservations", AVReservation) - , ("ProjectX.GRI_X:bGameStarted", AVBoolean) - , ("TAGame.Ball_TA:GameEvent", AVFlaggedInt) - , ("TAGame.Ball_TA:HitTeamNum", AVByte) - , ("TAGame.Ball_TA:ReplicatedAddedCarBounceScale", AVFloat) - , ("TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale", AVFloat) - , ("TAGame.Ball_TA:ReplicatedBallScale", AVFloat) - , ("TAGame.Ball_TA:ReplicatedExplosionData", AVExplosion) - , ("TAGame.Ball_TA:ReplicatedWorldBounceScale", AVFloat) - , ("TAGame.CameraSettingsActor_TA:CameraPitch", AVByte) - , ("TAGame.CameraSettingsActor_TA:CameraYaw", AVByte) - , ("TAGame.CameraSettingsActor_TA:PRI", AVFlaggedInt) - , ("TAGame.CameraSettingsActor_TA:ProfileSettings", AVCamSettings) - , ("TAGame.CameraSettingsActor_TA:bUsingBehindView", AVBoolean) - , ("TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera", AVBoolean) - , ("TAGame.CarComponent_Boost_TA:BoostModifier", AVFloat) - , ("TAGame.CarComponent_Boost_TA:RechargeDelay", AVFloat) - , ("TAGame.CarComponent_Boost_TA:RechargeRate", AVFloat) - , ("TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount", AVByte) - , ("TAGame.CarComponent_Boost_TA:UnlimitedBoostRefCount", AVInt) - , ("TAGame.CarComponent_Boost_TA:bNoBoost", AVBoolean) - , ("TAGame.CarComponent_Boost_TA:bUnlimitedBoost", AVBoolean) - , ("TAGame.CarComponent_Dodge_TA:DodgeTorque", AVLocation) - , ("TAGame.CarComponent_FlipCar_TA:FlipCarTime", AVFloat) - , ("TAGame.CarComponent_FlipCar_TA:bFlipRight", AVBoolean) - , ("TAGame.CarComponent_TA:ReplicatedActive", AVByte) - , ("TAGame.CarComponent_TA:ReplicatedActivityTime", AVFloat) - , ("TAGame.CarComponent_TA:Vehicle", AVFlaggedInt) - , ("TAGame.Car_TA:AddedBallForceMultiplier", AVFloat) - , ("TAGame.Car_TA:AddedCarForceMultiplier", AVFloat) - , ("TAGame.Car_TA:AttachedPickup", AVFlaggedInt) - , ("TAGame.Car_TA:ClubColors", AVClubColors) - , ("TAGame.Car_TA:ReplicatedDemolish", AVDemolish) - , ("TAGame.Car_TA:TeamPaint", AVTeamPaint) - , ("TAGame.CrowdActor_TA:GameEvent", AVFlaggedInt) - , ("TAGame.CrowdActor_TA:ModifiedNoise", AVFloat) - , ("TAGame.CrowdActor_TA:ReplicatedCountDownNumber", AVInt) - , ("TAGame.CrowdActor_TA:ReplicatedOneShotSound", AVFlaggedInt) - , ("TAGame.CrowdActor_TA:ReplicatedRoundCountDownNumber", AVInt) - , ("TAGame.CrowdManager_TA:GameEvent", AVFlaggedInt) - , ("TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound", AVFlaggedInt) - , ("TAGame.GRI_TA:NewDedicatedServerIP", AVString) - , ("TAGame.GameEvent_SoccarPrivate_TA:MatchSettings", AVPrivateMatchSettings) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger", AVMusicStinger) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam", AVByte) - , ("TAGame.GameEvent_Soccar_TA:RoundNum", AVInt) - , ("TAGame.GameEvent_Soccar_TA:SecondsRemaining", AVInt) - , ("TAGame.GameEvent_Soccar_TA:SubRulesArchetype", AVFlaggedInt) - , ("TAGame.GameEvent_Soccar_TA:bBallHasBeenHit", AVBoolean) - , ("TAGame.GameEvent_Soccar_TA:bOverTime", AVBoolean) - , ("TAGame.GameEvent_TA:BotSkill", AVInt) - , ("TAGame.GameEvent_TA:GameMode", AVGameMode) - , ("TAGame.GameEvent_TA:MatchTypeClass", AVFlaggedInt) - , ("TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining", AVInt) - , ("TAGame.GameEvent_TA:ReplicatedStateIndex", AVByte) - , ("TAGame.GameEvent_TA:ReplicatedStateName", AVInt) - , ("TAGame.GameEvent_TA:bCanVoteToForfeit", AVBoolean) - , ("TAGame.GameEvent_TA:bHasLeaveMatchPenalty", AVBoolean) - , ("TAGame.GameEvent_Team_TA:MaxTeamSize", AVInt) - , ("TAGame.PRI_TA:CameraPitch", AVByte) - , ("TAGame.PRI_TA:CameraSettings", AVCamSettings) - , ("TAGame.PRI_TA:CameraYaw", AVByte) - , ("TAGame.PRI_TA:ClientLoadout", AVLoadout) - , ("TAGame.PRI_TA:ClientLoadoutOnline", AVLoadoutOnline) - , ("TAGame.PRI_TA:ClientLoadouts", AVLoadouts) - , ("TAGame.PRI_TA:ClientLoadoutsOnline", AVLoadoutsOnline) - , ("TAGame.PRI_TA:MatchAssists", AVInt) - , ("TAGame.PRI_TA:MatchGoals", AVInt) - , ("TAGame.PRI_TA:MatchSaves", AVInt) - , ("TAGame.PRI_TA:MatchScore", AVInt) - , ("TAGame.PRI_TA:MatchShots", AVInt) - , ("TAGame.PRI_TA:PartyLeader", AVPartyLeader) - , ("TAGame.PRI_TA:PawnType", AVByte) - , ("TAGame.PRI_TA:PersistentCamera", AVFlaggedInt) - , ("TAGame.PRI_TA:ReplicatedGameEvent", AVFlaggedInt) - , ("TAGame.PRI_TA:Title", AVInt) - , ("TAGame.PRI_TA:TotalXP", AVInt) - , ("TAGame.PRI_TA:bIsInSplitScreen", AVBoolean) - , ("TAGame.PRI_TA:bMatchMVP", AVBoolean) - , ("TAGame.PRI_TA:bOnlineLoadoutSet", AVBoolean) - , ("TAGame.PRI_TA:bOnlineLoadoutsSet", AVBoolean) - , ("TAGame.PRI_TA:bReady", AVBoolean) - , ("TAGame.PRI_TA:bUsingBehindView", AVBoolean) - , ("TAGame.PRI_TA:bUsingSecondaryCamera", AVBoolean) - , ("TAGame.RBActor_TA:ReplicatedRBState", AVRigidBodyState) - , ("TAGame.RBActor_TA:WeldedInfo", AVWeldedInfo) - , ("TAGame.RBActor_TA:bFrozen", AVBoolean) - , ("TAGame.RBActor_TA:bIgnoreSyncing", AVBoolean) - , ("TAGame.RBActor_TA:bReplayActor", AVBoolean) - , ("TAGame.SpecialPickup_BallFreeze_TA:RepOrigSpeed", AVFloat) - , ("TAGame.SpecialPickup_BallVelcro_TA:AttachTime", AVFloat) - , ("TAGame.SpecialPickup_BallVelcro_TA:BreakTime", AVFloat) - , ("TAGame.SpecialPickup_BallVelcro_TA:bBroken", AVBoolean) - , ("TAGame.SpecialPickup_BallVelcro_TA:bHit", AVBoolean) - , ("TAGame.SpecialPickup_Targeted_TA:Targeted", AVFlaggedInt) - , ("TAGame.Team_Soccar_TA:GameScore", AVInt) - , ("TAGame.Team_TA:ClubColors", AVClubColors) - , ("TAGame.Team_TA:CustomTeamName", AVString) - , ("TAGame.Team_TA:GameEvent", AVFlaggedInt) - , ("TAGame.Team_TA:LogoData", AVFlaggedInt) - , ("TAGame.VehiclePickup_TA:ReplicatedPickupData", AVPickup) - , ("TAGame.Vehicle_TA:ReplicatedSteer", AVByte) - , ("TAGame.Vehicle_TA:ReplicatedThrottle", AVByte) - , ("TAGame.Vehicle_TA:bDriving", AVBoolean) - , ("TAGame.Vehicle_TA:bReplicatedHandbrake", AVBoolean) +rawAttributeTypes :: [(String, AttributeType)] +rawAttributeTypes = + [ ("Engine.Actor:DrawScale", FloatAttributeType) + , ("Engine.Actor:Role", EnumAttributeType) + , ("Engine.Actor:bBlockActors", BooleanAttributeType) + , ("Engine.Actor:bCollideActors", BooleanAttributeType) + , ("Engine.Actor:bHidden", BooleanAttributeType) + , ("Engine.GameReplicationInfo:GameClass", FlaggedIntAttributeType) + , ("Engine.GameReplicationInfo:ServerName", StringAttributeType) + , ("Engine.GameReplicationInfo:bMatchIsOver", BooleanAttributeType) + , ("Engine.Pawn:PlayerReplicationInfo", FlaggedIntAttributeType) + , ("Engine.PlayerReplicationInfo:Ping", ByteAttributeType) + , ("Engine.PlayerReplicationInfo:PlayerID", IntAttributeType) + , ("Engine.PlayerReplicationInfo:PlayerName", StringAttributeType) + , ("Engine.PlayerReplicationInfo:RemoteUserData", StringAttributeType) + , ("Engine.PlayerReplicationInfo:Score", IntAttributeType) + , ("Engine.PlayerReplicationInfo:Team", FlaggedIntAttributeType) + , ("Engine.PlayerReplicationInfo:UniqueId", UniqueIdAttributeType) + , ("Engine.PlayerReplicationInfo:bBot", BooleanAttributeType) + , ("Engine.PlayerReplicationInfo:bIsSpectator", BooleanAttributeType) + , ("Engine.PlayerReplicationInfo:bReadyToPlay", BooleanAttributeType) + , ("Engine.PlayerReplicationInfo:bWaitingPlayer", BooleanAttributeType) + , ("Engine.TeamInfo:Score", IntAttributeType) + , ("ProjectX.GRI_X:GameServerID", QWordAttributeType) + , ("ProjectX.GRI_X:ReplicatedGameMutatorIndex", IntAttributeType) + , ("ProjectX.GRI_X:ReplicatedGamePlaylist", IntAttributeType) + , ("ProjectX.GRI_X:Reservations", ReservationAttributeType) + , ("ProjectX.GRI_X:bGameStarted", BooleanAttributeType) + , ("TAGame.Ball_TA:GameEvent", FlaggedIntAttributeType) + , ("TAGame.Ball_TA:HitTeamNum", ByteAttributeType) + , ("TAGame.Ball_TA:ReplicatedAddedCarBounceScale", FloatAttributeType) + , ("TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale", FloatAttributeType) + , ("TAGame.Ball_TA:ReplicatedBallScale", FloatAttributeType) + , ("TAGame.Ball_TA:ReplicatedExplosionData", ExplosionAttributeType) + , ("TAGame.Ball_TA:ReplicatedWorldBounceScale", FloatAttributeType) + , ("TAGame.CameraSettingsActor_TA:CameraPitch", ByteAttributeType) + , ("TAGame.CameraSettingsActor_TA:CameraYaw", ByteAttributeType) + , ("TAGame.CameraSettingsActor_TA:PRI", FlaggedIntAttributeType) + , ("TAGame.CameraSettingsActor_TA:ProfileSettings", CamSettingsAttributeType) + , ("TAGame.CameraSettingsActor_TA:bUsingBehindView", BooleanAttributeType) + , ("TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera", BooleanAttributeType) + , ("TAGame.CarComponent_Boost_TA:BoostModifier", FloatAttributeType) + , ("TAGame.CarComponent_Boost_TA:RechargeDelay", FloatAttributeType) + , ("TAGame.CarComponent_Boost_TA:RechargeRate", FloatAttributeType) + , ("TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount", ByteAttributeType) + , ("TAGame.CarComponent_Boost_TA:UnlimitedBoostRefCount", IntAttributeType) + , ("TAGame.CarComponent_Boost_TA:bNoBoost", BooleanAttributeType) + , ("TAGame.CarComponent_Boost_TA:bUnlimitedBoost", BooleanAttributeType) + , ("TAGame.CarComponent_Dodge_TA:DodgeTorque", LocationAttributeType) + , ("TAGame.CarComponent_FlipCar_TA:FlipCarTime", FloatAttributeType) + , ("TAGame.CarComponent_FlipCar_TA:bFlipRight", BooleanAttributeType) + , ("TAGame.CarComponent_TA:ReplicatedActive", ByteAttributeType) + , ("TAGame.CarComponent_TA:ReplicatedActivityTime", FloatAttributeType) + , ("TAGame.CarComponent_TA:Vehicle", FlaggedIntAttributeType) + , ("TAGame.Car_TA:AddedBallForceMultiplier", FloatAttributeType) + , ("TAGame.Car_TA:AddedCarForceMultiplier", FloatAttributeType) + , ("TAGame.Car_TA:AttachedPickup", FlaggedIntAttributeType) + , ("TAGame.Car_TA:ClubColors", ClubColorsAttributeType) + , ("TAGame.Car_TA:ReplicatedDemolish", DemolishAttributeType) + , ("TAGame.Car_TA:TeamPaint", TeamPaintAttributeType) + , ("TAGame.CrowdActor_TA:GameEvent", FlaggedIntAttributeType) + , ("TAGame.CrowdActor_TA:ModifiedNoise", FloatAttributeType) + , ("TAGame.CrowdActor_TA:ReplicatedCountDownNumber", IntAttributeType) + , ("TAGame.CrowdActor_TA:ReplicatedOneShotSound", FlaggedIntAttributeType) + , ("TAGame.CrowdActor_TA:ReplicatedRoundCountDownNumber", IntAttributeType) + , ("TAGame.CrowdManager_TA:GameEvent", FlaggedIntAttributeType) + , ("TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound", FlaggedIntAttributeType) + , ("TAGame.GRI_TA:NewDedicatedServerIP", StringAttributeType) + , ("TAGame.GameEvent_SoccarPrivate_TA:MatchSettings", PrivateMatchSettingsAttributeType) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger", MusicStingerAttributeType) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam", ByteAttributeType) + , ("TAGame.GameEvent_Soccar_TA:RoundNum", IntAttributeType) + , ("TAGame.GameEvent_Soccar_TA:SecondsRemaining", IntAttributeType) + , ("TAGame.GameEvent_Soccar_TA:SubRulesArchetype", FlaggedIntAttributeType) + , ("TAGame.GameEvent_Soccar_TA:bBallHasBeenHit", BooleanAttributeType) + , ("TAGame.GameEvent_Soccar_TA:bOverTime", BooleanAttributeType) + , ("TAGame.GameEvent_TA:BotSkill", IntAttributeType) + , ("TAGame.GameEvent_TA:GameMode", GameModeAttributeType) + , ("TAGame.GameEvent_TA:MatchTypeClass", FlaggedIntAttributeType) + , ("TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining", IntAttributeType) + , ("TAGame.GameEvent_TA:ReplicatedStateIndex", ByteAttributeType) + , ("TAGame.GameEvent_TA:ReplicatedStateName", IntAttributeType) + , ("TAGame.GameEvent_TA:bCanVoteToForfeit", BooleanAttributeType) + , ("TAGame.GameEvent_TA:bHasLeaveMatchPenalty", BooleanAttributeType) + , ("TAGame.GameEvent_Team_TA:MaxTeamSize", IntAttributeType) + , ("TAGame.PRI_TA:CameraPitch", ByteAttributeType) + , ("TAGame.PRI_TA:CameraSettings", CamSettingsAttributeType) + , ("TAGame.PRI_TA:CameraYaw", ByteAttributeType) + , ("TAGame.PRI_TA:ClientLoadout", LoadoutAttributeType) + , ("TAGame.PRI_TA:ClientLoadoutOnline", LoadoutOnlineAttributeType) + , ("TAGame.PRI_TA:ClientLoadouts", LoadoutsAttributeType) + , ("TAGame.PRI_TA:ClientLoadoutsOnline", LoadoutsOnlineAttributeType) + , ("TAGame.PRI_TA:MatchAssists", IntAttributeType) + , ("TAGame.PRI_TA:MatchGoals", IntAttributeType) + , ("TAGame.PRI_TA:MatchSaves", IntAttributeType) + , ("TAGame.PRI_TA:MatchScore", IntAttributeType) + , ("TAGame.PRI_TA:MatchShots", IntAttributeType) + , ("TAGame.PRI_TA:PartyLeader", PartyLeaderAttributeType) + , ("TAGame.PRI_TA:PawnType", ByteAttributeType) + , ("TAGame.PRI_TA:PersistentCamera", FlaggedIntAttributeType) + , ("TAGame.PRI_TA:ReplicatedGameEvent", FlaggedIntAttributeType) + , ("TAGame.PRI_TA:Title", IntAttributeType) + , ("TAGame.PRI_TA:TotalXP", IntAttributeType) + , ("TAGame.PRI_TA:bIsInSplitScreen", BooleanAttributeType) + , ("TAGame.PRI_TA:bMatchMVP", BooleanAttributeType) + , ("TAGame.PRI_TA:bOnlineLoadoutSet", BooleanAttributeType) + , ("TAGame.PRI_TA:bOnlineLoadoutsSet", BooleanAttributeType) + , ("TAGame.PRI_TA:bReady", BooleanAttributeType) + , ("TAGame.PRI_TA:bUsingBehindView", BooleanAttributeType) + , ("TAGame.PRI_TA:bUsingSecondaryCamera", BooleanAttributeType) + , ("TAGame.RBActor_TA:ReplicatedRBState", RigidBodyStateAttributeType) + , ("TAGame.RBActor_TA:WeldedInfo", WeldedInfoAttributeType) + , ("TAGame.RBActor_TA:bFrozen", BooleanAttributeType) + , ("TAGame.RBActor_TA:bIgnoreSyncing", BooleanAttributeType) + , ("TAGame.RBActor_TA:bReplayActor", BooleanAttributeType) + , ("TAGame.SpecialPickup_BallFreeze_TA:RepOrigSpeed", FloatAttributeType) + , ("TAGame.SpecialPickup_BallVelcro_TA:AttachTime", FloatAttributeType) + , ("TAGame.SpecialPickup_BallVelcro_TA:BreakTime", FloatAttributeType) + , ("TAGame.SpecialPickup_BallVelcro_TA:bBroken", BooleanAttributeType) + , ("TAGame.SpecialPickup_BallVelcro_TA:bHit", BooleanAttributeType) + , ("TAGame.SpecialPickup_Targeted_TA:Targeted", FlaggedIntAttributeType) + , ("TAGame.Team_Soccar_TA:GameScore", IntAttributeType) + , ("TAGame.Team_TA:ClubColors", ClubColorsAttributeType) + , ("TAGame.Team_TA:CustomTeamName", StringAttributeType) + , ("TAGame.Team_TA:GameEvent", FlaggedIntAttributeType) + , ("TAGame.Team_TA:LogoData", FlaggedIntAttributeType) + , ("TAGame.VehiclePickup_TA:ReplicatedPickupData", PickupAttributeType) + , ("TAGame.Vehicle_TA:ReplicatedSteer", ByteAttributeType) + , ("TAGame.Vehicle_TA:ReplicatedThrottle", ByteAttributeType) + , ("TAGame.Vehicle_TA:bDriving", BooleanAttributeType) + , ("TAGame.Vehicle_TA:bReplicatedHandbrake", BooleanAttributeType) ] rawCrc32Table :: Integral a => [a] diff --git a/library/Rattletrap/Dictionary.hs b/library/Rattletrap/Dictionary.hs deleted file mode 100644 --- a/library/Rattletrap/Dictionary.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Dictionary where - -import Rattletrap.Text - -import qualified Data.Binary as Binary - -newtype Dictionary a = Dictionary - { dictionaryValue :: [(Text, Maybe a)] - } deriving (Eq, Ord, Show) - -getDictionary :: Binary.Get a -> Binary.Get (Dictionary a) -getDictionary getValue = do - key <- getText - if isNoneKey key - then pure (Dictionary [(key, Nothing)]) - else do - value <- getValue - let element = (key, Just value) - Dictionary elements <- getDictionary getValue - pure (Dictionary (element : elements)) - -putDictionary :: (a -> Binary.Put) -> Dictionary a -> Binary.Put -putDictionary putValue (Dictionary elements) = - mapM_ - (\(key, maybeValue) -> do - putText key - case maybeValue of - Nothing -> pure () - Just value -> putValue value) - elements - -isNoneKey :: Text -> Bool -isNoneKey text = filter (/= '\x00') (textToString text) == "None" diff --git a/library/Rattletrap/Float32.hs b/library/Rattletrap/Float32.hs deleted file mode 100644 --- a/library/Rattletrap/Float32.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Float32 where - -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.IEEE754 as IEEE754 -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString - -newtype Float32 = Float32 - { float32Value :: Float - } deriving (Eq, Ord, Show) - -getFloat32 :: Binary.Get Float32 -getFloat32 = do - float32 <- IEEE754.getFloat32le - pure (Float32 float32) - -putFloat32 :: Float32 -> Binary.Put -putFloat32 float32 = IEEE754.putFloat32le (float32Value float32) - -getFloat32Bits :: BinaryBit.BitGet Float32 -getFloat32Bits = do - bytes <- BinaryBit.getLazyByteString 4 - pure (Binary.runGet getFloat32 (reverseBytes bytes)) - -putFloat32Bits :: Float32 -> BinaryBit.BitPut () -putFloat32Bits float32 = do - let bytes = Binary.runPut (putFloat32 float32) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Frame.hs b/library/Rattletrap/Frame.hs --- a/library/Rattletrap/Frame.hs +++ b/library/Rattletrap/Frame.hs @@ -2,7 +2,7 @@ import Rattletrap.ActorMap import Rattletrap.ClassAttributeMap -import Rattletrap.Float32 +import Rattletrap.Primitive import Rattletrap.Replication import qualified Data.Binary.Bits.Get as BinaryBit @@ -42,10 +42,7 @@ delta <- getFloat32Bits (replications, newActorMap) <- getReplications version classAttributeMap actorMap - pure - ( Frame - {frameTime = time, frameDelta = delta, frameReplications = replications} - , newActorMap) + pure (Frame time delta replications, newActorMap) putFrame :: Frame -> BinaryBit.BitPut () putFrame frame = do diff --git a/library/Rattletrap/Header.hs b/library/Rattletrap/Header.hs --- a/library/Rattletrap/Header.hs +++ b/library/Rattletrap/Header.hs @@ -1,11 +1,8 @@ module Rattletrap.Header where -import Rattletrap.Dictionary -import Rattletrap.Int32 +import Rattletrap.Primitive import Rattletrap.Property import Rattletrap.PropertyValue -import Rattletrap.Text -import Rattletrap.Word32 import qualified Data.Binary as Binary @@ -22,13 +19,7 @@ licenseeVersion <- getWord32 label <- getText properties <- getDictionary getProperty - pure - Header - { headerEngineVersion = engineVersion - , headerLicenseeVersion = licenseeVersion - , headerLabel = label - , headerProperties = properties - } + pure (Header engineVersion licenseeVersion label properties) putHeader :: Header -> Binary.Put putHeader header = do diff --git a/library/Rattletrap/Initialization.hs b/library/Rattletrap/Initialization.hs --- a/library/Rattletrap/Initialization.hs +++ b/library/Rattletrap/Initialization.hs @@ -1,7 +1,6 @@ module Rattletrap.Initialization where -import Rattletrap.Int8Vector -import Rattletrap.Vector +import Rattletrap.Primitive import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit @@ -25,9 +24,7 @@ rotation <- getInt8Vector pure (Just rotation) else pure Nothing - pure - Initialization - {initializationLocation = location, initializationRotation = rotation} + pure (Initialization location rotation) putInitialization :: Initialization -> BinaryBit.BitPut () putInitialization initialization = do diff --git a/library/Rattletrap/Int32.hs b/library/Rattletrap/Int32.hs deleted file mode 100644 --- a/library/Rattletrap/Int32.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Int32 where - -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Int as Int - -newtype Int32 = Int32 - { int32Value :: Int.Int32 - } deriving (Eq, Ord, Show) - -getInt32 :: Binary.Get Int32 -getInt32 = do - int32 <- Binary.getInt32le - pure (Int32 int32) - -putInt32 :: Int32 -> Binary.Put -putInt32 (Int32 int32) = Binary.putInt32le int32 - -getInt32Bits :: BinaryBit.BitGet Int32 -getInt32Bits = do - bytes <- BinaryBit.getLazyByteString 4 - pure (Binary.runGet getInt32 (reverseBytes bytes)) - -putInt32Bits :: Int32 -> BinaryBit.BitPut () -putInt32Bits int32 = do - let bytes = Binary.runPut (putInt32 int32) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Int8.hs b/library/Rattletrap/Int8.hs deleted file mode 100644 --- a/library/Rattletrap/Int8.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Rattletrap.Int8 where - -import Rattletrap.Utility - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Int as Int - -newtype Int8 = Int8 - { int8Value :: Int.Int8 - } deriving (Eq, Ord, Show) - -getInt8 :: Binary.Get Int8 -getInt8 = do - int8 <- Binary.getInt8 - pure (Int8 int8) - -putInt8 :: Int8 -> Binary.Put -putInt8 int8 = Binary.putInt8 (int8Value int8) - -getInt8Bits :: BinaryBit.BitGet Int8 -getInt8Bits = do - bytes <- BinaryBit.getLazyByteString 1 - pure (Binary.runGet getInt8 (reverseBytes bytes)) - -putInt8Bits :: Int8 -> BinaryBit.BitPut () -putInt8Bits int8 = do - let bytes = Binary.runPut (putInt8 int8) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Int8Vector.hs b/library/Rattletrap/Int8Vector.hs deleted file mode 100644 --- a/library/Rattletrap/Int8Vector.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Rattletrap.Int8Vector where - -import Rattletrap.Int8 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data Int8Vector = Int8Vector - { int8VectorX :: Maybe Int8 - , int8VectorY :: Maybe Int8 - , int8VectorZ :: Maybe Int8 - } deriving (Eq, Ord, Show) - -getInt8Vector :: BinaryBit.BitGet Int8Vector -getInt8Vector = do - x <- getInt8VectorField - y <- getInt8VectorField - z <- getInt8VectorField - pure Int8Vector {int8VectorX = x, int8VectorY = y, int8VectorZ = z} - -putInt8Vector :: Int8Vector -> BinaryBit.BitPut () -putInt8Vector int8Vector = do - putInt8VectorField (int8VectorX int8Vector) - putInt8VectorField (int8VectorY int8Vector) - putInt8VectorField (int8VectorZ int8Vector) - -getInt8VectorField :: BinaryBit.BitGet (Maybe Int8) -getInt8VectorField = do - hasField <- BinaryBit.getBool - if hasField - then do - field <- getInt8Bits - pure (Just field) - else pure Nothing - -putInt8VectorField :: Maybe Int8 -> BinaryBit.BitPut () -putInt8VectorField maybeField = - case maybeField of - Nothing -> BinaryBit.putBool False - Just field -> do - BinaryBit.putBool True - putInt8Bits field diff --git a/library/Rattletrap/Json.hs b/library/Rattletrap/Json.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Json.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Rattletrap.Json where + +import Rattletrap.Attribute +import Rattletrap.AttributeMapping +import Rattletrap.AttributeValue +import Rattletrap.Cache +import Rattletrap.ClassMapping +import Rattletrap.Content +import Rattletrap.Frame +import Rattletrap.Header +import Rattletrap.Initialization +import Rattletrap.KeyFrame +import Rattletrap.Mark +import Rattletrap.Message +import Rattletrap.Primitive +import Rattletrap.Property +import Rattletrap.PropertyValue +import Rattletrap.RemoteId +import Rattletrap.Replay +import Rattletrap.Replication +import Rattletrap.ReplicationValue + +import qualified Control.Monad as Monad +import qualified Data.Aeson.Casing as Casing +import qualified Data.Aeson.TH as Aeson +import qualified Language.Haskell.TH as TH + +$(let optionsFor name = + (Casing.aesonDrop (length (TH.nameBase name)) Casing.snakeCase) + { Aeson.constructorTagModifier = Casing.snakeCase + , Aeson.omitNothingFields = True + , Aeson.sumEncoding = Aeson.ObjectWithSingleField + , Aeson.unwrapUnaryRecords = True + } + deriveJSON declarations name = do + newDeclarations <- Aeson.deriveJSON (optionsFor name) name + pure (newDeclarations ++ declarations) + names = + [ ''Attribute + , ''AttributeMapping + , ''AttributeValue + , ''BooleanAttribute + , ''ByteAttribute + , ''Cache + , ''CamSettingsAttribute + , ''ClassMapping + , ''ClubColorsAttribute + , ''CompressedWord + , ''CompressedWordVector + , ''Content + , ''DemolishAttribute + , ''DestroyedReplication + , ''Dictionary + , ''EnumAttribute + , ''ExplosionAttribute + , ''FlaggedIntAttribute + , ''Float32 + , ''FloatAttribute + , ''Frame + , ''GameModeAttribute + , ''Header + , ''Initialization + , ''Int32 + , ''Int8 + , ''Int8Vector + , ''IntAttribute + , ''KeyFrame + , ''List + , ''LoadoutAttribute + , ''LoadoutOnlineAttribute + , ''LoadoutsAttribute + , ''LoadoutsOnlineAttribute + , ''LocationAttribute + , ''Mark + , ''Message + , ''MusicStingerAttribute + , ''PartyLeaderAttribute + , ''PickupAttribute + , ''PrivateMatchSettingsAttribute + , ''Property + , ''PropertyValue + , ''QWordAttribute + , ''RemoteId + , ''Replay + , ''Replication + , ''ReplicationValue + , ''ReservationAttribute + , ''RigidBodyStateAttribute + , ''Section + , ''SpawnedReplication + , ''StringAttribute + , ''TeamPaintAttribute + , ''Text + , ''UniqueIdAttribute + , ''UpdatedReplication + , ''Vector + , ''WeldedInfoAttribute + , ''Word32 + , ''Word64 + , ''Word8 + ] + in Monad.foldM deriveJSON [] names) diff --git a/library/Rattletrap/KeyFrame.hs b/library/Rattletrap/KeyFrame.hs --- a/library/Rattletrap/KeyFrame.hs +++ b/library/Rattletrap/KeyFrame.hs @@ -1,7 +1,6 @@ module Rattletrap.KeyFrame where -import Rattletrap.Float32 -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -16,9 +15,7 @@ time <- getFloat32 frame <- getWord32 position <- getWord32 - pure - KeyFrame - {keyFrameTime = time, keyFrameFrame = frame, keyFramePosition = position} + pure (KeyFrame time frame position) putKeyFrame :: KeyFrame -> Binary.Put putKeyFrame keyFrame = do diff --git a/library/Rattletrap/List.hs b/library/Rattletrap/List.hs deleted file mode 100644 --- a/library/Rattletrap/List.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.List where - -import Rattletrap.Word32 - -import qualified Control.Monad as Monad -import qualified Data.Binary as Binary - -newtype List a = List - { listValue :: [a] - } deriving (Eq, Ord, Show) - -getList :: Binary.Get a -> Binary.Get (List a) -getList getElement = do - size <- getWord32 - elements <- Monad.replicateM (fromIntegral (word32Value size)) getElement - pure (List elements) - -putList :: (a -> Binary.Put) -> List a -> Binary.Put -putList putElement (List elements) = do - putWord32 (Word32 (fromIntegral (length elements))) - mapM_ putElement elements diff --git a/library/Rattletrap/Main.hs b/library/Rattletrap/Main.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Main.hs @@ -0,0 +1,47 @@ +module Rattletrap.Main where + +import Rattletrap.Json () +import Rattletrap.Replay +import Rattletrap.Version + +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Version as Version +import qualified System.Environment as Environment + +main :: IO () +main = do + args <- Environment.getArgs + mainWithArgs args + +mainWithArgs :: [String] -> IO () +mainWithArgs args = + case args of + ["version"] -> putStrLn (Version.showVersion version) + "decode":files -> do + (getInput, putOutput) <- getIO files + input <- getInput + let replay = Binary.runGet getReplay input + let output = Aeson.encode replay + putOutput output + "encode":files -> do + (getInput, putOutput) <- getIO files + input <- getInput + case Aeson.eitherDecode input of + Left message -> fail ("could not parse JSON: " ++ message) + Right replay -> do + let output = Binary.runPut (putReplay replay) + putOutput output + _ -> fail ("unexpected arguments " ++ show args) + +getIO + :: Monad m + => [FilePath] -> m (IO ByteString.ByteString, ByteString.ByteString -> IO ()) +getIO files = + case files of + [] -> pure (ByteString.getContents, ByteString.putStr) + [i] -> pure (ByteString.readFile i, ByteString.putStr) + [i, o] -> pure (ByteString.readFile i, ByteString.writeFile o) + _ -> fail ("unexpected arguments " ++ show files) diff --git a/library/Rattletrap/Mark.hs b/library/Rattletrap/Mark.hs --- a/library/Rattletrap/Mark.hs +++ b/library/Rattletrap/Mark.hs @@ -1,7 +1,6 @@ module Rattletrap.Mark where -import Rattletrap.Text -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -14,7 +13,7 @@ getMark = do value <- getText frame <- getWord32 - pure Mark {markValue = value, markFrame = frame} + pure (Mark value frame) putMark :: Mark -> Binary.Put putMark mark = do diff --git a/library/Rattletrap/Message.hs b/library/Rattletrap/Message.hs --- a/library/Rattletrap/Message.hs +++ b/library/Rattletrap/Message.hs @@ -1,7 +1,6 @@ module Rattletrap.Message where -import Rattletrap.Text -import Rattletrap.Word32 +import Rattletrap.Primitive import qualified Data.Binary as Binary @@ -16,7 +15,7 @@ frame <- getWord32 name <- getText value <- getText - pure Message {messageFrame = frame, messageName = name, messageValue = value} + pure (Message frame name value) putMessage :: Message -> Binary.Put putMessage message = do diff --git a/library/Rattletrap/Primitive.hs b/library/Rattletrap/Primitive.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive.hs @@ -0,0 +1,31 @@ +module Rattletrap.Primitive + ( module Rattletrap.Primitive.CompressedWord + , module Rattletrap.Primitive.CompressedWordVector + , module Rattletrap.Primitive.Dictionary + , module Rattletrap.Primitive.Float32 + , module Rattletrap.Primitive.Int8 + , module Rattletrap.Primitive.Int8Vector + , module Rattletrap.Primitive.Int32 + , module Rattletrap.Primitive.List + , module Rattletrap.Primitive.Section + , module Rattletrap.Primitive.Text + , module Rattletrap.Primitive.Vector + , module Rattletrap.Primitive.Word8 + , module Rattletrap.Primitive.Word32 + , module Rattletrap.Primitive.Word64 + ) where + +import Rattletrap.Primitive.CompressedWord +import Rattletrap.Primitive.CompressedWordVector +import Rattletrap.Primitive.Dictionary +import Rattletrap.Primitive.Float32 +import Rattletrap.Primitive.Int8 +import Rattletrap.Primitive.Int8Vector +import Rattletrap.Primitive.Int32 +import Rattletrap.Primitive.List +import Rattletrap.Primitive.Section +import Rattletrap.Primitive.Text +import Rattletrap.Primitive.Vector +import Rattletrap.Primitive.Word8 +import Rattletrap.Primitive.Word32 +import Rattletrap.Primitive.Word64 diff --git a/library/Rattletrap/Primitive/CompressedWord.hs b/library/Rattletrap/Primitive/CompressedWord.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/CompressedWord.hs @@ -0,0 +1,59 @@ +module Rattletrap.Primitive.CompressedWord where + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Bits as Bits + +data CompressedWord = CompressedWord + { compressedWordLimit :: Word + , compressedWordValue :: Word + } deriving (Eq, Ord, Show) + +getCompressedWord :: Word -> BinaryBit.BitGet CompressedWord +getCompressedWord limit = do + value <- getCompressedWordStep limit (getMaxBits limit) 0 0 + pure (CompressedWord limit value) + +putCompressedWord :: CompressedWord -> BinaryBit.BitPut () +putCompressedWord compressedWord = do + let limit = compressedWordLimit compressedWord + let value = compressedWordValue compressedWord + let maxBits = getMaxBits limit + let go position soFar = + if position < maxBits + then do + let x = Bits.shiftL 1 position + if maxBits > 1 && position == maxBits - 1 && soFar + x > limit + then pure () + else do + let bit = Bits.testBit value position + BinaryBit.putBool bit + let delta = + if bit + then x + else 0 + go (position + 1) (soFar + delta) + else pure () + go 0 0 + +getMaxBits + :: (Integral a, Integral b) + => a -> b +getMaxBits x = do + let n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) + if x < 1024 && x == 2 ^ n + then n + 1 + else n + +getCompressedWordStep :: Word -> Word -> Word -> Word -> BinaryBit.BitGet Word +getCompressedWordStep limit maxBits position value = do + let x = Bits.shiftL 1 (fromIntegral position) + if position < maxBits && value + x <= limit + then do + bit <- BinaryBit.getBool + let newValue = + if bit + then value + x + else value + getCompressedWordStep limit maxBits (position + 1) newValue + else pure value diff --git a/library/Rattletrap/Primitive/CompressedWordVector.hs b/library/Rattletrap/Primitive/CompressedWordVector.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/CompressedWordVector.hs @@ -0,0 +1,26 @@ +module Rattletrap.Primitive.CompressedWordVector where + +import Rattletrap.Primitive.CompressedWord + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data CompressedWordVector = CompressedWordVector + { compressedWordVectorX :: CompressedWord + , compressedWordVectorY :: CompressedWord + , compressedWordVectorZ :: CompressedWord + } deriving (Eq, Ord, Show) + +getCompressedWordVector :: BinaryBit.BitGet CompressedWordVector +getCompressedWordVector = do + let limit = 65536 + x <- getCompressedWord limit + y <- getCompressedWord limit + z <- getCompressedWord limit + pure (CompressedWordVector x y z) + +putCompressedWordVector :: CompressedWordVector -> BinaryBit.BitPut () +putCompressedWordVector compressedWordVector = do + putCompressedWord (compressedWordVectorX compressedWordVector) + putCompressedWord (compressedWordVectorY compressedWordVector) + putCompressedWord (compressedWordVectorZ compressedWordVector) diff --git a/library/Rattletrap/Primitive/Dictionary.hs b/library/Rattletrap/Primitive/Dictionary.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Dictionary.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Dictionary where + +import Rattletrap.Primitive.Text + +import qualified Data.Binary as Binary + +newtype Dictionary a = Dictionary + { dictionaryValue :: [(Text, Maybe a)] + } deriving (Eq, Ord, Show) + +getDictionary :: Binary.Get a -> Binary.Get (Dictionary a) +getDictionary getValue = do + key <- getText + if isNoneKey key + then pure (Dictionary [(key, Nothing)]) + else do + value <- getValue + let element = (key, Just value) + Dictionary elements <- getDictionary getValue + pure (Dictionary (element : elements)) + +putDictionary :: (a -> Binary.Put) -> Dictionary a -> Binary.Put +putDictionary putValue dictionary = + mapM_ + (\(key, maybeValue) -> do + putText key + case maybeValue of + Nothing -> pure () + Just value -> putValue value) + (dictionaryValue dictionary) + +isNoneKey :: Text -> Bool +isNoneKey text = filter (/= '\x00') (textToString text) == "None" diff --git a/library/Rattletrap/Primitive/Float32.hs b/library/Rattletrap/Primitive/Float32.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Float32.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Float32 where + +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.IEEE754 as IEEE754 +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString + +newtype Float32 = Float32 + { float32Value :: Float + } deriving (Eq, Ord, Show) + +getFloat32 :: Binary.Get Float32 +getFloat32 = do + float32 <- IEEE754.getFloat32le + pure (Float32 float32) + +putFloat32 :: Float32 -> Binary.Put +putFloat32 float32 = IEEE754.putFloat32le (float32Value float32) + +getFloat32Bits :: BinaryBit.BitGet Float32 +getFloat32Bits = do + bytes <- BinaryBit.getLazyByteString 4 + pure (Binary.runGet getFloat32 (reverseBytes bytes)) + +putFloat32Bits :: Float32 -> BinaryBit.BitPut () +putFloat32Bits float32 = do + let bytes = Binary.runPut (putFloat32 float32) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Primitive/Int32.hs b/library/Rattletrap/Primitive/Int32.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Int32.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Int32 where + +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Int as Int + +newtype Int32 = Int32 + { int32Value :: Int.Int32 + } deriving (Eq, Ord, Show) + +getInt32 :: Binary.Get Int32 +getInt32 = do + int32 <- Binary.getInt32le + pure (Int32 int32) + +putInt32 :: Int32 -> Binary.Put +putInt32 int32 = Binary.putInt32le (int32Value int32) + +getInt32Bits :: BinaryBit.BitGet Int32 +getInt32Bits = do + bytes <- BinaryBit.getLazyByteString 4 + pure (Binary.runGet getInt32 (reverseBytes bytes)) + +putInt32Bits :: Int32 -> BinaryBit.BitPut () +putInt32Bits int32 = do + let bytes = Binary.runPut (putInt32 int32) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Primitive/Int8.hs b/library/Rattletrap/Primitive/Int8.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Int8.hs @@ -0,0 +1,32 @@ +module Rattletrap.Primitive.Int8 where + +import Rattletrap.Utility + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Int as Int + +newtype Int8 = Int8 + { int8Value :: Int.Int8 + } deriving (Eq, Ord, Show) + +getInt8 :: Binary.Get Int8 +getInt8 = do + int8 <- Binary.getInt8 + pure (Int8 int8) + +putInt8 :: Int8 -> Binary.Put +putInt8 int8 = Binary.putInt8 (int8Value int8) + +getInt8Bits :: BinaryBit.BitGet Int8 +getInt8Bits = do + bytes <- BinaryBit.getLazyByteString 1 + pure (Binary.runGet getInt8 (reverseBytes bytes)) + +putInt8Bits :: Int8 -> BinaryBit.BitPut () +putInt8Bits int8 = do + let bytes = Binary.runPut (putInt8 int8) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Primitive/Int8Vector.hs b/library/Rattletrap/Primitive/Int8Vector.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Int8Vector.hs @@ -0,0 +1,42 @@ +module Rattletrap.Primitive.Int8Vector where + +import Rattletrap.Primitive.Int8 + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data Int8Vector = Int8Vector + { int8VectorX :: Maybe Int8 + , int8VectorY :: Maybe Int8 + , int8VectorZ :: Maybe Int8 + } deriving (Eq, Ord, Show) + +getInt8Vector :: BinaryBit.BitGet Int8Vector +getInt8Vector = do + x <- getInt8VectorField + y <- getInt8VectorField + z <- getInt8VectorField + pure (Int8Vector x y z) + +putInt8Vector :: Int8Vector -> BinaryBit.BitPut () +putInt8Vector int8Vector = do + putInt8VectorField (int8VectorX int8Vector) + putInt8VectorField (int8VectorY int8Vector) + putInt8VectorField (int8VectorZ int8Vector) + +getInt8VectorField :: BinaryBit.BitGet (Maybe Int8) +getInt8VectorField = do + hasField <- BinaryBit.getBool + if hasField + then do + field <- getInt8Bits + pure (Just field) + else pure Nothing + +putInt8VectorField :: Maybe Int8 -> BinaryBit.BitPut () +putInt8VectorField maybeField = + case maybeField of + Nothing -> BinaryBit.putBool False + Just field -> do + BinaryBit.putBool True + putInt8Bits field diff --git a/library/Rattletrap/Primitive/List.hs b/library/Rattletrap/Primitive/List.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/List.hs @@ -0,0 +1,22 @@ +module Rattletrap.Primitive.List where + +import Rattletrap.Primitive.Word32 + +import qualified Control.Monad as Monad +import qualified Data.Binary as Binary + +newtype List a = List + { listValue :: [a] + } deriving (Eq, Ord, Show) + +getList :: Binary.Get a -> Binary.Get (List a) +getList getElement = do + size <- getWord32 + elements <- Monad.replicateM (fromIntegral (word32Value size)) getElement + pure (List elements) + +putList :: (a -> Binary.Put) -> List a -> Binary.Put +putList putElement list = do + let elements = listValue list + putWord32 (Word32 (fromIntegral (length elements))) + mapM_ putElement elements diff --git a/library/Rattletrap/Primitive/Section.hs b/library/Rattletrap/Primitive/Section.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Section.hs @@ -0,0 +1,38 @@ +module Rattletrap.Primitive.Section where + +import Rattletrap.Crc +import Rattletrap.Primitive.Word32 + +import qualified Control.Monad as Monad +import qualified Data.Binary as Binary +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString + +newtype Section a = Section + { sectionBody :: a + } deriving (Eq, Ord, Show) + +getSection :: Binary.Get a -> Binary.Get (Section a) +getSection getBody = do + size <- getWord32 + crc <- getWord32 + rawBody <- Binary.getLazyByteString (fromIntegral (word32Value size)) + let actualCrc = Word32 (getCrc32 rawBody) + Monad.when (actualCrc /= crc) (fail (crcMessage actualCrc crc)) + let body = Binary.runGet getBody rawBody + pure (Section body) + +putSection :: (a -> Binary.Put) -> Section a -> Binary.Put +putSection putBody section = do + let rawBody = Binary.runPut (putBody (sectionBody section)) + let size = ByteString.length rawBody + let crc = getCrc32 rawBody + putWord32 (Word32 (fromIntegral size)) + putWord32 (Word32 crc) + Binary.putLazyByteString rawBody + +crcMessage :: Word32 -> Word32 -> String +crcMessage actual expected = + unwords + ["actual CRC", show actual, "does not match expected CRC", show expected] diff --git a/library/Rattletrap/Primitive/Text.hs b/library/Rattletrap/Primitive/Text.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Text.hs @@ -0,0 +1,88 @@ +module Rattletrap.Primitive.Text where + +import Rattletrap.Primitive.Int32 +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy.Char8 as ByteString +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding + +data Text = Text + { textSize :: Int32 + , textValue :: Text.Text + } deriving (Eq, Ord, Show) + +getText :: Binary.Get Text +getText = do + rawSize <- getInt32 + let decode = getTextDecoder rawSize + let size = getTextSize rawSize + bytes <- Binary.getLazyByteString size + let text = decode bytes + pure (Text rawSize text) + +putText :: Text -> Binary.Put +putText text = do + let size = textSize text + let encode = getTextEncoder size + putInt32 size + Binary.putLazyByteString (encode (textValue text)) + +getTextBits :: BinaryBit.BitGet Text +getTextBits = do + rawSize <- getInt32Bits + let decode = getTextDecoder rawSize + let size = getTextSize rawSize + bytes <- BinaryBit.getLazyByteString size + let text = decode (reverseBytes bytes) + pure (Text rawSize text) + +putTextBits :: Text -> BinaryBit.BitPut () +putTextBits text = do + let size = textSize text + let encode = getTextEncoder size + putInt32Bits size + BinaryBit.putByteString + (ByteString.toStrict (reverseBytes (encode (textValue text)))) + +stringToText :: String -> Text +stringToText string = + let value = Text.snoc (Text.pack string) '\x00' + size = Int32 (fromIntegral (Text.length value)) + in Text size value + +textToString :: Text -> String +textToString text = Text.unpack (Text.dropWhileEnd (== '\x00') (textValue text)) + +getTextSize + :: Integral a + => Int32 -> a +getTextSize size = + case int32Value size of + 0x05000000 -> 8 + x -> + if x < 0 + then (-2 * fromIntegral x) + else fromIntegral x + +getTextDecoder :: Int32 -> ByteString.ByteString -> Text.Text +getTextDecoder size bytes = + let decode = + if size < Int32 0 + then Encoding.decodeUtf16LE + else Encoding.decodeLatin1 + in decode (ByteString.toStrict bytes) + +getTextEncoder :: Int32 -> Text.Text -> ByteString.ByteString +getTextEncoder size text = + if size < Int32 0 + then ByteString.fromStrict (Encoding.encodeUtf16LE text) + else encodeLatin1 text + +encodeLatin1 :: Text.Text -> ByteString.ByteString +encodeLatin1 text = ByteString.pack (Text.unpack text) diff --git a/library/Rattletrap/Primitive/Vector.hs b/library/Rattletrap/Primitive/Vector.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Vector.hs @@ -0,0 +1,29 @@ +module Rattletrap.Primitive.Vector where + +import Rattletrap.Primitive.CompressedWord + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data Vector = Vector + { vectorBitSize :: CompressedWord + , vectorDx :: CompressedWord + , vectorDy :: CompressedWord + , vectorDz :: CompressedWord + } deriving (Eq, Ord, Show) + +getVector :: BinaryBit.BitGet Vector +getVector = do + bitSize <- getCompressedWord 19 + let limit = 2 ^ (compressedWordValue bitSize + 2) + dx <- getCompressedWord limit + dy <- getCompressedWord limit + dz <- getCompressedWord limit + pure (Vector bitSize dx dy dz) + +putVector :: Vector -> BinaryBit.BitPut () +putVector vector = do + putCompressedWord (vectorBitSize vector) + putCompressedWord (vectorDx vector) + putCompressedWord (vectorDy vector) + putCompressedWord (vectorDz vector) diff --git a/library/Rattletrap/Primitive/Word32.hs b/library/Rattletrap/Primitive/Word32.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Word32.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Word32 where + +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Word as Word + +newtype Word32 = Word32 + { word32Value :: Word.Word32 + } deriving (Eq, Ord, Show) + +getWord32 :: Binary.Get Word32 +getWord32 = do + word32 <- Binary.getWord32le + pure (Word32 word32) + +putWord32 :: Word32 -> Binary.Put +putWord32 word32 = Binary.putWord32le (word32Value word32) + +getWord32Bits :: BinaryBit.BitGet Word32 +getWord32Bits = do + bytes <- BinaryBit.getLazyByteString 4 + pure (Binary.runGet getWord32 (reverseBytes bytes)) + +putWord32Bits :: Word32 -> BinaryBit.BitPut () +putWord32Bits word32 = do + let bytes = Binary.runPut (putWord32 word32) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Primitive/Word64.hs b/library/Rattletrap/Primitive/Word64.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Word64.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Word64 where + +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Word as Word + +newtype Word64 = Word64 + { word64Value :: Word.Word64 + } deriving (Eq, Ord, Show) + +getWord64 :: Binary.Get Word64 +getWord64 = do + word64 <- Binary.getWord64le + pure (Word64 word64) + +putWord64 :: Word64 -> Binary.Put +putWord64 word64 = Binary.putWord64le (word64Value word64) + +getWord64Bits :: BinaryBit.BitGet Word64 +getWord64Bits = do + bytes <- BinaryBit.getLazyByteString 8 + pure (Binary.runGet getWord64 (reverseBytes bytes)) + +putWord64Bits :: Word64 -> BinaryBit.BitPut () +putWord64Bits word64 = do + let bytes = Binary.runPut (putWord64 word64) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Primitive/Word8.hs b/library/Rattletrap/Primitive/Word8.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Primitive/Word8.hs @@ -0,0 +1,33 @@ +module Rattletrap.Primitive.Word8 where + +import Rattletrap.Utility + +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.Word as Word + +newtype Word8 = Word8 + { word8Value :: Word.Word8 + } deriving (Eq, Ord, Show) + +getWord8 :: Binary.Get Word8 +getWord8 = do + word8 <- Binary.getWord8 + pure (Word8 word8) + +putWord8 :: Word8 -> Binary.Put +putWord8 word8 = Binary.putWord8 (word8Value word8) + +getWord8Bits :: BinaryBit.BitGet Word8 +getWord8Bits = do + bytes <- BinaryBit.getLazyByteString 1 + pure (Binary.runGet getWord8 (reverseBytes bytes)) + +putWord8Bits :: Word8 -> BinaryBit.BitPut () +putWord8Bits word8 = do + let bytes = Binary.runPut (putWord8 word8) + BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Property.hs b/library/Rattletrap/Property.hs --- a/library/Rattletrap/Property.hs +++ b/library/Rattletrap/Property.hs @@ -1,8 +1,7 @@ module Rattletrap.Property where +import Rattletrap.Primitive import Rattletrap.PropertyValue -import Rattletrap.Text -import Rattletrap.Word64 import qualified Data.Binary as Binary @@ -17,8 +16,7 @@ kind <- getText size <- getWord64 value <- getPropertyValue getProperty kind - pure - Property {propertyKind = kind, propertySize = size, propertyValue = value} + pure (Property kind size value) putProperty :: Property -> Binary.Put putProperty property = do diff --git a/library/Rattletrap/PropertyValue.hs b/library/Rattletrap/PropertyValue.hs --- a/library/Rattletrap/PropertyValue.hs +++ b/library/Rattletrap/PropertyValue.hs @@ -1,12 +1,6 @@ module Rattletrap.PropertyValue where -import Rattletrap.Dictionary -import Rattletrap.Float32 -import Rattletrap.Int32 -import Rattletrap.List -import Rattletrap.Text -import Rattletrap.Word64 -import Rattletrap.Word8 +import Rattletrap.Primitive import qualified Data.Binary as Binary diff --git a/library/Rattletrap/RemoteId.hs b/library/Rattletrap/RemoteId.hs --- a/library/Rattletrap/RemoteId.hs +++ b/library/Rattletrap/RemoteId.hs @@ -1,7 +1,6 @@ module Rattletrap.RemoteId where -import Rattletrap.Word64 -import Rattletrap.Word8 +import Rattletrap.Primitive import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit diff --git a/library/Rattletrap/Replay.hs b/library/Rattletrap/Replay.hs --- a/library/Rattletrap/Replay.hs +++ b/library/Rattletrap/Replay.hs @@ -1,42 +1,25 @@ module Rattletrap.Replay where import Rattletrap.Content -import Rattletrap.Crc import Rattletrap.Header -import Rattletrap.Word32 +import Rattletrap.Primitive.Section import qualified Data.Binary as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString data Replay = Replay - { replayHeader :: Header - , replayContent :: Content + { replayHeader :: Section Header + , replayContent :: Section Content } deriving (Eq, Ord, Show) getReplay :: Binary.Get Replay getReplay = do - _headerSize <- getWord32 - _headerCrc <- getWord32 - header <- getHeader - _contentSize <- getWord32 - _contentCrc <- getWord32 - let version = getVersion header - let numFrames = getNumFrames header - content <- getContent version numFrames - pure Replay {replayHeader = header, replayContent = content} + header <- getSection getHeader + let version = getVersion (sectionBody header) + let numFrames = getNumFrames (sectionBody header) + content <- getSection (getContent version numFrames) + pure (Replay header content) putReplay :: Replay -> Binary.Put putReplay replay = do - let header = Binary.runPut (putHeader (replayHeader replay)) - let headerSize = ByteString.length header - let headerCrc = getCrc32 header - putWord32 (Word32 (fromIntegral headerSize)) - putWord32 (Word32 headerCrc) - Binary.putLazyByteString header - let content = Binary.runPut (putContent (replayContent replay)) - let contentSize = ByteString.length content - let contentCrc = getCrc32 content - putWord32 (Word32 (fromIntegral contentSize)) - putWord32 (Word32 contentCrc) - Binary.putLazyByteString content + putSection putHeader (replayHeader replay) + putSection putContent (replayContent replay) diff --git a/library/Rattletrap/Replication.hs b/library/Rattletrap/Replication.hs --- a/library/Rattletrap/Replication.hs +++ b/library/Rattletrap/Replication.hs @@ -2,7 +2,7 @@ import Rattletrap.ActorMap import Rattletrap.ClassAttributeMap -import Rattletrap.CompressedWord +import Rattletrap.Primitive import Rattletrap.ReplicationValue import qualified Data.Binary.Bits.Get as BinaryBit @@ -45,11 +45,7 @@ actorId <- getCompressedWord maxActorId (value, newActorMap) <- getReplicationValue version classAttributeMap actorMap actorId - pure - (Just - ( Replication - {replicationActorId = actorId, replicationValue = value} - , newActorMap)) + pure (Just (Replication actorId value, newActorMap)) putReplication :: Replication -> BinaryBit.BitPut () putReplication replication = do diff --git a/library/Rattletrap/Replication/Destroyed.hs b/library/Rattletrap/Replication/Destroyed.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Replication/Destroyed.hs @@ -0,0 +1,14 @@ +module Rattletrap.Replication.Destroyed where + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data DestroyedReplication = DestroyedReplication + { + } deriving (Eq, Ord, Show) + +getDestroyedReplication :: BinaryBit.BitGet DestroyedReplication +getDestroyedReplication = pure DestroyedReplication + +putDestroyedReplication :: DestroyedReplication -> BinaryBit.BitPut () +putDestroyedReplication _ = pure () diff --git a/library/Rattletrap/Replication/Spawned.hs b/library/Rattletrap/Replication/Spawned.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Replication/Spawned.hs @@ -0,0 +1,57 @@ +module Rattletrap.Replication.Spawned where + +import Rattletrap.ActorMap +import Rattletrap.ClassAttributeMap +import Rattletrap.Initialization +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +data SpawnedReplication = SpawnedReplication + { spawnedReplicationFlag :: Bool + , spawnedReplicationObjectId :: Word32 + , spawnedReplication_objectName :: Text + , spawnedReplication_className :: Text + , spawnedReplicationInitialization :: Initialization + } deriving (Eq, Ord, Show) + +getSpawnedReplication + :: ClassAttributeMap + -> ActorMap + -> CompressedWord + -> BinaryBit.BitGet (SpawnedReplication, ActorMap) +getSpawnedReplication classAttributeMap actorMap actorId = do + flag <- BinaryBit.getBool + objectId <- getWord32Bits + let newActorMap = updateActorMap actorId objectId actorMap + objectName <- lookupObjectName classAttributeMap objectId + className <- lookupClassName objectName + let hasLocation = classHasLocation className + let hasRotation = classHasRotation className + initialization <- getInitialization hasLocation hasRotation + pure + ( SpawnedReplication flag objectId objectName className initialization + , newActorMap) + +putSpawnedReplication :: SpawnedReplication -> BinaryBit.BitPut () +putSpawnedReplication spawnedReplication = do + BinaryBit.putBool (spawnedReplicationFlag spawnedReplication) + putWord32Bits (spawnedReplicationObjectId spawnedReplication) + putInitialization (spawnedReplicationInitialization spawnedReplication) + +lookupObjectName + :: Monad m + => ClassAttributeMap -> Word32 -> m Text +lookupObjectName classAttributeMap objectId = + case getObjectName classAttributeMap objectId of + Nothing -> fail ("could not get object name for id " ++ show objectId) + Just objectName -> pure objectName + +lookupClassName + :: Monad m + => Text -> m Text +lookupClassName objectName = + case getClassName objectName of + Nothing -> fail ("could not get class name for object " ++ show objectName) + Just className -> pure className diff --git a/library/Rattletrap/Replication/Updated.hs b/library/Rattletrap/Replication/Updated.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Replication/Updated.hs @@ -0,0 +1,27 @@ +module Rattletrap.Replication.Updated where + +import Rattletrap.ActorMap +import Rattletrap.Attribute +import Rattletrap.ClassAttributeMap +import Rattletrap.Primitive + +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit + +newtype UpdatedReplication = UpdatedReplication + { updatedReplicationAttributes :: [Attribute] + } deriving (Eq, Ord, Show) + +getUpdatedReplication + :: (Int, Int) + -> ClassAttributeMap + -> ActorMap + -> CompressedWord + -> BinaryBit.BitGet UpdatedReplication +getUpdatedReplication version classAttributeMap actorMap actorId = do + attributes <- getAttributes version classAttributeMap actorMap actorId + pure (UpdatedReplication attributes) + +putUpdatedReplication :: UpdatedReplication -> BinaryBit.BitPut () +putUpdatedReplication updatedReplication = + putAttributes (updatedReplicationAttributes updatedReplication) diff --git a/library/Rattletrap/ReplicationValue.hs b/library/Rattletrap/ReplicationValue.hs --- a/library/Rattletrap/ReplicationValue.hs +++ b/library/Rattletrap/ReplicationValue.hs @@ -1,24 +1,24 @@ module Rattletrap.ReplicationValue ( module Rattletrap.ReplicationValue - , module Rattletrap.ReplicationValue.Destroyed - , module Rattletrap.ReplicationValue.Spawned - , module Rattletrap.ReplicationValue.Updated + , module Rattletrap.Replication.Destroyed + , module Rattletrap.Replication.Spawned + , module Rattletrap.Replication.Updated ) where import Rattletrap.ActorMap import Rattletrap.ClassAttributeMap -import Rattletrap.CompressedWord -import Rattletrap.ReplicationValue.Destroyed -import Rattletrap.ReplicationValue.Spawned -import Rattletrap.ReplicationValue.Updated +import Rattletrap.Primitive +import Rattletrap.Replication.Destroyed +import Rattletrap.Replication.Spawned +import Rattletrap.Replication.Updated import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit data ReplicationValue - = SpawnedReplication SpawnedReplicationValue - | UpdatedReplication UpdatedReplicationValue - | DestroyedReplication DestroyedReplicationValue + = SpawnedReplicationValue SpawnedReplication + | UpdatedReplicationValue UpdatedReplication + | DestroyedReplicationValue DestroyedReplication deriving (Eq, Ord, Show) getReplicationValue @@ -35,26 +35,26 @@ if isNew then do (x, newActorMap) <- - getSpawnedReplicationValue classAttributeMap actorMap actorId - pure (SpawnedReplication x, newActorMap) + getSpawnedReplication classAttributeMap actorMap actorId + pure (SpawnedReplicationValue x, newActorMap) else do - x <- getUpdatedReplicationValue version classAttributeMap actorMap actorId - pure (UpdatedReplication x, actorMap) + x <- getUpdatedReplication version classAttributeMap actorMap actorId + pure (UpdatedReplicationValue x, actorMap) else do - x <- getDestroyedReplicationValue - pure (DestroyedReplication x, actorMap) + x <- getDestroyedReplication + pure (DestroyedReplicationValue x, actorMap) putReplicationValue :: ReplicationValue -> BinaryBit.BitPut () putReplicationValue value = case value of - SpawnedReplication x -> do + SpawnedReplicationValue x -> do BinaryBit.putBool True BinaryBit.putBool True - putSpawnedReplicationValue x - UpdatedReplication x -> do + putSpawnedReplication x + UpdatedReplicationValue x -> do BinaryBit.putBool True BinaryBit.putBool False - putUpdatedReplicationValue x - DestroyedReplication x -> do + putUpdatedReplication x + DestroyedReplicationValue x -> do BinaryBit.putBool False - putDestroyedReplicationValue x + putDestroyedReplication x diff --git a/library/Rattletrap/ReplicationValue/Destroyed.hs b/library/Rattletrap/ReplicationValue/Destroyed.hs deleted file mode 100644 --- a/library/Rattletrap/ReplicationValue/Destroyed.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.ReplicationValue.Destroyed where - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data DestroyedReplicationValue = - DestroyedReplicationValue - deriving (Eq, Ord, Show) - -getDestroyedReplicationValue :: BinaryBit.BitGet DestroyedReplicationValue -getDestroyedReplicationValue = pure DestroyedReplicationValue - -putDestroyedReplicationValue :: DestroyedReplicationValue -> BinaryBit.BitPut () -putDestroyedReplicationValue DestroyedReplicationValue = pure () diff --git a/library/Rattletrap/ReplicationValue/Spawned.hs b/library/Rattletrap/ReplicationValue/Spawned.hs deleted file mode 100644 --- a/library/Rattletrap/ReplicationValue/Spawned.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Rattletrap.ReplicationValue.Spawned where - -import Rattletrap.ActorMap -import Rattletrap.ClassAttributeMap -import Rattletrap.CompressedWord -import Rattletrap.Initialization -import Rattletrap.Text -import Rattletrap.Word32 - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data SpawnedReplicationValue = SpawnedReplicationValue - { spawnedReplicationValueFlag :: Bool - , spawnedReplicationValueObjectId :: Word32 - , spawnedReplicationValue_objectName :: String - , spawnedReplicationValue_className :: String - , spawnedReplicationValueInitialization :: Initialization - } deriving (Eq, Ord, Show) - -getSpawnedReplicationValue - :: ClassAttributeMap - -> ActorMap - -> CompressedWord - -> BinaryBit.BitGet (SpawnedReplicationValue, ActorMap) -getSpawnedReplicationValue classAttributeMap actorMap actorId = do - flag <- BinaryBit.getBool - objectId <- getWord32Bits - let newActorMap = updateActorMap actorId objectId actorMap - case getObjectName classAttributeMap objectId of - Nothing -> fail ("could not get object name for id " ++ show objectId) - Just objectName -> - case getClassName objectName of - Nothing -> - fail ("could not get class name for object " ++ show objectName) - Just className -> do - let hasLocation = classHasLocation className - let hasRotation = classHasRotation className - initialization <- getInitialization hasLocation hasRotation - pure - ( SpawnedReplicationValue - flag - objectId - (textToString objectName) - (textToString className) - initialization - , newActorMap) - -putSpawnedReplicationValue :: SpawnedReplicationValue -> BinaryBit.BitPut () -putSpawnedReplicationValue spawnedReplicationValue = do - BinaryBit.putBool (spawnedReplicationValueFlag spawnedReplicationValue) - putWord32Bits (spawnedReplicationValueObjectId spawnedReplicationValue) - putInitialization - (spawnedReplicationValueInitialization spawnedReplicationValue) diff --git a/library/Rattletrap/ReplicationValue/Updated.hs b/library/Rattletrap/ReplicationValue/Updated.hs deleted file mode 100644 --- a/library/Rattletrap/ReplicationValue/Updated.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Rattletrap.ReplicationValue.Updated where - -import Rattletrap.ActorMap -import Rattletrap.Attribute -import Rattletrap.ClassAttributeMap -import Rattletrap.CompressedWord - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data UpdatedReplicationValue = UpdatedReplicationValue - { updatedReplicationValueAttributes :: [Attribute] - } deriving (Eq, Ord, Show) - -getUpdatedReplicationValue - :: (Int, Int) - -> ClassAttributeMap - -> ActorMap - -> CompressedWord - -> BinaryBit.BitGet UpdatedReplicationValue -getUpdatedReplicationValue version classAttributeMap actorMap actorId = do - attributes <- getAttributes version classAttributeMap actorMap actorId - pure (UpdatedReplicationValue attributes) - -putUpdatedReplicationValue :: UpdatedReplicationValue -> BinaryBit.BitPut () -putUpdatedReplicationValue updatedReplicationValue = - putAttributes (updatedReplicationValueAttributes updatedReplicationValue) diff --git a/library/Rattletrap/Text.hs b/library/Rattletrap/Text.hs deleted file mode 100644 --- a/library/Rattletrap/Text.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Rattletrap.Text where - -import Rattletrap.Int32 -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy.Char8 as ByteString -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Encoding - -data Text = Text - { textSize :: Int32 - , textValue :: Text.Text - } deriving (Eq, Ord, Show) - -getText :: Binary.Get Text -getText = do - rawSize <- getInt32 - let decode = getTextDecoder rawSize - let size = getTextSize rawSize - bytes <- Binary.getLazyByteString size - let text = decode bytes - pure (Text rawSize text) - -putText :: Text -> Binary.Put -putText text = do - let size = textSize text - let encode = getTextEncoder size - putInt32 size - Binary.putLazyByteString (encode (textValue text)) - -getTextBits :: BinaryBit.BitGet Text -getTextBits = do - rawSize <- getInt32Bits - let decode = getTextDecoder rawSize - let size = getTextSize rawSize - bytes <- BinaryBit.getLazyByteString size - let text = decode (reverseBytes bytes) - pure (Text rawSize text) - -putTextBits :: Text -> BinaryBit.BitPut () -putTextBits text = do - let size = textSize text - let encode = getTextEncoder size - putInt32Bits size - BinaryBit.putByteString - (ByteString.toStrict (reverseBytes (encode (textValue text)))) - -stringToText :: String -> Text -stringToText string = - let value = Text.snoc (Text.pack string) '\x00' - size = Int32 (fromIntegral (Text.length value)) - in Text size value - -textToString :: Text -> String -textToString text = Text.unpack (Text.dropWhileEnd (== '\x00') (textValue text)) - -getTextSize - :: Integral a - => Int32 -> a -getTextSize (Int32 size) = - if size == 0x05000000 - then 8 - else if size < 0 - then (-2 * fromIntegral size) - else fromIntegral size - -getTextDecoder :: Int32 -> ByteString.ByteString -> Text.Text -getTextDecoder (Int32 size) bytes = - let decode = - if size < 0 - then Encoding.decodeUtf16LE - else Encoding.decodeLatin1 - in decode (ByteString.toStrict bytes) - -getTextEncoder :: Int32 -> Text.Text -> ByteString.ByteString -getTextEncoder (Int32 size) text = - if size < 0 - then ByteString.fromStrict (Encoding.encodeUtf16LE text) - else encodeLatin1 text - -encodeLatin1 :: Text.Text -> ByteString.ByteString -encodeLatin1 text = ByteString.pack (Text.unpack text) diff --git a/library/Rattletrap/Utility.hs b/library/Rattletrap/Utility.hs --- a/library/Rattletrap/Utility.hs +++ b/library/Rattletrap/Utility.hs @@ -36,4 +36,4 @@ Bits.shiftL (byte Bits..&. Bits.bit 0) 7 reverseBytes :: ByteString.ByteString -> ByteString.ByteString -reverseBytes = ByteString.map reverseByte +reverseBytes bytes = ByteString.map reverseByte bytes diff --git a/library/Rattletrap/Vector.hs b/library/Rattletrap/Vector.hs deleted file mode 100644 --- a/library/Rattletrap/Vector.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.Vector where - -import Rattletrap.CompressedWord - -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit - -data Vector = Vector - { vectorBitSize :: CompressedWord - , vectorDx :: CompressedWord - , vectorDy :: CompressedWord - , vectorDz :: CompressedWord - } deriving (Eq, Ord, Show) - -getVector :: BinaryBit.BitGet Vector -getVector = do - bitSize <- getCompressedWord 19 - let limit = 2 ^ (compressedWordValue bitSize + 2) - dx <- getCompressedWord limit - dy <- getCompressedWord limit - dz <- getCompressedWord limit - pure - Vector - {vectorBitSize = bitSize, vectorDx = dx, vectorDy = dy, vectorDz = dz} - -putVector :: Vector -> BinaryBit.BitPut () -putVector vector = do - putCompressedWord (vectorBitSize vector) - putCompressedWord (vectorDx vector) - putCompressedWord (vectorDy vector) - putCompressedWord (vectorDz vector) diff --git a/library/Rattletrap/Word32.hs b/library/Rattletrap/Word32.hs deleted file mode 100644 --- a/library/Rattletrap/Word32.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Word32 where - -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Word as Word - -newtype Word32 = Word32 - { word32Value :: Word.Word32 - } deriving (Eq, Ord, Show) - -getWord32 :: Binary.Get Word32 -getWord32 = do - word32 <- Binary.getWord32le - pure (Word32 word32) - -putWord32 :: Word32 -> Binary.Put -putWord32 (Word32 word32) = Binary.putWord32le word32 - -getWord32Bits :: BinaryBit.BitGet Word32 -getWord32Bits = do - bytes <- BinaryBit.getLazyByteString 4 - pure (Binary.runGet getWord32 (reverseBytes bytes)) - -putWord32Bits :: Word32 -> BinaryBit.BitPut () -putWord32Bits word32 = do - let bytes = Binary.runPut (putWord32 word32) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Word64.hs b/library/Rattletrap/Word64.hs deleted file mode 100644 --- a/library/Rattletrap/Word64.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Word64 where - -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Word as Word - -newtype Word64 = Word64 - { word64Value :: Word.Word64 - } deriving (Eq, Ord, Show) - -getWord64 :: Binary.Get Word64 -getWord64 = do - word64 <- Binary.getWord64le - pure (Word64 word64) - -putWord64 :: Word64 -> Binary.Put -putWord64 word64 = Binary.putWord64le (word64Value word64) - -getWord64Bits :: BinaryBit.BitGet Word64 -getWord64Bits = do - bytes <- BinaryBit.getLazyByteString 8 - pure (Binary.runGet getWord64 (reverseBytes bytes)) - -putWord64Bits :: Word64 -> BinaryBit.BitPut () -putWord64Bits word64 = do - let bytes = Binary.runPut (putWord64 word64) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/library/Rattletrap/Word8.hs b/library/Rattletrap/Word8.hs deleted file mode 100644 --- a/library/Rattletrap/Word8.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Rattletrap.Word8 where - -import Rattletrap.Utility - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as ByteString -import qualified Data.Word as Word - -newtype Word8 = Word8 - { word8Value :: Word.Word8 - } deriving (Eq, Ord, Show) - -getWord8 :: Binary.Get Word8 -getWord8 = do - word8 <- Binary.getWord8 - pure (Word8 word8) - -putWord8 :: Word8 -> Binary.Put -putWord8 (Word8 word8) = Binary.putWord8 word8 - -getWord8Bits :: BinaryBit.BitGet Word8 -getWord8Bits = do - bytes <- BinaryBit.getLazyByteString 1 - pure (Binary.runGet getWord8 (reverseBytes bytes)) - -putWord8Bits :: Word8 -> BinaryBit.BitPut () -putWord8Bits word8 = do - let bytes = Binary.runPut (putWord8 word8) - BinaryBit.putByteString (ByteString.toStrict (reverseBytes bytes)) diff --git a/rattletrap.cabal b/rattletrap.cabal --- a/rattletrap.cabal +++ b/rattletrap.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: rattletrap -version: 0.2.0 +version: 0.3.0 synopsis: Parse and generate Rocket League replays. description: Rattletrap parses and generates Rocket League replays. category: Game @@ -78,85 +78,92 @@ default-extensions: Strict ghc-options: -Wall build-depends: - base >=4.9 && <4.10 + aeson >=0.11 && <1.1 + , aeson-casing >=0.1 && <0.2 + , base >=4.9 && <4.10 , bimap >=0.3 && <0.4 , binary >=0.8 && <0.9 , binary-bits >=0.5 && <0.6 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 , data-binary-ieee754 >=0.4 && <0.5 + , template-haskell >=2.11 && <2.12 , text >=1.2 && <1.3 , vector >=0.11 && <0.12 exposed-modules: Rattletrap Rattletrap.ActorMap Rattletrap.Attribute + Rattletrap.Attribute.Boolean + Rattletrap.Attribute.Byte + Rattletrap.Attribute.CamSettings + Rattletrap.Attribute.ClubColors + Rattletrap.Attribute.Demolish + Rattletrap.Attribute.Enum + Rattletrap.Attribute.Explosion + Rattletrap.Attribute.FlaggedInt + Rattletrap.Attribute.Float + Rattletrap.Attribute.GameMode + Rattletrap.Attribute.Int + Rattletrap.Attribute.Loadout + Rattletrap.Attribute.LoadoutOnline + Rattletrap.Attribute.Loadouts + Rattletrap.Attribute.LoadoutsOnline + Rattletrap.Attribute.Location + Rattletrap.Attribute.MusicStinger + Rattletrap.Attribute.PartyLeader + Rattletrap.Attribute.Pickup + Rattletrap.Attribute.PrivateMatchSettings + Rattletrap.Attribute.QWord + Rattletrap.Attribute.Reservation + Rattletrap.Attribute.RigidBodyState + Rattletrap.Attribute.String + Rattletrap.Attribute.TeamPaint + Rattletrap.Attribute.UniqueId + Rattletrap.Attribute.WeldedInfo Rattletrap.AttributeMapping + Rattletrap.AttributeType Rattletrap.AttributeValue - Rattletrap.AttributeValue.Boolean - Rattletrap.AttributeValue.Byte - Rattletrap.AttributeValue.CamSettings - Rattletrap.AttributeValue.ClubColors - Rattletrap.AttributeValue.Demolish - Rattletrap.AttributeValue.Enum - Rattletrap.AttributeValue.Explosion - Rattletrap.AttributeValue.FlaggedInt - Rattletrap.AttributeValue.Float - Rattletrap.AttributeValue.GameMode - Rattletrap.AttributeValue.Int - Rattletrap.AttributeValue.Loadout - Rattletrap.AttributeValue.LoadoutOnline - Rattletrap.AttributeValue.Loadouts - Rattletrap.AttributeValue.LoadoutsOnline - Rattletrap.AttributeValue.Location - Rattletrap.AttributeValue.MusicStinger - Rattletrap.AttributeValue.PartyLeader - Rattletrap.AttributeValue.Pickup - Rattletrap.AttributeValue.PrivateMatchSettings - Rattletrap.AttributeValue.QWord - Rattletrap.AttributeValue.Reservation - Rattletrap.AttributeValue.RigidBodyState - Rattletrap.AttributeValue.String - Rattletrap.AttributeValue.TeamPaint - Rattletrap.AttributeValue.UniqueId - Rattletrap.AttributeValue.WeldedInfo - Rattletrap.AttributeValueType Rattletrap.Cache Rattletrap.ClassAttributeMap Rattletrap.ClassMapping - Rattletrap.CompressedWord - Rattletrap.CompressedWordVector Rattletrap.Content Rattletrap.Crc Rattletrap.Data - Rattletrap.Dictionary - Rattletrap.Float32 Rattletrap.Frame Rattletrap.Header Rattletrap.Initialization - Rattletrap.Int32 - Rattletrap.Int8 - Rattletrap.Int8Vector + Rattletrap.Json Rattletrap.KeyFrame - Rattletrap.List + Rattletrap.Main Rattletrap.Mark Rattletrap.Message + Rattletrap.Primitive + Rattletrap.Primitive.CompressedWord + Rattletrap.Primitive.CompressedWordVector + Rattletrap.Primitive.Dictionary + Rattletrap.Primitive.Float32 + Rattletrap.Primitive.Int32 + Rattletrap.Primitive.Int8 + Rattletrap.Primitive.Int8Vector + Rattletrap.Primitive.List + Rattletrap.Primitive.Section + Rattletrap.Primitive.Text + Rattletrap.Primitive.Vector + Rattletrap.Primitive.Word32 + Rattletrap.Primitive.Word64 + Rattletrap.Primitive.Word8 Rattletrap.Property Rattletrap.PropertyValue Rattletrap.RemoteId Rattletrap.Replay Rattletrap.Replication + Rattletrap.Replication.Destroyed + Rattletrap.Replication.Spawned + Rattletrap.Replication.Updated Rattletrap.ReplicationValue - Rattletrap.ReplicationValue.Destroyed - Rattletrap.ReplicationValue.Spawned - Rattletrap.ReplicationValue.Updated - Rattletrap.Text Rattletrap.Utility - Rattletrap.Vector Rattletrap.Version - Rattletrap.Word32 - Rattletrap.Word64 - Rattletrap.Word8 other-modules: Paths_rattletrap default-language: Haskell2010 @@ -168,13 +175,11 @@ default-extensions: Strict ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - aeson >=0.11 && <1.1 - , aeson-casing >=0.1 && <0.2 + aeson , base , binary , bytestring , rattletrap - , template-haskell >=2.11 && <2.12 default-language: Haskell2010 test-suite lint @@ -200,12 +205,12 @@ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base - , binary , bytestring , filepath >=1.4 && <1.5 , rattletrap , tasty >=0.11 && <0.12 , tasty-hspec >=1.1 && <1.2 + , temporary >=1.2 && <1.3 other-modules: Lint default-language: Haskell2010 diff --git a/test/Lint.hs b/test/Lint.hs --- a/test/Lint.hs +++ b/test/Lint.hs @@ -1,7 +1,3 @@ -module Main - ( main - ) where - import qualified Language.Haskell.HLint3 as HLint import qualified System.Exit as Exit diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,12 +1,8 @@ -module Main - ( main - ) where - -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary +import qualified Control.Monad as Monad import qualified Data.ByteString.Lazy as ByteString import qualified Rattletrap import qualified System.FilePath as FilePath +import qualified System.IO.Temp as Temp import qualified Test.Tasty as Tasty import qualified Test.Tasty.Hspec as Hspec @@ -16,27 +12,37 @@ Tasty.defaultMain tests spec :: Hspec.Spec -spec = Hspec.describe "Rattletrap" (mapM_ (uncurry itCanGetAndPut) replays) +spec = + Hspec.describe + "Rattletrap" + (mapM_ (\(uuid, description) -> itCanRoundTrip uuid description) replays) -itCanGetAndPut :: String -> String -> Hspec.Spec -itCanGetAndPut uuid description = - Hspec.it - (unwords [take 4 uuid, description]) - (do let file = pathToReplay uuid - (input, _, output) <- getAndPut file - Hspec.shouldBe (output == input) True) +itCanRoundTrip :: String -> String -> Hspec.Spec +itCanRoundTrip uuid description = + Hspec.it (specName uuid description) (specBody uuid) +specName :: String -> String -> String +specName uuid description = unwords [take 4 uuid, description] + +specBody :: String -> IO () +specBody uuid = do + let inputFile = pathToReplay uuid + input <- ByteString.readFile inputFile + Temp.withSystemTempDirectory + "replay-" + (\directory -> do + let jsonFile = FilePath.combine directory "replay.json" + Rattletrap.mainWithArgs ["decode", inputFile, jsonFile] + let outputFile = FilePath.combine directory "output.replay" + Rattletrap.mainWithArgs ["encode", jsonFile, outputFile] + output <- ByteString.readFile outputFile + Monad.unless + (output == input) + (Hspec.expectationFailure "output does not match input")) + pathToReplay :: String -> FilePath pathToReplay uuid = FilePath.joinPath ["test", "replays", FilePath.addExtension uuid ".replay"] - -getAndPut :: FilePath - -> IO (ByteString.ByteString, Rattletrap.Replay, ByteString.ByteString) -getAndPut file = do - input <- ByteString.readFile file - let replay = Binary.runGet Rattletrap.getReplay input - let output = Binary.runPut (Rattletrap.putReplay replay) - pure (input, replay, output) replays :: [(String, String)] replays =