diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -27,13 +27,15 @@ Rattletrap can parse (decode) Rocket League replays and output them as JSON. ``` sh -> rattletrap decode input.replay output.json +> rattletrap decode http://example.com/input.replay output.json # or > rattletrap decode input.replay > output.json # or > rattletrap.decode < input.replay > output.json ``` +The input argument can either be a local path or a URL. + The resulting JSON is minified, but extremely large. The output can be up to 50 times larger than the input. @@ -42,12 +44,14 @@ Rattletrap can also generate (encode) Rocket League replays from JSON files. ``` sh -> rattletrap encode input.json output.replay +> rattletrap encode http://example.com/input.json output.replay # or > rattletrap encode input.json > output.replay # or > rattletrap.encode < input.json > output.replay ``` + +The input argument can either be a local path or a URL. If the JSON was generated by Rattletrap, the resulting replay should be identical to the original. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,4 @@ -import qualified Distribution.Simple +import qualified Distribution.Simple as Cabal main :: IO () -main = Distribution.Simple.defaultMain +main = Cabal.defaultMain diff --git a/library/Rattletrap/Attribute.hs b/library/Rattletrap/Attribute.hs --- a/library/Rattletrap/Attribute.hs +++ b/library/Rattletrap/Attribute.hs @@ -16,8 +16,8 @@ , attributeValue :: AttributeValue } deriving (Eq, Ord, Show) -getAttributes :: - (Int, Int) +getAttributes + :: (Int, Int, Int) -> ClassAttributeMap -> ActorMap -> CompressedWord @@ -36,8 +36,8 @@ mapM_ putAttribute attributes BinaryBit.putBool False -getAttribute :: - (Int, Int) +getAttribute + :: (Int, Int, Int) -> ClassAttributeMap -> ActorMap -> CompressedWord @@ -45,21 +45,18 @@ getAttribute version classAttributeMap actorMap actorId = case getAttributeMap classAttributeMap actorMap actorId of Nothing -> fail ("could not get attribute map for " ++ show actorId) - Just attributeMap -> - case getAttributeIdLimit attributeMap of - Nothing -> - fail ("could not get attribute ID limit for " ++ show actorId) - Just limit -> do - id_ <- getCompressedWord limit - case getAttributeName classAttributeMap attributeMap id_ of - Nothing -> fail ("could not get attribute name for " ++ show id_) - Just name -> do - value <- - getAttributeValue - version - (classAttributeMapObjectMap classAttributeMap) - name - pure (Attribute id_ name value) + Just attributeMap -> case getAttributeIdLimit attributeMap of + Nothing -> fail ("could not get attribute ID limit for " ++ show actorId) + Just limit -> do + id_ <- getCompressedWord limit + case getAttributeName classAttributeMap attributeMap id_ of + Nothing -> fail ("could not get attribute name for " ++ show id_) + Just name -> do + value <- getAttributeValue + version + (classAttributeMapObjectMap classAttributeMap) + name + pure (Attribute id_ name value) putAttribute :: Attribute -> BinaryBit.BitPut () putAttribute attribute = do diff --git a/library/Rattletrap/Attribute/CamSettings.hs b/library/Rattletrap/Attribute/CamSettings.hs --- a/library/Rattletrap/Attribute/CamSettings.hs +++ b/library/Rattletrap/Attribute/CamSettings.hs @@ -15,7 +15,7 @@ , camSettingsAttributeTransitionSpeed :: Maybe Float32 } deriving (Eq, Ord, Show) -getCamSettingsAttribute :: (Int, Int) -> BinaryBit.BitGet CamSettingsAttribute +getCamSettingsAttribute :: (Int, Int, Int) -> BinaryBit.BitGet CamSettingsAttribute getCamSettingsAttribute version = do fov <- getFloat32Bits height <- getFloat32Bits @@ -23,21 +23,21 @@ distance <- getFloat32Bits stiffness <- getFloat32Bits swivelSpeed <- getFloat32Bits - transitionSpeed <- - if version >= (868, 20) - then do - x <- getFloat32Bits - pure (Just x) - else pure Nothing + transitionSpeed <- if version >= (868, 20, 0) + then do + x <- getFloat32Bits + pure (Just x) + else pure Nothing pure - (CamSettingsAttribute - fov - height - angle - distance - stiffness - swivelSpeed - transitionSpeed) + ( CamSettingsAttribute + fov + height + angle + distance + stiffness + swivelSpeed + transitionSpeed + ) putCamSettingsAttribute :: CamSettingsAttribute -> BinaryBit.BitPut () putCamSettingsAttribute camSettingsAttribute = do diff --git a/library/Rattletrap/Attribute/Demolish.hs b/library/Rattletrap/Attribute/Demolish.hs --- a/library/Rattletrap/Attribute/Demolish.hs +++ b/library/Rattletrap/Attribute/Demolish.hs @@ -23,13 +23,14 @@ attackerVelocity <- getVector victimVelocity <- getVector pure - (DemolishAttribute - attackerFlag - attackerActorId - victimFlag - victimActorId - attackerVelocity - victimVelocity) + ( DemolishAttribute + attackerFlag + attackerActorId + victimFlag + victimActorId + attackerVelocity + victimVelocity + ) putDemolishAttribute :: DemolishAttribute -> BinaryBit.BitPut () putDemolishAttribute demolishAttribute = do diff --git a/library/Rattletrap/Attribute/ExtendedExplosion.hs b/library/Rattletrap/Attribute/ExtendedExplosion.hs --- a/library/Rattletrap/Attribute/ExtendedExplosion.hs +++ b/library/Rattletrap/Attribute/ExtendedExplosion.hs @@ -21,8 +21,8 @@ unknown2 <- getInt32Bits pure (ExtendedExplosionAttribute actorId location unknown1 unknown2) -putExtendedExplosionAttribute :: - ExtendedExplosionAttribute -> BinaryBit.BitPut () +putExtendedExplosionAttribute + :: ExtendedExplosionAttribute -> BinaryBit.BitPut () putExtendedExplosionAttribute extendedExplosionAttribute = do BinaryBit.putBool False putInt32Bits (extendedExplosionAttributeActorId extendedExplosionAttribute) diff --git a/library/Rattletrap/Attribute/GameMode.hs b/library/Rattletrap/Attribute/GameMode.hs --- a/library/Rattletrap/Attribute/GameMode.hs +++ b/library/Rattletrap/Attribute/GameMode.hs @@ -9,12 +9,9 @@ , gameModeAttributeWord :: Word.Word8 } deriving (Eq, Ord, Show) -getGameModeAttribute :: (Int, Int) -> BinaryBit.BitGet GameModeAttribute +getGameModeAttribute :: (Int, Int, Int) -> BinaryBit.BitGet GameModeAttribute getGameModeAttribute version = do - let numBits = - if version < (868, 12) - then 2 - else 8 + let numBits = if version < (868, 12, 0) then 2 else 8 word <- BinaryBit.getWord8 numBits pure (GameModeAttribute numBits word) diff --git a/library/Rattletrap/Attribute/Loadout.hs b/library/Rattletrap/Attribute/Loadout.hs --- a/library/Rattletrap/Attribute/Loadout.hs +++ b/library/Rattletrap/Attribute/Loadout.hs @@ -38,28 +38,28 @@ goalExplosion <- getOptional (version >= Word8 16) getWord32Bits banner <- getOptional (version >= Word8 17) getWord32Bits pure - (LoadoutAttribute - version - body - decal - wheels - rocketTrail - antenna - topper - unknown1 - unknown2 - engineAudio - trail - goalExplosion - banner) + ( LoadoutAttribute + version + body + decal + wheels + rocketTrail + antenna + topper + unknown1 + unknown2 + engineAudio + trail + goalExplosion + banner + ) getOptional :: Bool -> BinaryBit.BitGet a -> BinaryBit.BitGet (Maybe a) -getOptional p f = - if p - then do - x <- f - pure (Just x) - else pure Nothing +getOptional p f = if p + then do + x <- f + pure (Just x) + else pure Nothing putLoadoutAttribute :: LoadoutAttribute -> BinaryBit.BitPut () putLoadoutAttribute loadoutAttribute = do @@ -78,7 +78,6 @@ putOptional (loadoutAttributeBanner loadoutAttribute) putWord32Bits putOptional :: Maybe a -> (a -> BinaryBit.BitPut ()) -> BinaryBit.BitPut () -putOptional m f = - case m of - Just x -> f x - Nothing -> pure () +putOptional m f = case m of + Just x -> f x + Nothing -> pure () diff --git a/library/Rattletrap/Attribute/LoadoutOnline.hs b/library/Rattletrap/Attribute/LoadoutOnline.hs --- a/library/Rattletrap/Attribute/LoadoutOnline.hs +++ b/library/Rattletrap/Attribute/LoadoutOnline.hs @@ -1,6 +1,6 @@ module Rattletrap.Attribute.LoadoutOnline where -import Rattletrap.Attribute.ProductAttribute +import Rattletrap.Attribute.Product import Rattletrap.Primitive import qualified Control.Monad as Monad @@ -12,16 +12,15 @@ { loadoutAttributeValue :: [[ProductAttribute]] } deriving (Eq, Ord, Show) -getLoadoutOnlineAttribute :: - (Int, Int) +getLoadoutOnlineAttribute + :: (Int, Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet LoadoutOnlineAttribute getLoadoutOnlineAttribute version objectMap = do size <- getWord8Bits - values <- - Monad.replicateM - (fromIntegral (word8Value size)) - (getProductAttributes version objectMap) + values <- Monad.replicateM + (fromIntegral (word8Value size)) + (getProductAttributes version objectMap) pure (LoadoutOnlineAttribute values) putLoadoutOnlineAttribute :: LoadoutOnlineAttribute -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Attribute/LoadoutsOnline.hs b/library/Rattletrap/Attribute/LoadoutsOnline.hs --- a/library/Rattletrap/Attribute/LoadoutsOnline.hs +++ b/library/Rattletrap/Attribute/LoadoutsOnline.hs @@ -14,8 +14,8 @@ , loadoutsOnlineAttributeUnknown2 :: Bool } deriving (Eq, Ord, Show) -getLoadoutsOnlineAttribute :: - (Int, Int) +getLoadoutsOnlineAttribute + :: (Int, Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet LoadoutsOnlineAttribute getLoadoutsOnlineAttribute version objectMap = do diff --git a/library/Rattletrap/Attribute/PartyLeader.hs b/library/Rattletrap/Attribute/PartyLeader.hs --- a/library/Rattletrap/Attribute/PartyLeader.hs +++ b/library/Rattletrap/Attribute/PartyLeader.hs @@ -11,16 +11,15 @@ , partyLeaderAttributeId :: Maybe (RemoteId, Word8) } deriving (Eq, Ord, Show) -getPartyLeaderAttribute :: BinaryBit.BitGet PartyLeaderAttribute -getPartyLeaderAttribute = do +getPartyLeaderAttribute :: (Int, Int, Int) -> BinaryBit.BitGet PartyLeaderAttribute +getPartyLeaderAttribute version = do systemId <- getWord8Bits - maybeRemoteAndLocalId <- - if systemId == Word8 0 - then pure Nothing - else do - remoteId <- getRemoteId systemId - localId <- getWord8Bits - pure (Just (remoteId, localId)) + maybeRemoteAndLocalId <- if systemId == Word8 0 + then pure Nothing + else do + remoteId <- getRemoteId version systemId + localId <- getWord8Bits + pure (Just (remoteId, localId)) pure (PartyLeaderAttribute systemId maybeRemoteAndLocalId) putPartyLeaderAttribute :: PartyLeaderAttribute -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Attribute/Pickup.hs b/library/Rattletrap/Attribute/Pickup.hs --- a/library/Rattletrap/Attribute/Pickup.hs +++ b/library/Rattletrap/Attribute/Pickup.hs @@ -13,12 +13,11 @@ getPickupAttribute :: BinaryBit.BitGet PickupAttribute getPickupAttribute = do instigator <- BinaryBit.getBool - maybeInstigatorId <- - if instigator - then do - instigatorId <- getWord32Bits - pure (Just instigatorId) - else pure Nothing + maybeInstigatorId <- if instigator + then do + instigatorId <- getWord32Bits + pure (Just instigatorId) + else pure Nothing pickedUp <- BinaryBit.getBool pure (PickupAttribute maybeInstigatorId pickedUp) diff --git a/library/Rattletrap/Attribute/PrivateMatchSettings.hs b/library/Rattletrap/Attribute/PrivateMatchSettings.hs --- a/library/Rattletrap/Attribute/PrivateMatchSettings.hs +++ b/library/Rattletrap/Attribute/PrivateMatchSettings.hs @@ -14,8 +14,8 @@ , privateMatchSettingsAttributeFlag :: Bool } deriving (Eq, Ord, Show) -getPrivateMatchSettingsAttribute :: - BinaryBit.BitGet PrivateMatchSettingsAttribute +getPrivateMatchSettingsAttribute + :: BinaryBit.BitGet PrivateMatchSettingsAttribute getPrivateMatchSettingsAttribute = do mutators <- getTextBits joinableBy <- getWord32Bits @@ -24,16 +24,17 @@ password <- getTextBits flag <- BinaryBit.getBool pure - (PrivateMatchSettingsAttribute - mutators - joinableBy - maxPlayers - gameName - password - flag) + ( PrivateMatchSettingsAttribute + mutators + joinableBy + maxPlayers + gameName + password + flag + ) -putPrivateMatchSettingsAttribute :: - PrivateMatchSettingsAttribute -> BinaryBit.BitPut () +putPrivateMatchSettingsAttribute + :: PrivateMatchSettingsAttribute -> BinaryBit.BitPut () putPrivateMatchSettingsAttribute privateMatchSettingsAttribute = do putTextBits (privateMatchSettingsAttributeMutators privateMatchSettingsAttribute) diff --git a/library/Rattletrap/Attribute/Product.hs b/library/Rattletrap/Attribute/Product.hs new file mode 100644 --- /dev/null +++ b/library/Rattletrap/Attribute/Product.hs @@ -0,0 +1,87 @@ +module Rattletrap.Attribute.Product 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 +import qualified Data.Map as Map +import qualified Data.Word as Word + +data ProductAttribute = ProductAttribute + { productAttributeUnknown :: Bool + , productAttributeObjectId :: Word32 + , productAttributeObjectName :: Maybe Text + -- ^ read-only + , productAttributeValue :: Maybe (Either CompressedWord Word.Word32) + } deriving (Eq, Ord, Show) + +getProductAttributes + :: (Int, Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet [ProductAttribute] +getProductAttributes version objectMap = do + size <- getWord8Bits + Monad.replicateM + (fromIntegral (word8Value size)) + (getProductAttribute version objectMap) + +getProductAttribute + :: (Int, Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet ProductAttribute +getProductAttribute version objectMap = do + flag <- BinaryBit.getBool + objectId <- getWord32Bits + let objectName = Map.lookup objectId objectMap + value <- case objectName of + Just name -> case textToString name of + "TAGame.ProductAttribute_Painted_TA" -> if version >= (868, 18, 0) + then do + x <- BinaryBit.getWord32be 31 + pure (Just (Right x)) + else do + x <- getCompressedWord 14 + pure (Just (Left x)) + "TAGame.ProductAttribute_UserColor_TA" -> do + hasValue <- BinaryBit.getBool + value <- if hasValue + then do + x <- BinaryBit.getWord32be 31 + pure (Just (Right x)) + else pure Nothing + pure value + _ -> + fail + ( "unknown object name " + ++ show objectName + ++ " for ID " + ++ show objectId + ) + Nothing -> fail ("missing object name for ID " ++ show objectId) + pure (ProductAttribute flag objectId objectName value) + +putProductAttributes :: [ProductAttribute] -> BinaryBit.BitPut () +putProductAttributes attributes = do + putWord8Bits (Word8 (fromIntegral (length attributes))) + mapM_ putProductAttribute attributes + +putProductAttribute :: ProductAttribute -> BinaryBit.BitPut () +putProductAttribute attribute = do + BinaryBit.putBool (productAttributeUnknown attribute) + putWord32Bits (productAttributeObjectId attribute) + case productAttributeObjectName attribute of + Just name -> case textToString name of + "TAGame.ProductAttribute_Painted_TA" -> + case productAttributeValue attribute of + Nothing -> pure () + Just (Left x) -> putCompressedWord x + Just (Right x) -> BinaryBit.putWord32be 31 x + "TAGame.ProductAttribute_UserColor_TA" -> + case productAttributeValue attribute of + Nothing -> BinaryBit.putBool False + Just value -> do + BinaryBit.putBool True + case value of + Left x -> putCompressedWord x + Right x -> BinaryBit.putWord32be 31 x + _ -> + fail ("unknown object name for product attribute " ++ show attribute) + Nothing -> + fail ("missing object name for product attribute " ++ show attribute) diff --git a/library/Rattletrap/Attribute/ProductAttribute.hs b/library/Rattletrap/Attribute/ProductAttribute.hs deleted file mode 100644 --- a/library/Rattletrap/Attribute/ProductAttribute.hs +++ /dev/null @@ -1,89 +0,0 @@ -module Rattletrap.Attribute.ProductAttribute 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 -import qualified Data.Map as Map -import qualified Data.Word as Word - -data ProductAttribute = ProductAttribute - { productAttributeUnknown :: Bool - , productAttributeObjectId :: Word32 - , productAttributeObjectName :: Maybe Text - -- ^ read-only - , productAttributeValue :: Maybe (Either CompressedWord Word.Word32) - } deriving (Eq, Ord, Show) - -getProductAttributes :: - (Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet [ProductAttribute] -getProductAttributes version objectMap = do - size <- getWord8Bits - Monad.replicateM - (fromIntegral (word8Value size)) - (getProductAttribute version objectMap) - -getProductAttribute :: - (Int, Int) -> Map.Map Word32 Text -> BinaryBit.BitGet ProductAttribute -getProductAttribute version objectMap = do - flag <- BinaryBit.getBool - objectId <- getWord32Bits - let objectName = Map.lookup objectId objectMap - value <- - case objectName of - Just name -> - case textToString name of - "TAGame.ProductAttribute_Painted_TA" -> - if version >= (868, 18) - then do - x <- BinaryBit.getWord32be 31 - pure (Just (Right x)) - else do - x <- getCompressedWord 14 - pure (Just (Left x)) - "TAGame.ProductAttribute_UserColor_TA" -> do - hasValue <- BinaryBit.getBool - value <- - if hasValue - then do - x <- BinaryBit.getWord32be 31 - pure (Just (Right x)) - else pure Nothing - pure value - _ -> - fail - ("unknown object name " ++ - show objectName ++ " for ID " ++ show objectId) - Nothing -> fail ("missing object name for ID " ++ show objectId) - pure (ProductAttribute flag objectId objectName value) - -putProductAttributes :: [ProductAttribute] -> BinaryBit.BitPut () -putProductAttributes attributes = do - putWord8Bits (Word8 (fromIntegral (length attributes))) - mapM_ putProductAttribute attributes - -putProductAttribute :: ProductAttribute -> BinaryBit.BitPut () -putProductAttribute attribute = do - BinaryBit.putBool (productAttributeUnknown attribute) - putWord32Bits (productAttributeObjectId attribute) - case productAttributeObjectName attribute of - Just name -> - case textToString name of - "TAGame.ProductAttribute_Painted_TA" -> - case productAttributeValue attribute of - Nothing -> pure () - Just (Left x) -> putCompressedWord x - Just (Right x) -> BinaryBit.putWord32be 31 x - "TAGame.ProductAttribute_UserColor_TA" -> - case productAttributeValue attribute of - Nothing -> BinaryBit.putBool False - Just value -> do - BinaryBit.putBool True - case value of - Left x -> putCompressedWord x - Right x -> BinaryBit.putWord32be 31 x - _ -> - fail ("unknown object name for product attribute " ++ show attribute) - Nothing -> - fail ("missing object name for product attribute " ++ show attribute) diff --git a/library/Rattletrap/Attribute/Reservation.hs b/library/Rattletrap/Attribute/Reservation.hs --- a/library/Rattletrap/Attribute/Reservation.hs +++ b/library/Rattletrap/Attribute/Reservation.hs @@ -16,24 +16,22 @@ , reservationAttributeUnknown3 :: Maybe Word.Word8 } deriving (Eq, Ord, Show) -getReservationAttribute :: (Int, Int) -> BinaryBit.BitGet ReservationAttribute +getReservationAttribute :: (Int, 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) + uniqueId <- getUniqueIdAttribute version + 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) + mc <- if version < (868, 12, 0) + then pure Nothing + else do + c <- BinaryBit.getWord8 6 + pure (Just c) pure (ReservationAttribute number uniqueId name a b mc) putReservationAttribute :: ReservationAttribute -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Attribute/RigidBodyState.hs b/library/Rattletrap/Attribute/RigidBodyState.hs --- a/library/Rattletrap/Attribute/RigidBodyState.hs +++ b/library/Rattletrap/Attribute/RigidBodyState.hs @@ -18,25 +18,24 @@ 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) + 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) + ( RigidBodyStateAttribute + sleeping + location + rotation + linearVelocity + angularVelocity + ) putRigidBodyStateAttribute :: RigidBodyStateAttribute -> BinaryBit.BitPut () putRigidBodyStateAttribute rigidBodyStateAttribute = do diff --git a/library/Rattletrap/Attribute/TeamPaint.hs b/library/Rattletrap/Attribute/TeamPaint.hs --- a/library/Rattletrap/Attribute/TeamPaint.hs +++ b/library/Rattletrap/Attribute/TeamPaint.hs @@ -21,12 +21,13 @@ primaryFinish <- getWord32Bits accentFinish <- getWord32Bits pure - (TeamPaintAttribute - team - primaryColor - accentColor - primaryFinish - accentFinish) + ( TeamPaintAttribute + team + primaryColor + accentColor + primaryFinish + accentFinish + ) putTeamPaintAttribute :: TeamPaintAttribute -> BinaryBit.BitPut () putTeamPaintAttribute teamPaintAttribute = do diff --git a/library/Rattletrap/Attribute/UniqueId.hs b/library/Rattletrap/Attribute/UniqueId.hs --- a/library/Rattletrap/Attribute/UniqueId.hs +++ b/library/Rattletrap/Attribute/UniqueId.hs @@ -12,10 +12,10 @@ , uniqueIdAttributeLocalId :: Word8 } deriving (Eq, Ord, Show) -getUniqueIdAttribute :: BinaryBit.BitGet UniqueIdAttribute -getUniqueIdAttribute = do +getUniqueIdAttribute :: (Int, Int, Int) -> BinaryBit.BitGet UniqueIdAttribute +getUniqueIdAttribute version = do systemId <- getWord8Bits - remoteId <- getRemoteId systemId + remoteId <- getRemoteId version systemId localId <- getWord8Bits pure (UniqueIdAttribute systemId remoteId localId) diff --git a/library/Rattletrap/AttributeValue.hs b/library/Rattletrap/AttributeValue.hs --- a/library/Rattletrap/AttributeValue.hs +++ b/library/Rattletrap/AttributeValue.hs @@ -23,7 +23,7 @@ , module Rattletrap.Attribute.PartyLeader , module Rattletrap.Attribute.Pickup , module Rattletrap.Attribute.PrivateMatchSettings - , module Rattletrap.Attribute.ProductAttribute + , module Rattletrap.Attribute.Product , module Rattletrap.Attribute.QWord , module Rattletrap.Attribute.Reservation , module Rattletrap.Attribute.RigidBodyState @@ -56,7 +56,7 @@ import Rattletrap.Attribute.PartyLeader import Rattletrap.Attribute.Pickup import Rattletrap.Attribute.PrivateMatchSettings -import Rattletrap.Attribute.ProductAttribute +import Rattletrap.Attribute.Product import Rattletrap.Attribute.QWord import Rattletrap.Attribute.Reservation import Rattletrap.Attribute.RigidBodyState @@ -105,140 +105,138 @@ | WeldedInfoAttributeValue WeldedInfoAttribute deriving (Eq, Ord, Show) -getAttributeValue :: - (Int, Int) +getAttributeValue + :: (Int, Int, Int) -> Map.Map Word32 Text -> Text -> BinaryBit.BitGet AttributeValue getAttributeValue version objectMap name = case Map.lookup name attributeTypes of - Just constructor -> - case constructor of - AppliedDamageAttributeType -> do - x <- getAppliedDamageAttribute - pure (AppliedDamageAttributeValue x) - BooleanAttributeType -> do - x <- getBooleanAttribute - pure (BooleanAttributeValue x) - ByteAttributeType -> do - x <- getByteAttribute - pure (ByteAttributeValue x) - CamSettingsAttributeType -> do - x <- getCamSettingsAttribute version - pure (CamSettingsAttributeValue x) - ClubColorsAttributeType -> do - x <- getClubColorsAttribute - pure (ClubColorsAttributeValue x) - DamageStateAttributeType -> do - x <- getDamageStateAttribute - pure (DamageStateAttributeValue x) - DemolishAttributeType -> do - x <- getDemolishAttribute - pure (DemolishAttributeValue x) - EnumAttributeType -> do - x <- getEnumAttribute - pure (EnumAttributeValue x) - ExplosionAttributeType -> do - x <- getExplosionAttribute - pure (ExplosionAttributeValue x) - ExtendedExplosionAttributeType -> do - x <- getExtendedExplosionAttribute - pure (ExtendedExplosionAttributeValue 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 version objectMap - pure (LoadoutOnlineAttributeValue x) - LoadoutsAttributeType -> do - x <- getLoadoutsAttribute - pure (LoadoutsAttributeValue x) - LoadoutsOnlineAttributeType -> do - x <- getLoadoutsOnlineAttribute version objectMap - 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) + Just constructor -> case constructor of + AppliedDamageAttributeType -> do + x <- getAppliedDamageAttribute + pure (AppliedDamageAttributeValue x) + BooleanAttributeType -> do + x <- getBooleanAttribute + pure (BooleanAttributeValue x) + ByteAttributeType -> do + x <- getByteAttribute + pure (ByteAttributeValue x) + CamSettingsAttributeType -> do + x <- getCamSettingsAttribute version + pure (CamSettingsAttributeValue x) + ClubColorsAttributeType -> do + x <- getClubColorsAttribute + pure (ClubColorsAttributeValue x) + DamageStateAttributeType -> do + x <- getDamageStateAttribute + pure (DamageStateAttributeValue x) + DemolishAttributeType -> do + x <- getDemolishAttribute + pure (DemolishAttributeValue x) + EnumAttributeType -> do + x <- getEnumAttribute + pure (EnumAttributeValue x) + ExplosionAttributeType -> do + x <- getExplosionAttribute + pure (ExplosionAttributeValue x) + ExtendedExplosionAttributeType -> do + x <- getExtendedExplosionAttribute + pure (ExtendedExplosionAttributeValue 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 version objectMap + pure (LoadoutOnlineAttributeValue x) + LoadoutsAttributeType -> do + x <- getLoadoutsAttribute + pure (LoadoutsAttributeValue x) + LoadoutsOnlineAttributeType -> do + x <- getLoadoutsOnlineAttribute version objectMap + pure (LoadoutsOnlineAttributeValue x) + LocationAttributeType -> do + x <- getLocationAttribute + pure (LocationAttributeValue x) + MusicStingerAttributeType -> do + x <- getMusicStingerAttribute + pure (MusicStingerAttributeValue x) + PartyLeaderAttributeType -> do + x <- getPartyLeaderAttribute version + 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 version + pure (UniqueIdAttributeValue x) + WeldedInfoAttributeType -> do + x <- getWeldedInfoAttribute + pure (WeldedInfoAttributeValue x) Nothing -> fail ("don't know how to get attribute value " ++ show name) attributeTypes :: Map.Map Text AttributeType attributeTypes = Map.mapKeys stringToText (Map.fromList rawAttributeTypes) putAttributeValue :: AttributeValue -> BinaryBit.BitPut () -putAttributeValue value = - case value of - AppliedDamageAttributeValue x -> putAppliedDamageAttribute x - BooleanAttributeValue x -> putBooleanAttribute x - ByteAttributeValue x -> putByteAttribute x - CamSettingsAttributeValue x -> putCamSettingsAttribute x - ClubColorsAttributeValue x -> putClubColorsAttribute x - DamageStateAttributeValue x -> putDamageStateAttribute x - DemolishAttributeValue x -> putDemolishAttribute x - EnumAttributeValue x -> putEnumAttribute x - ExplosionAttributeValue x -> putExplosionAttribute x - ExtendedExplosionAttributeValue x -> putExtendedExplosionAttribute 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 +putAttributeValue value = case value of + AppliedDamageAttributeValue x -> putAppliedDamageAttribute x + BooleanAttributeValue x -> putBooleanAttribute x + ByteAttributeValue x -> putByteAttribute x + CamSettingsAttributeValue x -> putCamSettingsAttribute x + ClubColorsAttributeValue x -> putClubColorsAttribute x + DamageStateAttributeValue x -> putDamageStateAttribute x + DemolishAttributeValue x -> putDemolishAttribute x + EnumAttributeValue x -> putEnumAttribute x + ExplosionAttributeValue x -> putExplosionAttribute x + ExtendedExplosionAttributeValue x -> putExtendedExplosionAttribute 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/ClassAttributeMap.hs b/library/Rattletrap/ClassAttributeMap.hs --- a/library/Rattletrap/ClassAttributeMap.hs +++ b/library/Rattletrap/ClassAttributeMap.hs @@ -33,8 +33,8 @@ -- | Makes a 'ClassAttributeMap' given the necessary fields from the -- 'Rattletrap.Content.Content'. -makeClassAttributeMap :: - List Text +makeClassAttributeMap + :: List Text -- ^ From 'Rattletrap.Content.contentObjects'. -> List ClassMapping -- ^ From 'Rattletrap.Content.contentClassMappings'. @@ -44,35 +44,34 @@ -- ^ From 'Rattletrap.Content.contentNames'. -> ClassAttributeMap makeClassAttributeMap objects classMappings caches names = - let objectMap = makeObjectMap objects - classMap = makeClassMap classMappings - objectClassMap = makeObjectClassMap objectMap classMap - classCache = makeClassCache classMap caches - attributeMap = makeAttributeMap caches - classIds = map (\(_, classId, _, _) -> classId) classCache - parentMap = makeParentMap classCache - 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))) - classIds) - nameMap = makeNameMap names + let + objectMap = makeObjectMap objects + classMap = makeClassMap classMappings + objectClassMap = makeObjectClassMap objectMap classMap + classCache = makeClassCache classMap caches + attributeMap = makeAttributeMap caches + classIds = map (\(_, classId, _, _) -> classId) classCache + parentMap = makeParentMap classCache + 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)) + ) + classIds + ) + nameMap = makeNameMap names in ClassAttributeMap objectMap objectClassMap value nameMap makeNameMap :: List Text -> IntMap.IntMap Text @@ -82,84 +81,95 @@ getName nameMap nameIndex = IntMap.lookup (fromIntegral (word32Value nameIndex)) nameMap -makeObjectClassMap :: - Map.Map Word32 Text -> Bimap.Bimap Word32 Text -> Map.Map Word32 Word32 +makeObjectClassMap + :: Map.Map Word32 Text -> Bimap.Bimap Word32 Text -> Map.Map Word32 Word32 makeObjectClassMap objectMap classMap = do let objectIds = Map.keys objectMap let classIds = map (getClassId objectMap classMap) objectIds let rawPairs = zip objectIds classIds - let pairs = - Maybe.mapMaybe - (\(objectId, maybeClassId) -> - case maybeClassId of - Nothing -> Nothing - Just classId -> Just (objectId, classId)) - rawPairs + let + pairs = Maybe.mapMaybe + ( \(objectId, maybeClassId) -> case maybeClassId of + Nothing -> Nothing + Just classId -> Just (objectId, classId) + ) + rawPairs Map.fromList pairs -getClassId :: - Map.Map Word32 Text -> Bimap.Bimap Word32 Text -> Word32 -> Maybe Word32 +getClassId + :: Map.Map Word32 Text -> Bimap.Bimap Word32 Text -> Word32 -> Maybe Word32 getClassId objectMap classMap objectId = do objectName <- getObjectName objectMap objectId className <- getClassName objectName Bimap.lookupR className classMap -makeClassCache :: - Bimap.Bimap Word32 Text +makeClassCache + :: Bimap.Bimap Word32 Text -> List Cache -> [(Maybe Text, Word32, Word32, Word32)] -makeClassCache classMap caches = - map - (\cache -> - let classId = cacheClassId cache - in ( Bimap.lookup classId classMap - , classId - , cacheCacheId cache - , cacheParentCacheId cache)) - (listValue caches) +makeClassCache classMap caches = map + ( \cache -> + let + classId = cacheClassId cache + in + ( Bimap.lookup classId classMap + , classId + , cacheCacheId cache + , cacheParentCacheId cache + ) + ) + (listValue caches) makeClassMap :: List ClassMapping -> Bimap.Bimap Word32 Text -makeClassMap classMappings = - Bimap.fromList - (map - (\classMapping -> - (classMappingStreamId classMapping, classMappingName classMapping)) - (listValue classMappings)) +makeClassMap classMappings = Bimap.fromList + ( map + ( \classMapping -> + (classMappingStreamId classMapping, classMappingName classMapping) + ) + (listValue classMappings) + ) makeAttributeMap :: List Cache -> Map.Map Word32 (Map.Map Word32 Word32) -makeAttributeMap caches = - Map.fromList - (map - (\cache -> - ( cacheClassId cache - , Map.fromList - (map - (\attributeMapping -> - ( attributeMappingStreamId attributeMapping - , attributeMappingObjectId attributeMapping)) - (listValue (cacheAttributeMappings cache))))) - (listValue caches)) +makeAttributeMap caches = Map.fromList + ( map + ( \cache -> + ( cacheClassId cache + , Map.fromList + ( map + ( \attributeMapping -> + ( attributeMappingStreamId attributeMapping + , attributeMappingObjectId attributeMapping + ) + ) + (listValue (cacheAttributeMappings cache)) + ) + ) + ) + (listValue caches) + ) -makeShallowParentMap :: - [(Maybe Text, Word32, Word32, Word32)] -> Map.Map Word32 Word32 -makeShallowParentMap classCache = - Map.fromList - (Maybe.mapMaybe - (\xs -> - case xs of - [] -> Nothing - (maybeClassName, classId, _, parentCacheId):rest -> do - parentClassId <- getParentClass maybeClassName parentCacheId rest - pure (classId, parentClassId)) - (List.tails (reverse classCache))) +makeShallowParentMap + :: [(Maybe Text, Word32, Word32, Word32)] -> Map.Map Word32 Word32 +makeShallowParentMap classCache = Map.fromList + ( Maybe.mapMaybe + ( \xs -> case xs of + [] -> Nothing + (maybeClassName, classId, _, parentCacheId):rest -> do + parentClassId <- getParentClass maybeClassName parentCacheId rest + pure (classId, parentClassId) + ) + (List.tails (reverse classCache)) + ) -makeParentMap :: - [(Maybe Text, Word32, Word32, Word32)] -> Map.Map Word32 [Word32] +makeParentMap + :: [(Maybe Text, Word32, Word32, Word32)] -> Map.Map Word32 [Word32] makeParentMap classCache = - let shallowParentMap = makeShallowParentMap classCache - in Map.mapWithKey - (\classId _ -> getParentClasses shallowParentMap classId) - shallowParentMap + let + shallowParentMap = makeShallowParentMap classCache + in + Map.mapWithKey + (\classId _ -> getParentClasses shallowParentMap classId) + shallowParentMap getParentClasses :: Map.Map Word32 Word32 -> Word32 -> [Word32] getParentClasses shallowParentMap classId = @@ -168,50 +178,51 @@ Just parentClassId -> parentClassId : getParentClasses shallowParentMap parentClassId -getParentClass :: - Maybe Text +getParentClass + :: Maybe Text -> Word32 -> [(Maybe Text, Word32, Word32, Word32)] -> Maybe Word32 -getParentClass maybeClassName parentCacheId xs = - case maybeClassName of - Nothing -> getParentClassById parentCacheId xs - Just className -> getParentClassByName className parentCacheId xs +getParentClass maybeClassName parentCacheId xs = case maybeClassName of + Nothing -> getParentClassById parentCacheId xs + Just className -> getParentClassByName className parentCacheId xs -getParentClassById :: - Word32 -> [(Maybe Text, Word32, Word32, Word32)] -> Maybe Word32 +getParentClassById + :: Word32 -> [(Maybe Text, Word32, Word32, Word32)] -> Maybe Word32 getParentClassById parentCacheId xs = case dropWhile (\(_, _, cacheId, _) -> cacheId /= parentCacheId) xs of - [] -> - if parentCacheId == Word32 0 - then Nothing - else getParentClassById (Word32 (word32Value parentCacheId - 1)) xs + [] -> if parentCacheId == Word32 0 + then Nothing + else getParentClassById (Word32 (word32Value parentCacheId - 1)) xs (_, parentClassId, _, _):_ -> Just parentClassId -getParentClassByName :: - Text -> Word32 -> [(Maybe Text, Word32, Word32, Word32)] -> Maybe Word32 +getParentClassByName + :: Text -> Word32 -> [(Maybe Text, Word32, Word32, Word32)] -> Maybe Word32 getParentClassByName className parentCacheId xs = case Map.lookup className parentClasses of Nothing -> getParentClassById parentCacheId xs - Just parentClassName -> - Maybe.maybe - (getParentClassById parentCacheId xs) - Just - (Maybe.listToMaybe - (map - (\(_, parentClassId, _, _) -> parentClassId) - (filter - (\(_, _, cacheId, _) -> cacheId <= parentCacheId) - (filter - (\(maybeClassName, _, _, _) -> - maybeClassName == Just parentClassName) - xs)))) + Just parentClassName -> Maybe.maybe + (getParentClassById parentCacheId xs) + Just + ( Maybe.listToMaybe + ( map + (\(_, parentClassId, _, _) -> parentClassId) + ( filter + (\(_, _, cacheId, _) -> cacheId <= parentCacheId) + ( filter + ( \(maybeClassName, _, _, _) -> + maybeClassName == Just parentClassName + ) + xs + ) + ) + ) + ) parentClasses :: Map.Map Text Text -parentClasses = - Map.map - stringToText - (Map.mapKeys stringToText (Map.fromList rawParentClasses)) +parentClasses = Map.map + stringToText + (Map.mapKeys stringToText (Map.fromList rawParentClasses)) makeObjectMap :: List Text -> Map.Map Word32 Text makeObjectMap objects = @@ -226,29 +237,29 @@ normalizeObjectName :: Text -> Text normalizeObjectName objectName = - let name = textValue objectName - crowdActor = Text.pack "TheWorld:PersistentLevel.CrowdActor_TA" - crowdManager = Text.pack "TheWorld:PersistentLevel.CrowdManager_TA" - boostPickup = Text.pack "TheWorld:PersistentLevel.VehiclePickup_Boost_TA" - mapScoreboard = Text.pack "TheWorld:PersistentLevel.InMapScoreboard_TA" - breakout = Text.pack "TheWorld:PersistentLevel.BreakOutActor_Platform_TA" + let + name = textValue objectName + crowdActor = Text.pack "TheWorld:PersistentLevel.CrowdActor_TA" + crowdManager = Text.pack "TheWorld:PersistentLevel.CrowdManager_TA" + boostPickup = Text.pack "TheWorld:PersistentLevel.VehiclePickup_Boost_TA" + mapScoreboard = Text.pack "TheWorld:PersistentLevel.InMapScoreboard_TA" + breakout = Text.pack "TheWorld:PersistentLevel.BreakOutActor_Platform_TA" in if Text.isInfixOf crowdActor name - then Text crowdActor - else if Text.isInfixOf crowdManager name - then Text crowdManager - else if Text.isInfixOf boostPickup name - then Text boostPickup - else if Text.isInfixOf mapScoreboard name - then Text mapScoreboard - else if Text.isInfixOf breakout name - then Text breakout - else objectName + then Text crowdActor + else if Text.isInfixOf crowdManager name + then Text crowdManager + else if Text.isInfixOf boostPickup name + then Text boostPickup + else if Text.isInfixOf mapScoreboard name + then Text mapScoreboard + else if Text.isInfixOf breakout name + then Text breakout + else objectName objectClasses :: Map.Map Text Text -objectClasses = - Map.map - stringToText - (Map.mapKeys stringToText (Map.fromList rawObjectClasses)) +objectClasses = Map.map + stringToText + (Map.mapKeys stringToText (Map.fromList rawObjectClasses)) classHasLocation :: Text -> Bool classHasLocation className = Set.member className classesWithLocation @@ -268,16 +279,16 @@ let limit = fromIntegral (word32Value streamId) pure limit -getAttributeName :: - ClassAttributeMap -> Map.Map Word32 Word32 -> CompressedWord -> Maybe Text +getAttributeName + :: ClassAttributeMap -> Map.Map Word32 Word32 -> CompressedWord -> Maybe Text getAttributeName classAttributeMap attributeMap streamId = do let key = Word32 (fromIntegral (compressedWordValue streamId)) attributeId <- Map.lookup key attributeMap let objectMap = classAttributeMapObjectMap classAttributeMap Map.lookup attributeId objectMap -getAttributeMap :: - ClassAttributeMap +getAttributeMap + :: ClassAttributeMap -> ActorMap -> CompressedWord -> Maybe (Map.Map Word32 Word32) diff --git a/library/Rattletrap/Content.hs b/library/Rattletrap/Content.hs --- a/library/Rattletrap/Content.hs +++ b/library/Rattletrap/Content.hs @@ -51,10 +51,9 @@ -- for the 'Rattletrap.ClassAttributeMap.ClassAttributeMap'. } deriving (Eq, Ord, Show) -getContent :: - (Int, Int) - -- ^ Major and minor version numbers, usually from - -- 'Rattletrap.Header.getVersion'. +getContent + :: (Int, Int, Int) + -- ^ Version numbers, usually from 'Rattletrap.Header.getVersion'. -> Int -- ^ The number of frames in the stream, usually from -- 'Rattletrap.Header.getNumFrames'. @@ -74,33 +73,37 @@ names <- getList getText classMappings <- getList getClassMapping caches <- getList getCache - let classAttributeMap = - makeClassAttributeMap objects classMappings caches names - let frames = - Binary.runGet - (BinaryBit.runBitGet - (do (theFrames, _) <- - getFrames - version - numFrames - maxChannels - classAttributeMap - Map.empty - pure theFrames)) - (reverseBytes stream) + let + classAttributeMap = + makeClassAttributeMap objects classMappings caches names + let + frames = Binary.runGet + ( BinaryBit.runBitGet + ( do + (theFrames, _) <- getFrames + version + numFrames + maxChannels + classAttributeMap + Map.empty + pure theFrames + ) + ) + (reverseBytes stream) pure - (Content - levels - keyFrames - streamSize - frames - messages - marks - packages - objects - names - classMappings - caches) + ( Content + levels + keyFrames + streamSize + frames + messages + marks + packages + objects + names + classMappings + caches + ) putContent :: Content -> Binary.Put putContent content = do @@ -108,8 +111,9 @@ putList putKeyFrame (contentKeyFrames content) let streamSize = contentStreamSize content putWord32 streamSize - let stream = - Binary.runPut (BinaryBit.runBitPut (putFrames (contentFrames content))) + let + stream = + Binary.runPut (BinaryBit.runBitPut (putFrames (contentFrames content))) Binary.putLazyByteString (reverseBytes (padBytes (word32Value streamSize) stream)) putList putMessage (contentMessages content) diff --git a/library/Rattletrap/Crc.hs b/library/Rattletrap/Crc.hs --- a/library/Rattletrap/Crc.hs +++ b/library/Rattletrap/Crc.hs @@ -23,15 +23,11 @@ let crc = ByteString.foldl update initial bytes Bits.complement crc -crc32Update :: - Vector.Vector Word.Word32 -> Word.Word32 -> Word.Word8 -> Word.Word32 +crc32Update + :: Vector.Vector Word.Word32 -> Word.Word32 -> Word.Word8 -> Word.Word32 crc32Update table crc byte = do - let toWord8 = - fromIntegral :: (Integral a) => - a -> Word.Word8 - let toInt = - fromIntegral :: (Integral a) => - a -> Int + let toWord8 = fromIntegral :: (Integral a) => a -> Word.Word8 + let toInt = fromIntegral :: (Integral a) => a -> Int let index = toInt (Bits.xor byte (toWord8 (Bits.shiftR crc 24))) let left = Vector.unsafeIndex table index let right = Bits.shiftL crc 8 diff --git a/library/Rattletrap/Frame.hs b/library/Rattletrap/Frame.hs --- a/library/Rattletrap/Frame.hs +++ b/library/Rattletrap/Frame.hs @@ -17,8 +17,8 @@ , frameReplications :: [Replication] } deriving (Eq, Ord, Show) -getFrames :: - (Int, Int) +getFrames + :: (Int, Int, Int) -> Int -> Word -> ClassAttributeMap @@ -28,22 +28,24 @@ if numFrames <= 0 then pure ([], actorMap) else do - (frame, newActorMap) <- - getFrame version maxChannels classAttributeMap actorMap - (frames, newerActorMap) <- - getFrames - version - (numFrames - 1) - maxChannels - classAttributeMap - newActorMap + (frame, newActorMap) <- getFrame + version + maxChannels + classAttributeMap + actorMap + (frames, newerActorMap) <- getFrames + version + (numFrames - 1) + maxChannels + classAttributeMap + newActorMap pure (frame : frames, newerActorMap) putFrames :: [Frame] -> BinaryBit.BitPut () putFrames = mapM_ putFrame -getFrame :: - (Int, Int) +getFrame + :: (Int, Int, Int) -> Word -> ClassAttributeMap -> ActorMap @@ -51,8 +53,11 @@ getFrame version maxChannels classAttributeMap actorMap = do time <- getFloat32Bits delta <- getFloat32Bits - (replications, newActorMap) <- - getReplications version maxChannels classAttributeMap actorMap + (replications, newActorMap) <- getReplications + version + maxChannels + classAttributeMap + actorMap pure (Frame time delta replications, newActorMap) putFrame :: Frame -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Header.hs b/library/Rattletrap/Header.hs --- a/library/Rattletrap/Header.hs +++ b/library/Rattletrap/Header.hs @@ -6,15 +6,16 @@ import qualified Data.Binary as Binary import qualified Data.Map as Map +import qualified Data.Maybe as Maybe -- | Contains high-level metadata about a 'Rattletrap.Replay.Replay'. data Header = Header { headerEngineVersion :: Word32 - -- ^ The "major" version number. + -- ^ The "major" ("engine") version number. , headerLicenseeVersion :: Word32 - -- ^ The "minor" version number. + -- ^ The "minor" ("licensee") version number. , headerPatchVersion :: Maybe Word32 - -- ^ The "patch" version number. + -- ^ The "patch" ("net") version number. , headerLabel :: Text -- ^ Always @TAGame.Replay_Soccar_TA@. , headerProperties :: Dictionary Property @@ -64,12 +65,11 @@ pure (Header engineVersion licenseeVersion patchVersion label properties) getPatchVersion :: Word32 -> Word32 -> Binary.Get (Maybe Word32) -getPatchVersion major minor = - if hasPatchVersion major minor - then do - patchVersion <- getWord32 - pure (Just patchVersion) - else pure Nothing +getPatchVersion major minor = if hasPatchVersion major minor + then do + patchVersion <- getWord32 + pure (Just patchVersion) + else pure Nothing hasPatchVersion :: Word32 -> Word32 -> Bool hasPatchVersion major minor = major >= Word32 868 && minor >= Word32 18 @@ -84,34 +84,29 @@ putText (headerLabel header) putDictionary putProperty (headerProperties header) -getVersion :: Header -> (Int, Int) +getVersion :: Header -> (Int, Int, Int) getVersion header = - let major = getMajorVersion header - minor = getMinorVersion header - in (major, minor) - -getMajorVersion :: Header -> Int -getMajorVersion header = - fromIntegral (word32Value (headerEngineVersion header)) - -getMinorVersion :: Header -> Int -getMinorVersion header = - fromIntegral (word32Value (headerLicenseeVersion header)) + ( fromIntegral (word32Value (headerEngineVersion header)) + , fromIntegral (word32Value (headerLicenseeVersion header)) + , Maybe.fromMaybe 0 (fmap (\ v -> fromIntegral (word32Value v)) (headerPatchVersion header)) + ) getNumFrames :: Header -> Int getNumFrames header = - let key = textValue (stringToText "NumFrames") - properties = dictionaryValue (headerProperties header) + let + key = textValue (stringToText "NumFrames") + properties = dictionaryValue (headerProperties header) in case Map.lookup key properties of - Just (Property _ _ (IntProperty numFrames)) -> - fromIntegral (int32Value numFrames) - _ -> 0 + Just (Property _ _ (IntProperty numFrames)) -> + fromIntegral (int32Value numFrames) + _ -> 0 getMaxChannels :: Header -> Word getMaxChannels header = - let key = textValue (stringToText "MaxChannels") - properties = dictionaryValue (headerProperties header) + let + key = textValue (stringToText "MaxChannels") + properties = dictionaryValue (headerProperties header) in case Map.lookup key properties of - Just (Property _ _ (IntProperty numFrames)) -> - fromIntegral (int32Value numFrames) - _ -> 1023 + Just (Property _ _ (IntProperty numFrames)) -> + fromIntegral (int32Value numFrames) + _ -> 1023 diff --git a/library/Rattletrap/Helper.hs b/library/Rattletrap/Helper.hs --- a/library/Rattletrap/Helper.hs +++ b/library/Rattletrap/Helper.hs @@ -14,10 +14,9 @@ -- * Lazy byte strings -- | Parses a raw replay. decodeReplay :: ByteString.ByteString -> Either String Replay -decodeReplay contents = - case Binary.runGetOrFail getReplay contents of - Left (_, _, message) -> fail message - Right (_, _, replay) -> pure replay +decodeReplay contents = case Binary.runGetOrFail getReplay contents of + Left (_, _, message) -> fail message + Right (_, _, replay) -> pure replay -- | Encodes a replay as JSON. encodeJson :: Replay -> ByteString.ByteString diff --git a/library/Rattletrap/Initialization.hs b/library/Rattletrap/Initialization.hs --- a/library/Rattletrap/Initialization.hs +++ b/library/Rattletrap/Initialization.hs @@ -16,18 +16,16 @@ getInitialization :: Bool -> Bool -> BinaryBit.BitGet Initialization getInitialization hasLocation hasRotation = do - location <- - if hasLocation - then do - location <- getVector - pure (Just location) - else pure Nothing - rotation <- - if hasRotation - then do - rotation <- getInt8Vector - pure (Just rotation) - else pure Nothing + location <- if hasLocation + then do + location <- getVector + pure (Just location) + else pure Nothing + rotation <- if hasRotation + then do + rotation <- getInt8Vector + pure (Just rotation) + else pure Nothing pure (Initialization location rotation) putInitialization :: Initialization -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Main.hs b/library/Rattletrap/Main.hs --- a/library/Rattletrap/Main.hs +++ b/library/Rattletrap/Main.hs @@ -27,35 +27,29 @@ -- 3. @mainWithArgs ["encode"]@: Generates a raw replay from JSON. The -- handling of input and output is the same as decoding. mainWithArgs :: [String] -> IO () -mainWithArgs args = - case args of - ["version"] -> putStrLn (Version.showVersion version) - action:files -> do - (getInput, putOutput) <- getIO files - input <- getInput - output <- - case action of - "decode" -> - case decodeReplay input of - Left message -> fail message - Right replay -> pure (encodeJson replay) - "encode" -> - case decodeJson input of - Left message -> fail message - Right replay -> pure (encodeReplay replay) - _ -> fail ("unknown action: " ++ show action) - putOutput output - _ -> fail ("unknown arguments: " ++ show args) +mainWithArgs args = case args of + ["version"] -> putStrLn (Version.showVersion version) + action:files -> do + (getInput, putOutput) <- getIO files + input <- getInput + output <- case action of + "decode" -> case decodeReplay input of + Left message -> fail message + Right replay -> pure (encodeJson replay) + "encode" -> case decodeJson input of + Left message -> fail message + Right replay -> pure (encodeReplay replay) + _ -> fail ("unknown action: " ++ show action) + putOutput output + _ -> fail ("unknown arguments: " ++ show args) -getIO :: - [FilePath] - -> IO (IO ByteString.ByteString, ByteString.ByteString -> IO ()) -getIO files = - case files of - [] -> pure (ByteString.getContents, ByteString.putStr) - [i] -> pure (readUrlOrFile i, ByteString.putStr) - [i, o] -> pure (readUrlOrFile i, ByteString.writeFile o) - _ -> fail ("unknown files: " ++ show files) +getIO + :: [FilePath] -> IO (IO ByteString.ByteString, ByteString.ByteString -> IO ()) +getIO files = case files of + [] -> pure (ByteString.getContents, ByteString.putStr) + [i] -> pure (readUrlOrFile i, ByteString.putStr) + [i, o] -> pure (readUrlOrFile i, ByteString.writeFile o) + _ -> fail ("unknown files: " ++ show files) readUrlOrFile :: FilePath -> IO ByteString.ByteString readUrlOrFile i = case Client.parseUrlThrow i of diff --git a/library/Rattletrap/Primitive/CompressedWord.hs b/library/Rattletrap/Primitive/CompressedWord.hs --- a/library/Rattletrap/Primitive/CompressedWord.hs +++ b/library/Rattletrap/Primitive/CompressedWord.hs @@ -19,29 +19,24 @@ 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 () + 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 + 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 @@ -49,9 +44,6 @@ if position < maxBits && value + x <= limit then do bit <- BinaryBit.getBool - let newValue = - if bit - then value + x - else value + let newValue = if bit then value + x else value getCompressedWordStep limit maxBits (position + 1) newValue else pure value diff --git a/library/Rattletrap/Primitive/Dictionary.hs b/library/Rattletrap/Primitive/Dictionary.hs --- a/library/Rattletrap/Primitive/Dictionary.hs +++ b/library/Rattletrap/Primitive/Dictionary.hs @@ -50,10 +50,11 @@ putDictionary putValue dictionary = do let elements = dictionaryValue dictionary mapM_ - (\key -> do - putText key - case Map.lookup (textValue key) elements of - Nothing -> fail ("could not find key " ++ textToString key) - Just value -> putValue value) + ( \key -> do + putText key + case Map.lookup (textValue key) elements of + Nothing -> fail ("could not find key " ++ textToString key) + Just value -> putValue value + ) (dictionaryKeys dictionary) putText (dictionaryLastKey dictionary) diff --git a/library/Rattletrap/Primitive/Int8Vector.hs b/library/Rattletrap/Primitive/Int8Vector.hs --- a/library/Rattletrap/Primitive/Int8Vector.hs +++ b/library/Rattletrap/Primitive/Int8Vector.hs @@ -34,9 +34,8 @@ 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 +putInt8VectorField maybeField = case maybeField of + Nothing -> BinaryBit.putBool False + Just field -> do + BinaryBit.putBool True + putInt8Bits field diff --git a/library/Rattletrap/Primitive/Section.hs b/library/Rattletrap/Primitive/Section.hs --- a/library/Rattletrap/Primitive/Section.hs +++ b/library/Rattletrap/Primitive/Section.hs @@ -50,6 +50,5 @@ Binary.putLazyByteString rawBody crcMessage :: Word32 -> Word32 -> String -crcMessage actual expected = - unwords - ["actual CRC", show actual, "does not match expected CRC", show expected] +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 --- a/library/Rattletrap/Primitive/Text.hs +++ b/library/Rattletrap/Primitive/Text.hs @@ -58,49 +58,37 @@ getTextSize :: Text -> Int32 getTextSize text = - let value = textValue text - scale = - if Text.all Char.isLatin1 value - then 1 - else -1 - rawSize = - if Text.null value - then 0 - else fromIntegral (Text.length value) + 1 - size = - if value == Text.pack "\x00\x00\x00None" - then 0x05000000 - else scale * rawSize - in Int32 size + let + value = textValue text + scale = if Text.all Char.isLatin1 value then 1 else -1 + rawSize = + if Text.null value then 0 else fromIntegral (Text.length value) + 1 + size = if value == Text.pack "\x00\x00\x00None" + then 0x05000000 + else scale * rawSize + in + Int32 size normalizeTextSize :: Integral a => Int32 -> a -normalizeTextSize size = - case int32Value size of - 0x05000000 -> 8 - x -> - if x < 0 - then (-2 * fromIntegral x) - else fromIntegral x +normalizeTextSize 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) + 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 +getTextEncoder size text = if size < Int32 0 + then ByteString.fromStrict (Encoding.encodeUtf16LE text) + else encodeLatin1 text dropNull :: Text.Text -> Text.Text dropNull = Text.dropWhileEnd (== '\x00') addNull :: Text.Text -> Text.Text -addNull text = - if Text.null text - then text - else Text.snoc text '\x00' +addNull text = if Text.null text then text else Text.snoc text '\x00' diff --git a/library/Rattletrap/Primitive/Vector.hs b/library/Rattletrap/Primitive/Vector.hs --- a/library/Rattletrap/Primitive/Vector.hs +++ b/library/Rattletrap/Primitive/Vector.hs @@ -28,8 +28,9 @@ putVector :: Vector -> BinaryBit.BitPut () putVector vector = do - let bitSize = - round (logBase (2 :: Float) (fromIntegral (vectorBias vector))) - 1 + let + bitSize = + round (logBase (2 :: Float) (fromIntegral (vectorBias vector))) - 1 putCompressedWord (CompressedWord 19 bitSize) let dx = fromIntegral (vectorX vector + fromIntegral (vectorBias vector)) let dy = fromIntegral (vectorY vector + fromIntegral (vectorBias vector)) diff --git a/library/Rattletrap/PropertyValue.hs b/library/Rattletrap/PropertyValue.hs --- a/library/Rattletrap/PropertyValue.hs +++ b/library/Rattletrap/PropertyValue.hs @@ -21,52 +21,49 @@ deriving (Eq, Ord, Show) getPropertyValue :: Binary.Get a -> Text -> Binary.Get (PropertyValue a) -getPropertyValue getProperty kind = - case textToString kind of - "ArrayProperty" -> do - list <- getList (getDictionary getProperty) - pure (ArrayProperty list) - "BoolProperty" -> do - word8 <- getWord8 - pure (BoolProperty word8) - "ByteProperty" -> do - k <- getText - v <- - if textToString k == "OnlinePlatform_Steam" - then pure Nothing - else do - v <- getText - pure (Just v) - pure (ByteProperty k v) - "FloatProperty" -> do - float32 <- getFloat32 - pure (FloatProperty float32) - "IntProperty" -> do - int32 <- getInt32 - pure (IntProperty int32) - "NameProperty" -> do - text <- getText - pure (NameProperty text) - "QWordProperty" -> do - word64 <- getWord64 - pure (QWordProperty word64) - "StrProperty" -> do - text <- getText - pure (StrProperty text) - _ -> fail ("don't know how to read property value " ++ show kind) +getPropertyValue getProperty kind = case textToString kind of + "ArrayProperty" -> do + list <- getList (getDictionary getProperty) + pure (ArrayProperty list) + "BoolProperty" -> do + word8 <- getWord8 + pure (BoolProperty word8) + "ByteProperty" -> do + k <- getText + v <- if textToString k == "OnlinePlatform_Steam" + then pure Nothing + else do + v <- getText + pure (Just v) + pure (ByteProperty k v) + "FloatProperty" -> do + float32 <- getFloat32 + pure (FloatProperty float32) + "IntProperty" -> do + int32 <- getInt32 + pure (IntProperty int32) + "NameProperty" -> do + text <- getText + pure (NameProperty text) + "QWordProperty" -> do + word64 <- getWord64 + pure (QWordProperty word64) + "StrProperty" -> do + text <- getText + pure (StrProperty text) + _ -> fail ("don't know how to read property value " ++ show kind) putPropertyValue :: (a -> Binary.Put) -> PropertyValue a -> Binary.Put -putPropertyValue putProperty value = - case value of - ArrayProperty list -> putList (putDictionary putProperty) list - BoolProperty word8 -> putWord8 word8 - ByteProperty k mv -> do - putText k - case mv of - Nothing -> pure () - Just v -> putText v - FloatProperty float32 -> putFloat32 float32 - IntProperty int32 -> putInt32 int32 - NameProperty text -> putText text - QWordProperty word64 -> putWord64 word64 - StrProperty text -> putText text +putPropertyValue putProperty value = case value of + ArrayProperty list -> putList (putDictionary putProperty) list + BoolProperty word8 -> putWord8 word8 + ByteProperty k mv -> do + putText k + case mv of + Nothing -> pure () + Just v -> putText v + FloatProperty float32 -> putFloat32 float32 + IntProperty int32 -> putInt32 int32 + NameProperty text -> putText text + QWordProperty word64 -> putWord64 word64 + StrProperty text -> putText text diff --git a/library/Rattletrap/RemoteId.hs b/library/Rattletrap/RemoteId.hs --- a/library/Rattletrap/RemoteId.hs +++ b/library/Rattletrap/RemoteId.hs @@ -18,38 +18,36 @@ | XboxId Word64 deriving (Eq, Ord, Show) -getRemoteId :: Word8 -> BinaryBit.BitGet RemoteId -getRemoteId systemId = - case word8Value systemId of - 0 -> do - word24 <- BinaryBit.getWord32be 24 - pure (SplitscreenId word24) - 1 -> do - word64 <- getWord64Bits - pure (SteamId word64) - 2 -> do - rawName <- BinaryBit.getLazyByteString 16 - let name = - Text.dropWhileEnd - (== '\x00') - (Encoding.decodeLatin1 - (ByteString.toStrict (reverseBytes rawName))) - bytes <- BinaryBit.getLazyByteString 16 - pure (PlayStationId name (ByteString.unpack bytes)) - 4 -> do - word64 <- getWord64Bits - pure (XboxId word64) - _ -> fail ("unknown system id " ++ show systemId) +getRemoteId :: (Int, Int, Int) -> Word8 -> BinaryBit.BitGet RemoteId +getRemoteId (_, _, patchVersion) systemId = case word8Value systemId of + 0 -> do + word24 <- BinaryBit.getWord32be 24 + pure (SplitscreenId word24) + 1 -> do + word64 <- getWord64Bits + pure (SteamId word64) + 2 -> do + rawName <- BinaryBit.getLazyByteString 16 + let + name = Text.dropWhileEnd + (== '\x00') + (Encoding.decodeLatin1 (ByteString.toStrict (reverseBytes rawName))) + numBytes = if patchVersion >= 1 then 24 else 16 + bytes <- BinaryBit.getLazyByteString numBytes + pure (PlayStationId name (ByteString.unpack bytes)) + 4 -> do + word64 <- getWord64Bits + pure (XboxId word64) + _ -> fail ("unknown system id " ++ show systemId) putRemoteId :: RemoteId -> BinaryBit.BitPut () -putRemoteId remoteId = - case remoteId of - PlayStationId name bytes -> do - let rawName = - ByteString.toStrict - (reverseBytes (padBytes (16 :: Int) (encodeLatin1 name))) - BinaryBit.putByteString rawName - BinaryBit.putByteString (ByteString.toStrict (ByteString.pack bytes)) - SplitscreenId word24 -> BinaryBit.putWord32be 24 word24 - SteamId word64 -> putWord64Bits word64 - XboxId word64 -> putWord64Bits word64 +putRemoteId remoteId = case remoteId of + PlayStationId name bytes -> do + let + rawName = ByteString.toStrict + (reverseBytes (padBytes (16 :: Int) (encodeLatin1 name))) + BinaryBit.putByteString rawName + BinaryBit.putByteString (ByteString.toStrict (ByteString.pack bytes)) + SplitscreenId word24 -> BinaryBit.putWord32be 24 word24 + SteamId word64 -> putWord64Bits word64 + XboxId word64 -> putWord64Bits word64 diff --git a/library/Rattletrap/Replication.hs b/library/Rattletrap/Replication.hs --- a/library/Rattletrap/Replication.hs +++ b/library/Rattletrap/Replication.hs @@ -13,20 +13,26 @@ , replicationValue :: ReplicationValue } deriving (Eq, Ord, Show) -getReplications :: - (Int, Int) +getReplications + :: (Int, Int, Int) -> Word -> ClassAttributeMap -> ActorMap -> BinaryBit.BitGet ([Replication], ActorMap) getReplications version maxChannels classAttributeMap actorMap = do - maybeReplication <- - getReplication version maxChannels classAttributeMap actorMap + maybeReplication <- getReplication + version + maxChannels + classAttributeMap + actorMap case maybeReplication of Nothing -> pure ([], actorMap) Just (replication, newActorMap) -> do - (replications, newerActorMap) <- - getReplications version maxChannels classAttributeMap newActorMap + (replications, newerActorMap) <- getReplications + version + maxChannels + classAttributeMap + newActorMap pure (replication : replications, newerActorMap) putReplications :: [Replication] -> BinaryBit.BitPut () @@ -34,8 +40,8 @@ mapM_ putReplication replications BinaryBit.putBool False -getReplication :: - (Int, Int) +getReplication + :: (Int, Int, Int) -> Word -> ClassAttributeMap -> ActorMap @@ -46,8 +52,11 @@ then pure Nothing else do actorId <- getCompressedWord maxChannels - (value, newActorMap) <- - getReplicationValue version classAttributeMap actorMap actorId + (value, newActorMap) <- getReplicationValue + version + classAttributeMap + actorMap + actorId pure (Just (Replication actorId value, newActorMap)) putReplication :: Replication -> BinaryBit.BitPut () diff --git a/library/Rattletrap/Replication/Spawned.hs b/library/Rattletrap/Replication/Spawned.hs --- a/library/Rattletrap/Replication/Spawned.hs +++ b/library/Rattletrap/Replication/Spawned.hs @@ -26,20 +26,19 @@ , spawnedReplicationInitialization :: Initialization } deriving (Eq, Ord, Show) -getSpawnedReplication :: - (Int, Int) +getSpawnedReplication + :: (Int, Int, Int) -> ClassAttributeMap -> ActorMap -> CompressedWord -> BinaryBit.BitGet (SpawnedReplication, ActorMap) getSpawnedReplication version classAttributeMap actorMap actorId = do flag <- BinaryBit.getBool - nameIndex <- - if version < (868, 14) - then pure Nothing - else do - nameIndex <- getWord32Bits - pure (Just nameIndex) + nameIndex <- if version < (868, 14, 0) + then pure Nothing + else do + nameIndex <- getWord32Bits + pure (Just nameIndex) name <- lookupName classAttributeMap nameIndex objectId <- getWord32Bits let newActorMap = Map.insert actorId objectId actorMap @@ -50,14 +49,15 @@ initialization <- getInitialization hasLocation hasRotation pure ( SpawnedReplication - flag - nameIndex - name - objectId - objectName - className - initialization - , newActorMap) + flag + nameIndex + name + objectId + objectName + className + initialization + , newActorMap + ) putSpawnedReplication :: SpawnedReplication -> BinaryBit.BitPut () putSpawnedReplication spawnedReplication = do @@ -69,13 +69,12 @@ putInitialization (spawnedReplicationInitialization spawnedReplication) lookupName :: Monad m => ClassAttributeMap -> Maybe Word32 -> m (Maybe Text) -lookupName classAttributeMap maybeNameIndex = - case maybeNameIndex of - Nothing -> pure Nothing - Just nameIndex -> - case getName (classAttributeMapNameMap classAttributeMap) nameIndex of - Nothing -> fail ("could not get name for index " ++ show nameIndex) - Just name -> pure (Just name) +lookupName classAttributeMap maybeNameIndex = case maybeNameIndex of + Nothing -> pure Nothing + Just nameIndex -> + case getName (classAttributeMapNameMap classAttributeMap) nameIndex of + Nothing -> fail ("could not get name for index " ++ show nameIndex) + Just name -> pure (Just name) lookupObjectName :: Monad m => ClassAttributeMap -> Word32 -> m Text lookupObjectName classAttributeMap objectId = @@ -84,7 +83,6 @@ 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 +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 --- a/library/Rattletrap/Replication/Updated.hs +++ b/library/Rattletrap/Replication/Updated.hs @@ -12,8 +12,8 @@ { updatedReplicationAttributes :: [Attribute] } deriving (Eq, Ord, Show) -getUpdatedReplication :: - (Int, Int) +getUpdatedReplication + :: (Int, Int, Int) -> ClassAttributeMap -> ActorMap -> CompressedWord diff --git a/library/Rattletrap/ReplicationValue.hs b/library/Rattletrap/ReplicationValue.hs --- a/library/Rattletrap/ReplicationValue.hs +++ b/library/Rattletrap/ReplicationValue.hs @@ -24,8 +24,8 @@ -- ^ Destroys an existing actor. deriving (Eq, Ord, Show) -getReplicationValue :: - (Int, Int) +getReplicationValue + :: (Int, Int, Int) -> ClassAttributeMap -> ActorMap -> CompressedWord @@ -37,8 +37,11 @@ isNew <- BinaryBit.getBool if isNew then do - (x, newActorMap) <- - getSpawnedReplication version classAttributeMap actorMap actorId + (x, newActorMap) <- getSpawnedReplication + version + classAttributeMap + actorMap + actorId pure (SpawnedReplicationValue x, newActorMap) else do x <- getUpdatedReplication version classAttributeMap actorMap actorId @@ -48,16 +51,15 @@ pure (DestroyedReplicationValue x, actorMap) putReplicationValue :: ReplicationValue -> BinaryBit.BitPut () -putReplicationValue value = - case value of - SpawnedReplicationValue x -> do - BinaryBit.putBool True - BinaryBit.putBool True - putSpawnedReplication x - UpdatedReplicationValue x -> do - BinaryBit.putBool True - BinaryBit.putBool False - putUpdatedReplication x - DestroyedReplicationValue x -> do - BinaryBit.putBool False - putDestroyedReplication x +putReplicationValue value = case value of + SpawnedReplicationValue x -> do + BinaryBit.putBool True + BinaryBit.putBool True + putSpawnedReplication x + UpdatedReplicationValue x -> do + BinaryBit.putBool True + BinaryBit.putBool False + putUpdatedReplication x + DestroyedReplicationValue x -> do + BinaryBit.putBool False + putDestroyedReplication x diff --git a/library/Rattletrap/Utility.hs b/library/Rattletrap/Utility.hs --- a/library/Rattletrap/Utility.hs +++ b/library/Rattletrap/Utility.hs @@ -10,22 +10,21 @@ encodeLatin1 text = ByteString8.pack (Text.unpack text) padBytes :: Integral a => a -> ByteString.ByteString -> ByteString.ByteString -padBytes size bytes = - ByteString.concat - [ bytes - , ByteString.replicate (fromIntegral size - ByteString.length bytes) 0x00 - ] +padBytes size bytes = ByteString.concat + [ bytes + , ByteString.replicate (fromIntegral size - ByteString.length bytes) 0x00 + ] reverseByte :: Word.Word8 -> Word.Word8 reverseByte byte = - Bits.shiftR (byte Bits..&. Bits.bit 7) 7 + - Bits.shiftR (byte Bits..&. Bits.bit 6) 5 + - Bits.shiftR (byte Bits..&. Bits.bit 5) 3 + - Bits.shiftR (byte Bits..&. Bits.bit 4) 1 + - Bits.shiftL (byte Bits..&. Bits.bit 3) 1 + - Bits.shiftL (byte Bits..&. Bits.bit 2) 3 + - Bits.shiftL (byte Bits..&. Bits.bit 1) 5 + - Bits.shiftL (byte Bits..&. Bits.bit 0) 7 + Bits.shiftR (byte Bits..&. Bits.bit 7) 7 + + Bits.shiftR (byte Bits..&. Bits.bit 6) 5 + + Bits.shiftR (byte Bits..&. Bits.bit 5) 3 + + Bits.shiftR (byte Bits..&. Bits.bit 4) 1 + + Bits.shiftL (byte Bits..&. Bits.bit 3) 1 + + Bits.shiftL (byte Bits..&. Bits.bit 2) 3 + + Bits.shiftL (byte Bits..&. Bits.bit 1) 5 + + Bits.shiftL (byte Bits..&. Bits.bit 0) 7 reverseBytes :: ByteString.ByteString -> ByteString.ByteString reverseBytes = ByteString.map reverseByte diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: rattletrap -version: 3.1.0 +version: 3.1.1 category: Game description: Rattletrap parses and generates Rocket League replays. @@ -16,19 +16,19 @@ synopsis: Parse and generate Rocket League replays. dependencies: - - aeson >= 1.0.2 && < 1.3 - - base >= 4.9.1 && < 4.11 - - bimap >= 0.3.2 && < 0.4 - - binary >= 0.8.3 && < 0.9 + - aeson >= 1.2.3 && < 1.3 + - base >= 4.10.1 && < 4.11 + - bimap >= 0.3.3 && < 0.4 + - binary >= 0.8.5 && < 0.9 - binary-bits >= 0.5 && < 0.6 - bytestring >= 0.10.8 && < 0.11 - - containers >= 0.5.7 && < 0.6 + - containers >= 0.5.10 && < 0.6 - data-binary-ieee754 >= 0.4.4 && < 0.5 - http-client >= 0.5.7 && < 0.6 - http-client-tls >= 0.3.5 && < 0.4 - - template-haskell >= 2.11.0 && < 2.13 + - template-haskell >= 2.12.0 && < 2.13 - text >= 1.2.2 && < 1.3 - - vector >= 0.11.0 && < 0.13 + - vector >= 0.12.0 && < 0.13 ghc-options: -Wall library: @@ -52,9 +52,9 @@ test: dependencies: - filepath >= 1.4.1 && < 1.5 - - hspec >= 2.4.1 && < 2.5 + - hspec >= 2.4.4 && < 2.5 - rattletrap - - temporary >= 1.2.0 && < 1.3 + - temporary >= 1.2.1 && < 1.3 ghc-options: - -rtsopts - -threaded diff --git a/rattletrap.cabal b/rattletrap.cabal --- a/rattletrap.cabal +++ b/rattletrap.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.17.0. +-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack name: rattletrap -version: 3.1.0 +version: 3.1.1 synopsis: Parse and generate Rocket League replays. description: Rattletrap parses and generates Rocket League replays. category: Game @@ -37,6 +37,7 @@ replays/22BACD794ABE7B92E50E9CBDBD9C59CE.replay replays/27B6A7B64553F0F685874584F96BAB1B.replay replays/29F582C34A65EB34D358A784CBE3C189.replay + replays/2CFE577044E651D3FA9DBF83ECA8BCC3.replay replays/338173964F9F71EBDD31058A1936CBB4.replay replays/372DBFCA4BDB340E4357B6BD43032802.replay replays/387F059C47C09E253C875CA990EFD9F2.replay @@ -91,19 +92,19 @@ default-extensions: Strict ghc-options: -Wall build-depends: - aeson >= 1.0.2 && < 1.3 - , base >= 4.9.1 && < 4.11 - , bimap >= 0.3.2 && < 0.4 - , binary >= 0.8.3 && < 0.9 + aeson >= 1.2.3 && < 1.3 + , base >= 4.10.1 && < 4.11 + , bimap >= 0.3.3 && < 0.4 + , binary >= 0.8.5 && < 0.9 , binary-bits >= 0.5 && < 0.6 , bytestring >= 0.10.8 && < 0.11 - , containers >= 0.5.7 && < 0.6 + , containers >= 0.5.10 && < 0.6 , data-binary-ieee754 >= 0.4.4 && < 0.5 , http-client >= 0.5.7 && < 0.6 , http-client-tls >= 0.3.5 && < 0.4 - , template-haskell >= 2.11.0 && < 2.13 + , template-haskell >= 2.12.0 && < 2.13 , text >= 1.2.2 && < 1.3 - , vector >= 0.11.0 && < 0.13 + , vector >= 0.12.0 && < 0.13 exposed-modules: Rattletrap Rattletrap.ActorMap @@ -131,7 +132,7 @@ Rattletrap.Attribute.PartyLeader Rattletrap.Attribute.Pickup Rattletrap.Attribute.PrivateMatchSettings - Rattletrap.Attribute.ProductAttribute + Rattletrap.Attribute.Product Rattletrap.Attribute.QWord Rattletrap.Attribute.Reservation Rattletrap.Attribute.RigidBodyState @@ -193,19 +194,19 @@ executables ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - aeson >= 1.0.2 && < 1.3 - , base >= 4.9.1 && < 4.11 - , bimap >= 0.3.2 && < 0.4 - , binary >= 0.8.3 && < 0.9 + aeson >= 1.2.3 && < 1.3 + , base >= 4.10.1 && < 4.11 + , bimap >= 0.3.3 && < 0.4 + , binary >= 0.8.5 && < 0.9 , binary-bits >= 0.5 && < 0.6 , bytestring >= 0.10.8 && < 0.11 - , containers >= 0.5.7 && < 0.6 + , containers >= 0.5.10 && < 0.6 , data-binary-ieee754 >= 0.4.4 && < 0.5 , http-client >= 0.5.7 && < 0.6 , http-client-tls >= 0.3.5 && < 0.4 - , template-haskell >= 2.11.0 && < 2.13 + , template-haskell >= 2.12.0 && < 2.13 , text >= 1.2.2 && < 1.3 - , vector >= 0.11.0 && < 0.13 + , vector >= 0.12.0 && < 0.13 , rattletrap default-language: Haskell2010 @@ -216,21 +217,21 @@ tests ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - aeson >= 1.0.2 && < 1.3 - , base >= 4.9.1 && < 4.11 - , bimap >= 0.3.2 && < 0.4 - , binary >= 0.8.3 && < 0.9 + aeson >= 1.2.3 && < 1.3 + , base >= 4.10.1 && < 4.11 + , bimap >= 0.3.3 && < 0.4 + , binary >= 0.8.5 && < 0.9 , binary-bits >= 0.5 && < 0.6 , bytestring >= 0.10.8 && < 0.11 - , containers >= 0.5.7 && < 0.6 + , containers >= 0.5.10 && < 0.6 , data-binary-ieee754 >= 0.4.4 && < 0.5 , http-client >= 0.5.7 && < 0.6 , http-client-tls >= 0.3.5 && < 0.4 - , template-haskell >= 2.11.0 && < 2.13 + , template-haskell >= 2.12.0 && < 2.13 , text >= 1.2.2 && < 1.3 - , vector >= 0.11.0 && < 0.13 + , vector >= 0.12.0 && < 0.13 , filepath >= 1.4.1 && < 1.5 - , hspec >= 2.4.1 && < 2.5 + , hspec >= 2.4.4 && < 2.5 , rattletrap - , temporary >= 1.2.0 && < 1.3 + , temporary >= 1.2.1 && < 1.3 default-language: Haskell2010 diff --git a/replays/2CFE577044E651D3FA9DBF83ECA8BCC3.replay b/replays/2CFE577044E651D3FA9DBF83ECA8BCC3.replay new file mode 100644 Binary files /dev/null and b/replays/2CFE577044E651D3FA9DBF83ECA8BCC3.replay differ diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,117 +1,5 @@ -resolver: ghc-8.2.1 +resolver: nightly-2017-11-25 packages: - . - tools - -extra-deps: - - aeson-1.2.1.0 - - ansi-terminal-0.6.3.1 - - async-2.1.1.1 - - attoparsec-0.13.1.0 - - base-compat-0.9.3 - - bimap-0.3.3 - - binary-bits-0.5 - - call-stack-0.1.0 - - data-binary-ieee754-0.4.4 - - dlist-0.8.0.3 - - exceptions-0.8.3 - - hashable-1.2.6.1 - - hspec-2.4.4 - - hspec-core-2.4.4 - - hspec-discover-2.4.4 - - hspec-expectations-0.8.2 - - HUnit-1.6.0.0 - - integer-logarithms-1.0.2 - - mtl-2.2.1 - - old-locale-1.0.0.7 - - primitive-0.6.2.0 - - QuickCheck-2.10.0.1 - - quickcheck-io-0.2.0 - - random-1.1 - - scientific-0.3.5.1 - - setenv-0.1.1.3 - - stm-2.4.4.1 - - tagged-0.8.5 - - temporary-1.2.1 - - text-1.2.2.2 - - tf-random-0.5 - - time-locale-compat-0.1.1.3 - - transformers-compat-0.5.1.4 - - unordered-containers-0.2.8.0 - - uuid-types-1.0.3 - - vector-0.12.0.1 - - # tools - - adjunctions-4.3 - - ansi-wl-pprint-0.6.7.3 - - asn1-encoding-0.9.5 - - asn1-parse-0.9.4 - - asn1-types-0.3.2 - - base-orphans-0.6 - - base64-bytestring-1.0.0.1 - - bifunctors-5.4.2 - - blaze-builder-0.4.0.2 - - blaze-html-0.9.0.1 - - blaze-markup-0.8.0.0 - - byteable-0.1.1 - - cabal-doctest-1.0.2 - - case-insensitive-1.2.0.10 - - cereal-0.5.4.0 - - charset-0.3.7.1 - - comonad-5.0.1 - - connection-0.2.8 - - contravariant-1.4 - - cookie-0.4.2.1 - - cryptonite-0.24 - - data-default-class-0.1.2.0 - - distributive-0.5.2 - - fail-4.9.0.0 - - fingertree-0.1.1.0 - - foundation-0.0.13 - - free-4.12.4 - - github-release-1.0.4 - - hourglass-0.2.10 - - HTTP-4000.3.7 - - http-client-0.5.7.0 - - http-client-tls-0.3.5.1 - - http-types-0.9.1 - - kan-extensions-5.0.2 - - lens-4.15.3 - - memory-0.14.6 - - mime-types-0.1.0.7 - - network-2.6.3.2 - - network-uri-2.6.1.0 - - Only-0.1 - - optparse-applicative-0.14.0.0 - - optparse-generic-1.2.2 - - parallel-3.2.1.1 - - parsec-3.1.11 - - parsers-0.12.5 - - pem-0.2.2 - - prelude-extras-0.4.0.3 - - profunctors-5.2 - - reducers-3.12.1 - - reflection-2.1.2 - - safe-0.3.15 - - semigroupoids-5.2 - - semigroups-0.18.3 - - socks-0.5.5 - - StateVar-1.1.0.4 - - streaming-commons-0.1.18 - - system-filepath-0.4.13.4 - - th-abstraction-0.2.3.0 - - tls-1.3.11 - - trifecta-1.7 - - uri-templater-0.2.1.0 - - utf8-string-1.0.1.1 - - void-0.7.2 - - x509-1.7.1 - - x509-store-1.6.3 - - x509-system-1.6.5 - - x509-validation-1.6.8 - - zlib-0.6.1.2 - -flags: - time-locale-compat: - old-locale: false diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -24,15 +24,16 @@ 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")) + ( \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 = @@ -58,6 +59,7 @@ , ("22BACD794ABE7B92E50E9CBDBD9C59CE", "a vote to forfeit") , ("27B6A7B64553F0F685874584F96BAB1B", "some UTF-16 text") , ("29F582C34A65EB34D358A784CBE3C189", "frames") + , ("2CFE577044E651D3FA9DBF83ECA8BCC3", "a new playstation id") , ("338173964F9F71EBDD31058A1936CBB4", "patch 1.37") , ("372DBFCA4BDB340E4357B6BD43032802", "a camera yaw attribute") , ("387F059C47C09E253C875CA990EFD9F2", "a frozen attribute")