diff --git a/rattletrap.cabal b/rattletrap.cabal --- a/rattletrap.cabal +++ b/rattletrap.cabal @@ -1,7 +1,7 @@ -cabal-version: >= 1.10 +cabal-version: 2.0 name: rattletrap -version: 9.4.1 +version: 10.0.0 synopsis: Parse and generate Rocket League replays. description: Rattletrap parses and generates Rocket League replays. @@ -16,16 +16,13 @@ type: git location: https://github.com/tfausak/rattletrap -flag static - manual: True - default: False - library autogen-modules: Paths_rattletrap build-depends: base >= 4.14.1 && < 4.15 , aeson >= 1.5.5 && < 1.6 , aeson-pretty >= 0.8.8 && < 0.9 + , array >= 0.5.4 && < 0.6 , binary >= 0.8.8 && < 0.9 , bytestring >= 0.10.12 && < 0.11 , caerbannog >= 0.6.0 && < 0.7 @@ -33,288 +30,139 @@ , filepath >= 1.4.2 && < 1.5 , http-client >= 0.6.4 && < 0.8 , http-client-tls >= 0.3.5 && < 0.4 - , scientific >= 0.3.6 && < 0.4 - , template-haskell >= 2.16.0 && < 2.17 , text >= 1.2.4 && < 1.3 , transformers >= 0.5.6 && < 0.6 + default-extensions: NamedFieldPuns default-language: Haskell2010 - exposed-modules: Rattletrap - ghc-options: - -Weverything - -Wno-all-missed-specialisations - -Wno-implicit-prelude - -Wno-missing-deriving-strategies - -Wno-missing-exported-signatures - -Wno-missing-import-lists - -Wno-safe - -Wno-unsafe - hs-source-dirs: src/lib - other-modules: + exposed-modules: Paths_rattletrap + Rattletrap + Rattletrap.BitGet + Rattletrap.BitPut + Rattletrap.ByteGet + Rattletrap.BytePut + Rattletrap.Console.Config + Rattletrap.Console.Flag Rattletrap.Console.Main + Rattletrap.Console.Mode + Rattletrap.Console.Option Rattletrap.Data - Rattletrap.Decode.AppliedDamageAttribute - Rattletrap.Decode.Attribute - Rattletrap.Decode.AttributeMapping - Rattletrap.Decode.AttributeValue - Rattletrap.Decode.BooleanAttribute - Rattletrap.Decode.ByteAttribute - Rattletrap.Decode.Cache - Rattletrap.Decode.CamSettingsAttribute - Rattletrap.Decode.ClassMapping - Rattletrap.Decode.ClubColorsAttribute - Rattletrap.Decode.Common - Rattletrap.Decode.CompressedWord - Rattletrap.Decode.CompressedWordVector - Rattletrap.Decode.Content - Rattletrap.Decode.CustomDemolishAttribute - Rattletrap.Decode.DamageStateAttribute - Rattletrap.Decode.DemolishAttribute - Rattletrap.Decode.DestroyedReplication - Rattletrap.Decode.Dictionary - Rattletrap.Decode.EnumAttribute - Rattletrap.Decode.ExplosionAttribute - Rattletrap.Decode.ExtendedExplosionAttribute - Rattletrap.Decode.FlaggedIntAttribute - Rattletrap.Decode.FlaggedByteAttribute - Rattletrap.Decode.Float32le - Rattletrap.Decode.FloatAttribute - Rattletrap.Decode.Frame - Rattletrap.Decode.GameModeAttribute - Rattletrap.Decode.Header - Rattletrap.Decode.Initialization - Rattletrap.Decode.Int32le - Rattletrap.Decode.Int64Attribute - Rattletrap.Decode.Int64le - Rattletrap.Decode.Int8le - Rattletrap.Decode.Int8Vector - Rattletrap.Decode.IntAttribute - Rattletrap.Decode.KeyFrame - Rattletrap.Decode.List - Rattletrap.Decode.LoadoutAttribute - Rattletrap.Decode.LoadoutOnlineAttribute - Rattletrap.Decode.LoadoutsAttribute - Rattletrap.Decode.LoadoutsOnlineAttribute - Rattletrap.Decode.LocationAttribute - Rattletrap.Decode.Mark - Rattletrap.Decode.Message - Rattletrap.Decode.MusicStingerAttribute - Rattletrap.Decode.PartyLeaderAttribute - Rattletrap.Decode.PickupAttribute - Rattletrap.Decode.PickupAttributeNew - Rattletrap.Decode.PlayerHistoryKeyAttribute - Rattletrap.Decode.PrivateMatchSettingsAttribute - Rattletrap.Decode.ProductAttribute - Rattletrap.Decode.Property - Rattletrap.Decode.PropertyValue - Rattletrap.Decode.Quaternion - Rattletrap.Decode.QWordAttribute - Rattletrap.Decode.RemoteId - Rattletrap.Decode.Replay - Rattletrap.Decode.Replication - Rattletrap.Decode.ReplicationValue - Rattletrap.Decode.ReservationAttribute - Rattletrap.Decode.RigidBodyStateAttribute - Rattletrap.Decode.Rotation - Rattletrap.Decode.Section - Rattletrap.Decode.SpawnedReplication - Rattletrap.Decode.StatEventAttribute - Rattletrap.Decode.Str - Rattletrap.Decode.StringAttribute - Rattletrap.Decode.TeamPaintAttribute - Rattletrap.Decode.TitleAttribute - Rattletrap.Decode.UniqueIdAttribute - Rattletrap.Decode.UpdatedReplication - Rattletrap.Decode.Vector - Rattletrap.Decode.WeldedInfoAttribute - Rattletrap.Decode.Word32le - Rattletrap.Decode.Word64le - Rattletrap.Decode.Word8le - Rattletrap.Encode.AppliedDamageAttribute - Rattletrap.Encode.Attribute - Rattletrap.Encode.AttributeMapping - Rattletrap.Encode.AttributeValue - Rattletrap.Encode.BooleanAttribute - Rattletrap.Encode.ByteAttribute - Rattletrap.Encode.Cache - Rattletrap.Encode.CamSettingsAttribute - Rattletrap.Encode.ClassMapping - Rattletrap.Encode.ClubColorsAttribute - Rattletrap.Encode.Common - Rattletrap.Encode.CompressedWord - Rattletrap.Encode.CompressedWordVector - Rattletrap.Encode.Content - Rattletrap.Encode.CustomDemolishAttribute - Rattletrap.Encode.DamageStateAttribute - Rattletrap.Encode.DemolishAttribute - Rattletrap.Encode.DestroyedReplication - Rattletrap.Encode.Dictionary - Rattletrap.Encode.EnumAttribute - Rattletrap.Encode.ExplosionAttribute - Rattletrap.Encode.ExtendedExplosionAttribute - Rattletrap.Encode.FlaggedIntAttribute - Rattletrap.Encode.FlaggedByteAttribute - Rattletrap.Encode.Float32le - Rattletrap.Encode.FloatAttribute - Rattletrap.Encode.Frame - Rattletrap.Encode.GameModeAttribute - Rattletrap.Encode.Header - Rattletrap.Encode.Initialization - Rattletrap.Encode.Int32le - Rattletrap.Encode.Int64Attribute - Rattletrap.Encode.Int64le - Rattletrap.Encode.Int8le - Rattletrap.Encode.Int8Vector - Rattletrap.Encode.IntAttribute - Rattletrap.Encode.KeyFrame - Rattletrap.Encode.List - Rattletrap.Encode.LoadoutAttribute - Rattletrap.Encode.LoadoutOnlineAttribute - Rattletrap.Encode.LoadoutsAttribute - Rattletrap.Encode.LoadoutsOnlineAttribute - Rattletrap.Encode.LocationAttribute - Rattletrap.Encode.Mark - Rattletrap.Encode.Message - Rattletrap.Encode.MusicStingerAttribute - Rattletrap.Encode.PartyLeaderAttribute - Rattletrap.Encode.PickupAttribute - Rattletrap.Encode.PickupAttributeNew - Rattletrap.Encode.PlayerHistoryKeyAttribute - Rattletrap.Encode.PrivateMatchSettingsAttribute - Rattletrap.Encode.ProductAttribute - Rattletrap.Encode.Property - Rattletrap.Encode.PropertyValue - Rattletrap.Encode.Quaternion - Rattletrap.Encode.QWordAttribute - Rattletrap.Encode.RemoteId - Rattletrap.Encode.Replay - Rattletrap.Encode.Replication - Rattletrap.Encode.ReplicationValue - Rattletrap.Encode.ReservationAttribute - Rattletrap.Encode.RigidBodyStateAttribute - Rattletrap.Encode.Rotation - Rattletrap.Encode.Section - Rattletrap.Encode.SpawnedReplication - Rattletrap.Encode.StatEventAttribute - Rattletrap.Encode.Str - Rattletrap.Encode.StringAttribute - Rattletrap.Encode.TeamPaintAttribute - Rattletrap.Encode.TitleAttribute - Rattletrap.Encode.UniqueIdAttribute - Rattletrap.Encode.UpdatedReplication - Rattletrap.Encode.Vector - Rattletrap.Encode.WeldedInfoAttribute - Rattletrap.Encode.Word32le - Rattletrap.Encode.Word64le - Rattletrap.Encode.Word8le - Rattletrap.Type.AppliedDamageAttribute + Rattletrap.Get + Rattletrap.Schema Rattletrap.Type.Attribute + Rattletrap.Type.Attribute.AppliedDamage + Rattletrap.Type.Attribute.Boolean + Rattletrap.Type.Attribute.Byte + Rattletrap.Type.Attribute.CamSettings + Rattletrap.Type.Attribute.ClubColors + Rattletrap.Type.Attribute.CustomDemolish + Rattletrap.Type.Attribute.DamageState + Rattletrap.Type.Attribute.Demolish + Rattletrap.Type.Attribute.Enum + Rattletrap.Type.Attribute.Explosion + Rattletrap.Type.Attribute.ExtendedExplosion + Rattletrap.Type.Attribute.FlaggedByte + Rattletrap.Type.Attribute.FlaggedInt + Rattletrap.Type.Attribute.Float + Rattletrap.Type.Attribute.GameMode + Rattletrap.Type.Attribute.Int + Rattletrap.Type.Attribute.Int64 + Rattletrap.Type.Attribute.Loadout + Rattletrap.Type.Attribute.LoadoutOnline + Rattletrap.Type.Attribute.Loadouts + Rattletrap.Type.Attribute.LoadoutsOnline + Rattletrap.Type.Attribute.Location + Rattletrap.Type.Attribute.MusicStinger + Rattletrap.Type.Attribute.PartyLeader + Rattletrap.Type.Attribute.Pickup + Rattletrap.Type.Attribute.PickupNew + Rattletrap.Type.Attribute.PlayerHistoryKey + Rattletrap.Type.Attribute.PrivateMatchSettings + Rattletrap.Type.Attribute.Product + Rattletrap.Type.Attribute.ProductValue + Rattletrap.Type.Attribute.QWord + Rattletrap.Type.Attribute.Reservation + Rattletrap.Type.Attribute.RigidBodyState + Rattletrap.Type.Attribute.StatEvent + Rattletrap.Type.Attribute.String + Rattletrap.Type.Attribute.TeamPaint + Rattletrap.Type.Attribute.Title + Rattletrap.Type.Attribute.UniqueId + Rattletrap.Type.Attribute.WeldedInfo Rattletrap.Type.AttributeMapping Rattletrap.Type.AttributeType Rattletrap.Type.AttributeValue - Rattletrap.Type.BooleanAttribute - Rattletrap.Type.ByteAttribute Rattletrap.Type.Cache - Rattletrap.Type.CamSettingsAttribute Rattletrap.Type.ClassAttributeMap Rattletrap.Type.ClassMapping - Rattletrap.Type.ClubColorsAttribute - Rattletrap.Type.Common Rattletrap.Type.CompressedWord Rattletrap.Type.CompressedWordVector Rattletrap.Type.Content - Rattletrap.Type.CustomDemolishAttribute - Rattletrap.Type.DamageStateAttribute - Rattletrap.Type.DemolishAttribute - Rattletrap.Type.DestroyedReplication Rattletrap.Type.Dictionary - Rattletrap.Type.EnumAttribute - Rattletrap.Type.ExplosionAttribute - Rattletrap.Type.ExtendedExplosionAttribute - Rattletrap.Type.FlaggedIntAttribute - Rattletrap.Type.FlaggedByteAttribute - Rattletrap.Type.Float32le - Rattletrap.Type.FloatAttribute + Rattletrap.Type.F32 Rattletrap.Type.Frame - Rattletrap.Type.GameModeAttribute Rattletrap.Type.Header + Rattletrap.Type.I32 + Rattletrap.Type.I64 + Rattletrap.Type.I8 Rattletrap.Type.Initialization - Rattletrap.Type.Int32le - Rattletrap.Type.Int64Attribute - Rattletrap.Type.Int64le - Rattletrap.Type.Int8le Rattletrap.Type.Int8Vector - Rattletrap.Type.IntAttribute Rattletrap.Type.KeyFrame Rattletrap.Type.List - Rattletrap.Type.LoadoutAttribute - Rattletrap.Type.LoadoutOnlineAttribute - Rattletrap.Type.LoadoutsAttribute - Rattletrap.Type.LoadoutsOnlineAttribute - Rattletrap.Type.LocationAttribute Rattletrap.Type.Mark Rattletrap.Type.Message - Rattletrap.Type.MusicStingerAttribute - Rattletrap.Type.PartyLeaderAttribute - Rattletrap.Type.PickupAttribute - Rattletrap.Type.PickupAttributeNew - Rattletrap.Type.PlayerHistoryKeyAttribute - Rattletrap.Type.PrivateMatchSettingsAttribute - Rattletrap.Type.ProductAttribute Rattletrap.Type.Property Rattletrap.Type.PropertyValue Rattletrap.Type.Quaternion - Rattletrap.Type.QWordAttribute Rattletrap.Type.RemoteId Rattletrap.Type.Replay Rattletrap.Type.Replication + Rattletrap.Type.Replication.Destroyed + Rattletrap.Type.Replication.Spawned + Rattletrap.Type.Replication.Updated Rattletrap.Type.ReplicationValue - Rattletrap.Type.ReservationAttribute - Rattletrap.Type.RigidBodyStateAttribute Rattletrap.Type.Rotation Rattletrap.Type.Section - Rattletrap.Type.SpawnedReplication - Rattletrap.Type.StatEventAttribute Rattletrap.Type.Str - Rattletrap.Type.StringAttribute - Rattletrap.Type.TeamPaintAttribute - Rattletrap.Type.TitleAttribute - Rattletrap.Type.UniqueIdAttribute - Rattletrap.Type.UpdatedReplication + Rattletrap.Type.U32 + Rattletrap.Type.U64 + Rattletrap.Type.U8 Rattletrap.Type.Vector - Rattletrap.Type.WeldedInfoAttribute - Rattletrap.Type.Word32le - Rattletrap.Type.Word64le - Rattletrap.Type.Word8le + Rattletrap.Type.Version Rattletrap.Utility.Bytes Rattletrap.Utility.Crc Rattletrap.Utility.Helper - - if impl(ghc >= 8.10) - ghc-options: - -Wno-missing-safe-haskell-mode - -Wno-prepositive-qualified-module + Rattletrap.Utility.Json + Rattletrap.Utility.Monad + Rattletrap.Version + ghc-options: + -Weverything + -Wno-all-missed-specialisations + -Wno-implicit-prelude + -Wno-missing-deriving-strategies + -Wno-missing-export-lists + -Wno-missing-exported-signatures + -Wno-missing-import-lists + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module + -Wno-safe + -Wno-unsafe + hs-source-dirs: src/lib executable rattletrap - build-depends: - base -any - , rattletrap -any + build-depends: base, rattletrap default-language: Haskell2010 ghc-options: -rtsopts -threaded hs-source-dirs: src/exe main-is: Main.hs - if flag(static) - ld-options: -static - test-suite test build-depends: - base -any - , bytestring -any - , filepath -any + base + , bytestring + , filepath , HUnit >= 1.6.1 && < 1.7 - , rattletrap -any - , temporary >= 1.3 && < 1.4 + , rattletrap default-language: Haskell2010 ghc-options: -rtsopts -threaded hs-source-dirs: src/test diff --git a/src/exe/Main.hs b/src/exe/Main.hs --- a/src/exe/Main.hs +++ b/src/exe/Main.hs @@ -1,6 +1,5 @@ module Main ( main - ) -where + ) where import Rattletrap (main) diff --git a/src/lib/Rattletrap.hs b/src/lib/Rattletrap.hs --- a/src/lib/Rattletrap.hs +++ b/src/lib/Rattletrap.hs @@ -5,158 +5,7 @@ , Rattletrap.Utility.Helper.encodeReplayJson , Rattletrap.Utility.Helper.decodeReplayJson , Rattletrap.Utility.Helper.encodeReplayFile - , Rattletrap.Type.AppliedDamageAttribute.AppliedDamageAttribute(..) - , Rattletrap.Type.Attribute.Attribute(..) - , Rattletrap.Type.AttributeMapping.AttributeMapping(..) - , Rattletrap.Type.AttributeType.AttributeType(..) - , Rattletrap.Type.AttributeValue.AttributeValue(..) - , Rattletrap.Type.BooleanAttribute.BooleanAttribute(..) - , Rattletrap.Type.ByteAttribute.ByteAttribute(..) - , Rattletrap.Type.Cache.Cache(..) - , Rattletrap.Type.CamSettingsAttribute.CamSettingsAttribute(..) - , Rattletrap.Type.ClassAttributeMap.ClassAttributeMap(..) - , Rattletrap.Type.ClassMapping.ClassMapping(..) - , Rattletrap.Type.ClubColorsAttribute.ClubColorsAttribute(..) - , Rattletrap.Type.CompressedWord.CompressedWord(..) - , Rattletrap.Type.CompressedWordVector.CompressedWordVector(..) - , Rattletrap.Type.Content.Content(..) - , Rattletrap.Type.DamageStateAttribute.DamageStateAttribute(..) - , Rattletrap.Type.DemolishAttribute.DemolishAttribute(..) - , Rattletrap.Type.DestroyedReplication.DestroyedReplication(..) - , Rattletrap.Type.Dictionary.Dictionary(..) - , Rattletrap.Type.EnumAttribute.EnumAttribute(..) - , Rattletrap.Type.ExplosionAttribute.ExplosionAttribute(..) - , Rattletrap.Type.ExtendedExplosionAttribute.ExtendedExplosionAttribute(..) - , Rattletrap.Type.FlaggedIntAttribute.FlaggedIntAttribute(..) - , Rattletrap.Type.Float32le.Float32le(..) - , Rattletrap.Type.FloatAttribute.FloatAttribute(..) - , Rattletrap.Type.Frame.Frame(..) - , Rattletrap.Type.GameModeAttribute.GameModeAttribute(..) - , Rattletrap.Type.Header.Header(..) - , Rattletrap.Type.Initialization.Initialization(..) - , Rattletrap.Type.Int32le.Int32le(..) - , Rattletrap.Type.Int64Attribute.Int64Attribute(..) - , Rattletrap.Type.Int64le.Int64le(..) - , Rattletrap.Type.Int8le.Int8le(..) - , Rattletrap.Type.Int8Vector.Int8Vector(..) - , Rattletrap.Type.IntAttribute.IntAttribute(..) - , Rattletrap.Type.KeyFrame.KeyFrame(..) - , Rattletrap.Type.List.List(..) - , Rattletrap.Type.LoadoutAttribute.LoadoutAttribute(..) - , Rattletrap.Type.LoadoutOnlineAttribute.LoadoutOnlineAttribute(..) - , Rattletrap.Type.LoadoutsAttribute.LoadoutsAttribute(..) - , Rattletrap.Type.LoadoutsOnlineAttribute.LoadoutsOnlineAttribute(..) - , Rattletrap.Type.LocationAttribute.LocationAttribute(..) - , Rattletrap.Type.Mark.Mark(..) - , Rattletrap.Type.Message.Message(..) - , Rattletrap.Type.MusicStingerAttribute.MusicStingerAttribute(..) - , Rattletrap.Type.PartyLeaderAttribute.PartyLeaderAttribute(..) - , Rattletrap.Type.PickupAttribute.PickupAttribute(..) - , Rattletrap.Type.PlayerHistoryKeyAttribute.PlayerHistoryKeyAttribute(..) - , Rattletrap.Type.PrivateMatchSettingsAttribute.PrivateMatchSettingsAttribute(..) - , Rattletrap.Type.ProductAttribute.ProductAttribute(..) - , Rattletrap.Type.Property.Property(..) - , Rattletrap.Type.PropertyValue.PropertyValue(..) - , Rattletrap.Type.Quaternion.Quaternion(..) - , Rattletrap.Type.QWordAttribute.QWordAttribute(..) - , Rattletrap.Type.RemoteId.RemoteId(..) - , Rattletrap.Type.Replay.Replay(..) - , Rattletrap.Type.Replication.Replication(..) - , Rattletrap.Type.ReplicationValue.ReplicationValue(..) - , Rattletrap.Type.ReservationAttribute.ReservationAttribute(..) - , Rattletrap.Type.RigidBodyStateAttribute.RigidBodyStateAttribute(..) - , Rattletrap.Type.Rotation.Rotation(..) - , Rattletrap.Type.Section.Section(..) - , Rattletrap.Type.SpawnedReplication.SpawnedReplication(..) - , Rattletrap.Type.StatEventAttribute.StatEventAttribute(..) - , Rattletrap.Type.Str.Str(..) - , Rattletrap.Type.StringAttribute.StringAttribute(..) - , Rattletrap.Type.TeamPaintAttribute.TeamPaintAttribute(..) - , Rattletrap.Type.TitleAttribute.TitleAttribute(..) - , Rattletrap.Type.UniqueIdAttribute.UniqueIdAttribute(..) - , Rattletrap.Type.UpdatedReplication.UpdatedReplication(..) - , Rattletrap.Type.Vector.Vector(..) - , Rattletrap.Type.WeldedInfoAttribute.WeldedInfoAttribute(..) - , Rattletrap.Type.Word32le.Word32le(..) - , Rattletrap.Type.Word64le.Word64le(..) - , Rattletrap.Type.Word8le.Word8le(..) - ) -where + ) where import qualified Rattletrap.Console.Main -import qualified Rattletrap.Type.AppliedDamageAttribute -import qualified Rattletrap.Type.Attribute -import qualified Rattletrap.Type.AttributeMapping -import qualified Rattletrap.Type.AttributeType -import qualified Rattletrap.Type.AttributeValue -import qualified Rattletrap.Type.BooleanAttribute -import qualified Rattletrap.Type.ByteAttribute -import qualified Rattletrap.Type.Cache -import qualified Rattletrap.Type.CamSettingsAttribute -import qualified Rattletrap.Type.ClassAttributeMap -import qualified Rattletrap.Type.ClassMapping -import qualified Rattletrap.Type.ClubColorsAttribute -import qualified Rattletrap.Type.CompressedWord -import qualified Rattletrap.Type.CompressedWordVector -import qualified Rattletrap.Type.Content -import qualified Rattletrap.Type.DamageStateAttribute -import qualified Rattletrap.Type.DemolishAttribute -import qualified Rattletrap.Type.DestroyedReplication -import qualified Rattletrap.Type.Dictionary -import qualified Rattletrap.Type.EnumAttribute -import qualified Rattletrap.Type.ExplosionAttribute -import qualified Rattletrap.Type.ExtendedExplosionAttribute -import qualified Rattletrap.Type.FlaggedIntAttribute -import qualified Rattletrap.Type.Float32le -import qualified Rattletrap.Type.FloatAttribute -import qualified Rattletrap.Type.Frame -import qualified Rattletrap.Type.GameModeAttribute -import qualified Rattletrap.Type.Header -import qualified Rattletrap.Type.Initialization -import qualified Rattletrap.Type.Int32le -import qualified Rattletrap.Type.Int64Attribute -import qualified Rattletrap.Type.Int64le -import qualified Rattletrap.Type.Int8le -import qualified Rattletrap.Type.Int8Vector -import qualified Rattletrap.Type.IntAttribute -import qualified Rattletrap.Type.KeyFrame -import qualified Rattletrap.Type.List -import qualified Rattletrap.Type.LoadoutAttribute -import qualified Rattletrap.Type.LoadoutOnlineAttribute -import qualified Rattletrap.Type.LoadoutsAttribute -import qualified Rattletrap.Type.LoadoutsOnlineAttribute -import qualified Rattletrap.Type.LocationAttribute -import qualified Rattletrap.Type.Mark -import qualified Rattletrap.Type.Message -import qualified Rattletrap.Type.MusicStingerAttribute -import qualified Rattletrap.Type.PartyLeaderAttribute -import qualified Rattletrap.Type.PickupAttribute -import qualified Rattletrap.Type.PlayerHistoryKeyAttribute -import qualified Rattletrap.Type.PrivateMatchSettingsAttribute -import qualified Rattletrap.Type.ProductAttribute -import qualified Rattletrap.Type.Property -import qualified Rattletrap.Type.PropertyValue -import qualified Rattletrap.Type.Quaternion -import qualified Rattletrap.Type.QWordAttribute -import qualified Rattletrap.Type.RemoteId -import qualified Rattletrap.Type.Replay -import qualified Rattletrap.Type.Replication -import qualified Rattletrap.Type.ReplicationValue -import qualified Rattletrap.Type.ReservationAttribute -import qualified Rattletrap.Type.RigidBodyStateAttribute -import qualified Rattletrap.Type.Rotation -import qualified Rattletrap.Type.Section -import qualified Rattletrap.Type.SpawnedReplication -import qualified Rattletrap.Type.StatEventAttribute -import qualified Rattletrap.Type.Str -import qualified Rattletrap.Type.StringAttribute -import qualified Rattletrap.Type.TeamPaintAttribute -import qualified Rattletrap.Type.TitleAttribute -import qualified Rattletrap.Type.UniqueIdAttribute -import qualified Rattletrap.Type.UpdatedReplication -import qualified Rattletrap.Type.Vector -import qualified Rattletrap.Type.WeldedInfoAttribute -import qualified Rattletrap.Type.Word32le -import qualified Rattletrap.Type.Word64le -import qualified Rattletrap.Type.Word8le import qualified Rattletrap.Utility.Helper diff --git a/src/lib/Rattletrap/BitGet.hs b/src/lib/Rattletrap/BitGet.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/BitGet.hs @@ -0,0 +1,48 @@ +module Rattletrap.BitGet where + +import qualified Control.Monad as Monad +import qualified Data.Binary.Bits.Get as BinaryBits +import qualified Data.Binary.Get as Binary +import qualified Data.Bits as Bits +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Word as Word +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.Get as Get +import qualified Rattletrap.Utility.Bytes as Utility + +type BitGet = BinaryBits.BitGet + +toByteGet :: BitGet a -> ByteGet.ByteGet a +toByteGet = binaryGetToByteGet . BinaryBits.runBitGet + +binaryGetToByteGet :: Binary.Get a -> ByteGet.ByteGet a +binaryGetToByteGet g = do + s1 <- Get.get + case Binary.runGetOrFail g $ LazyByteString.fromStrict s1 of + Left (_, _, x) -> fail x + Right (s2, _, x) -> do + Get.put $ LazyByteString.toStrict s2 + pure x + +fromByteGet :: ByteGet.ByteGet a -> Int -> BitGet a +fromByteGet f n = do + x <- BinaryBits.getByteString n + either fail pure . ByteGet.run f $ Utility.reverseBytes x + +bits :: Bits.Bits a => Int -> BitGet a +bits n = + foldr + (\bit x -> let y = Bits.shiftL x 1 in if bit then Bits.setBit y 0 else y + ) + Bits.zeroBits + <$> Monad.replicateM n bool + +bool :: BitGet Bool +bool = BinaryBits.getBool + +byteString :: Int -> BitGet ByteString.ByteString +byteString = BinaryBits.getByteString + +word8 :: Int -> BitGet Word.Word8 +word8 = BinaryBits.getWord8 diff --git a/src/lib/Rattletrap/BitPut.hs b/src/lib/Rattletrap/BitPut.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/BitPut.hs @@ -0,0 +1,41 @@ +module Rattletrap.BitPut where + +import qualified Data.Binary.Bits.Put as BinaryBits +import qualified Data.Binary.Put as Binary +import qualified Data.Bits as Bits +import qualified Data.ByteString as ByteString +import qualified Data.Word as Word +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Utility.Bytes as Utility + +newtype BitPut = BitPut (BinaryBits.BitPut ()) + +instance Semigroup BitPut where + x <> y = fromBinaryBits $ toBinaryBits x >> toBinaryBits y + +instance Monoid BitPut where + mempty = fromBinaryBits $ pure () + +fromBinaryBits :: BinaryBits.BitPut () -> BitPut +fromBinaryBits = BitPut + +toBinaryBits :: BitPut -> BinaryBits.BitPut () +toBinaryBits (BitPut x) = x + +toBytePut :: BitPut -> BytePut.BytePut +toBytePut = Binary.execPut . BinaryBits.runBitPut . toBinaryBits + +fromBytePut :: BytePut.BytePut -> BitPut +fromBytePut = byteString . Utility.reverseBytes . BytePut.toByteString + +bits :: Bits.Bits a => Int -> a -> BitPut +bits n x = foldMap (bool . Bits.testBit x) [0 .. n - 1] + +bool :: Bool -> BitPut +bool = fromBinaryBits . BinaryBits.putBool + +byteString :: ByteString.ByteString -> BitPut +byteString = fromBinaryBits . BinaryBits.putByteString + +word8 :: Int -> Word.Word8 -> BitPut +word8 n = fromBinaryBits . BinaryBits.putWord8 n diff --git a/src/lib/Rattletrap/ByteGet.hs b/src/lib/Rattletrap/ByteGet.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/ByteGet.hs @@ -0,0 +1,65 @@ +module Rattletrap.ByteGet where + +import qualified Data.Bits as Bits +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Functor.Identity as Identity +import qualified Data.Int as Int +import qualified Data.Word as Word +import qualified GHC.Float as Float +import qualified Rattletrap.Get as Get + +type ByteGet = Get.Get ByteString.ByteString Identity.Identity + +run :: ByteGet a -> ByteString.ByteString -> Either String a +run g = fmap snd . Identity.runIdentity . Get.run g + +byteString :: Int -> ByteGet ByteString.ByteString +byteString n = do + s1 <- Get.get + let (x, s2) = ByteString.splitAt n s1 + Get.put s2 + pure x + +float :: ByteGet Float +float = Float.castWord32ToFloat <$> word32 + +int8 :: ByteGet Int.Int8 +int8 = fromIntegral <$> word8 + +int32 :: ByteGet Int.Int32 +int32 = fromIntegral <$> word32 + +int64 :: ByteGet Int.Int64 +int64 = fromIntegral <$> word64 + +remaining :: ByteGet LazyByteString.ByteString +remaining = do + x <- Get.get + Get.put ByteString.empty + pure $ LazyByteString.fromStrict x + +word8 :: ByteGet Word.Word8 +word8 = ByteString.head <$> byteString 1 + +word32 :: ByteGet Word.Word32 +word32 = do + x <- byteString 4 + pure + $ Bits.shiftL (fromIntegral $ ByteString.index x 0) 0 + + Bits.shiftL (fromIntegral $ ByteString.index x 1) 8 + + Bits.shiftL (fromIntegral $ ByteString.index x 2) 16 + + Bits.shiftL (fromIntegral $ ByteString.index x 3) 24 + +word64 :: ByteGet Word.Word64 +word64 = do + x <- byteString 8 + pure + $ Bits.shiftL (fromIntegral $ ByteString.index x 0) 0 + + Bits.shiftL (fromIntegral $ ByteString.index x 1) 8 + + Bits.shiftL (fromIntegral $ ByteString.index x 2) 16 + + Bits.shiftL (fromIntegral $ ByteString.index x 3) 24 + + Bits.shiftL (fromIntegral $ ByteString.index x 4) 32 + + Bits.shiftL (fromIntegral $ ByteString.index x 5) 40 + + Bits.shiftL (fromIntegral $ ByteString.index x 6) 48 + + Bits.shiftL (fromIntegral $ ByteString.index x 7) 56 diff --git a/src/lib/Rattletrap/BytePut.hs b/src/lib/Rattletrap/BytePut.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/BytePut.hs @@ -0,0 +1,39 @@ +module Rattletrap.BytePut where + +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Lazy as LazyByteString +import qualified Data.Int as Int +import qualified Data.Word as Word + +type BytePut = Builder.Builder + +toByteString :: BytePut -> ByteString.ByteString +toByteString = LazyByteString.toStrict . toLazyByteString + +toLazyByteString :: BytePut -> LazyByteString.ByteString +toLazyByteString = Builder.toLazyByteString + +byteString :: ByteString.ByteString -> BytePut +byteString = Builder.byteString + +float :: Float -> BytePut +float = Builder.floatLE + +int8 :: Int.Int8 -> BytePut +int8 = Builder.int8 + +int32 :: Int.Int32 -> BytePut +int32 = Builder.int32LE + +int64 :: Int.Int64 -> BytePut +int64 = Builder.int64LE + +word8 :: Word.Word8 -> BytePut +word8 = Builder.word8 + +word32 :: Word.Word32 -> BytePut +word32 = Builder.word32LE + +word64 :: Word.Word64 -> BytePut +word64 = Builder.word64LE diff --git a/src/lib/Rattletrap/Console/Config.hs b/src/lib/Rattletrap/Console/Config.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Console/Config.hs @@ -0,0 +1,57 @@ +module Rattletrap.Console.Config where + +import qualified Rattletrap.Console.Flag as Flag +import qualified Rattletrap.Console.Mode as Mode +import qualified System.FilePath as FilePath + +data Config = Config + { compact :: Bool + , fast :: Bool + , help :: Bool + , input :: Maybe String + , mode :: Maybe Mode.Mode + , output :: Maybe String + , schema :: Bool + , skipCrc :: Bool + , version :: Bool + } + deriving (Eq, Show) + +initial :: Config +initial = Config + { compact = False + , fast = False + , help = False + , input = Nothing + , mode = Nothing + , output = Nothing + , schema = False + , skipCrc = False + , version = False + } + +applyFlag :: Config -> Flag.Flag -> Either String Config +applyFlag config flag = case flag of + Flag.Compact -> Right config { compact = True } + Flag.Fast -> Right config { fast = True } + Flag.Help -> Right config { help = True } + Flag.Input x -> Right config { input = Just x } + Flag.Mode x -> do + y <- Mode.fromString x + Right config { mode = Just y } + Flag.Output x -> Right config { output = Just x } + Flag.Schema -> Right config { schema = True } + Flag.SkipCrc -> Right config { skipCrc = True } + Flag.Version -> Right config { version = True } + +getMode :: Config -> Mode.Mode +getMode config = + let + i = FilePath.takeExtension <$> input config + o = FilePath.takeExtension <$> output config + in case (i, o) of + (Just ".json", _) -> Mode.Encode + (Just ".replay", _) -> Mode.Decode + (_, Just ".json") -> Mode.Decode + (_, Just ".replay") -> Mode.Encode + _ -> Mode.Decode diff --git a/src/lib/Rattletrap/Console/Flag.hs b/src/lib/Rattletrap/Console/Flag.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Console/Flag.hs @@ -0,0 +1,13 @@ +module Rattletrap.Console.Flag where + +data Flag + = Compact + | Fast + | Help + | Input FilePath + | Mode String + | Output FilePath + | Schema + | SkipCrc + | Version + deriving (Eq, Show) diff --git a/src/lib/Rattletrap/Console/Main.hs b/src/lib/Rattletrap/Console/Main.hs --- a/src/lib/Rattletrap/Console/Main.hs +++ b/src/lib/Rattletrap/Console/Main.hs @@ -1,25 +1,103 @@ module Rattletrap.Console.Main ( main , rattletrap - ) -where + ) where import qualified Control.Monad as Monad -import qualified Data.Aeson as Json -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as LazyBytes -import qualified Data.Version as Version +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as LazyByteString import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Client.TLS as Client -import qualified Paths_rattletrap as This -import qualified Rattletrap.Type.Replay as Rattletrap +import qualified Rattletrap.Console.Config as Config +import qualified Rattletrap.Console.Mode as Mode +import qualified Rattletrap.Console.Option as Option +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute as Attribute +import qualified Rattletrap.Type.Attribute.AppliedDamage as Attribute.AppliedDamage +import qualified Rattletrap.Type.Attribute.Boolean as Attribute.Boolean +import qualified Rattletrap.Type.Attribute.Byte as Attribute.Byte +import qualified Rattletrap.Type.Attribute.CamSettings as Attribute.CamSettings +import qualified Rattletrap.Type.Attribute.ClubColors as Attribute.ClubColors +import qualified Rattletrap.Type.Attribute.CustomDemolish as Attribute.CustomDemolish +import qualified Rattletrap.Type.Attribute.DamageState as Attribute.DamageState +import qualified Rattletrap.Type.Attribute.Demolish as Attribute.Demolish +import qualified Rattletrap.Type.Attribute.Enum as Attribute.Enum +import qualified Rattletrap.Type.Attribute.Explosion as Attribute.Explosion +import qualified Rattletrap.Type.Attribute.ExtendedExplosion as Attribute.ExtendedExplosion +import qualified Rattletrap.Type.Attribute.FlaggedByte as Attribute.FlaggedByte +import qualified Rattletrap.Type.Attribute.FlaggedInt as Attribute.FlaggedInt +import qualified Rattletrap.Type.Attribute.Float as Attribute.Float +import qualified Rattletrap.Type.Attribute.GameMode as Attribute.GameMode +import qualified Rattletrap.Type.Attribute.Int as Attribute.Int +import qualified Rattletrap.Type.Attribute.Int64 as Attribute.Int64 +import qualified Rattletrap.Type.Attribute.Loadout as Attribute.Loadout +import qualified Rattletrap.Type.Attribute.LoadoutOnline as Attribute.LoadoutOnline +import qualified Rattletrap.Type.Attribute.Loadouts as Attribute.Loadouts +import qualified Rattletrap.Type.Attribute.LoadoutsOnline as Attribute.LoadoutsOnline +import qualified Rattletrap.Type.Attribute.Location as Attribute.Location +import qualified Rattletrap.Type.Attribute.MusicStinger as Attribute.MusicStinger +import qualified Rattletrap.Type.Attribute.PartyLeader as Attribute.PartyLeader +import qualified Rattletrap.Type.Attribute.Pickup as Attribute.Pickup +import qualified Rattletrap.Type.Attribute.PickupNew as Attribute.PickupNew +import qualified Rattletrap.Type.Attribute.PlayerHistoryKey as Attribute.PlayerHistoryKey +import qualified Rattletrap.Type.Attribute.PrivateMatchSettings as Attribute.PrivateMatchSettings +import qualified Rattletrap.Type.Attribute.Product as Attribute.Product +import qualified Rattletrap.Type.Attribute.ProductValue as Attribute.ProductValue +import qualified Rattletrap.Type.Attribute.QWord as Attribute.QWord +import qualified Rattletrap.Type.Attribute.Reservation as Attribute.Reservation +import qualified Rattletrap.Type.Attribute.RigidBodyState as Attribute.RigidBodyState +import qualified Rattletrap.Type.Attribute.StatEvent as Attribute.StatEvent +import qualified Rattletrap.Type.Attribute.String as Attribute.String +import qualified Rattletrap.Type.Attribute.TeamPaint as Attribute.TeamPaint +import qualified Rattletrap.Type.Attribute.Title as Attribute.Title +import qualified Rattletrap.Type.Attribute.UniqueId as Attribute.UniqueId +import qualified Rattletrap.Type.Attribute.WeldedInfo as Attribute.WeldedInfo +import qualified Rattletrap.Type.AttributeMapping as AttributeMapping +import qualified Rattletrap.Type.AttributeValue as AttributeValue +import qualified Rattletrap.Type.Cache as Cache +import qualified Rattletrap.Type.ClassMapping as ClassMapping +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.CompressedWordVector as CompressedWordVector +import qualified Rattletrap.Type.Content as Content +import qualified Rattletrap.Type.Dictionary as Dictionary +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.Frame as Frame +import qualified Rattletrap.Type.Header as Header +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.I64 as I64 +import qualified Rattletrap.Type.I8 as I8 +import qualified Rattletrap.Type.Initialization as Initialization +import qualified Rattletrap.Type.Int8Vector as Int8Vector +import qualified Rattletrap.Type.KeyFrame as KeyFrame +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Mark as Mark +import qualified Rattletrap.Type.Message as Message +import qualified Rattletrap.Type.Property as Property +import qualified Rattletrap.Type.PropertyValue as PropertyValue +import qualified Rattletrap.Type.Quaternion as Quaternion +import qualified Rattletrap.Type.RemoteId as RemoteId +import qualified Rattletrap.Type.Replay as Replay +import qualified Rattletrap.Type.Replication as Replication +import qualified Rattletrap.Type.Replication.Destroyed as Replication.Destroyed +import qualified Rattletrap.Type.Replication.Spawned as Replication.Spawned +import qualified Rattletrap.Type.Replication.Updated as Replication.Updated +import qualified Rattletrap.Type.ReplicationValue as ReplicationValue +import qualified Rattletrap.Type.Rotation as Rotation +import qualified Rattletrap.Type.Section as Section +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U64 as U64 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Vector as Vector import qualified Rattletrap.Utility.Helper as Rattletrap +import qualified Rattletrap.Utility.Json as Json +import qualified Rattletrap.Version as Version import qualified System.Console.GetOpt as Console import qualified System.Environment as Environment import qualified System.Exit as Exit -import qualified System.FilePath as Path import qualified System.IO as IO -import qualified Text.Printf as Printf main :: IO () main = do @@ -30,209 +108,180 @@ rattletrap :: String -> [String] -> IO () rattletrap name arguments = do config <- getConfig arguments - Monad.when (configHelp config) (printHelp name *> Exit.exitFailure) - Monad.when (configVersion config) (printVersion *> Exit.exitFailure) + if Config.help config + then helpMain name + else if Config.version config + then versionMain + else if Config.schema config + then schemaMain config + else defaultMain config + +helpMain :: String -> IO () +helpMain name = do + putStr $ Console.usageInfo + (unwords [name, "version", Version.string]) + Option.all + +versionMain :: IO () +versionMain = do + putStrLn Version.string + +schemaMain :: Config.Config -> IO () +schemaMain config = do + let + json = Aeson.encodePretty' + Aeson.defConfig + { Aeson.confCompare = compare + , Aeson.confIndent = Aeson.Tab + , Aeson.confTrailingNewline = True + } + schema + case Config.output config of + Nothing -> LazyByteString.putStr json + Just file -> LazyByteString.writeFile file json + +defaultMain :: Config.Config -> IO () +defaultMain config = do input <- getInput config let decode = getDecoder config replay <- either fail pure (decode input) let encode = getEncoder config putOutput config (encode replay) -getDecoder :: Config -> Bytes.ByteString -> Either String Rattletrap.FullReplay -getDecoder config = case getMode config of - ModeDecode -> Rattletrap.decodeReplayFile $ configFast config - ModeEncode -> Rattletrap.decodeReplayJson +schema :: Aeson.Value +schema = + let contentSchema = Content.schema $ List.schema Frame.schema + in + Aeson.object + [ Json.pair "$schema" "https://json-schema.org/draft-07/schema" + , Json.pair "$id" Replay.schemaUrl + , Json.pair "$ref" "#/definitions/replay" + , Json.pair "definitions" . Aeson.object $ fmap + (\s -> Schema.name s Aeson..= Schema.json s) + [ Attribute.schema + , Attribute.AppliedDamage.schema + , Attribute.Boolean.schema + , Attribute.Byte.schema + , Attribute.CamSettings.schema + , Attribute.ClubColors.schema + , Attribute.CustomDemolish.schema + , Attribute.DamageState.schema + , Attribute.Demolish.schema + , Attribute.Enum.schema + , Attribute.Explosion.schema + , Attribute.ExtendedExplosion.schema + , Attribute.FlaggedByte.schema + , Attribute.FlaggedInt.schema + , Attribute.Float.schema + , Attribute.GameMode.schema + , Attribute.Int.schema + , Attribute.Int64.schema + , Attribute.Loadout.schema + , Attribute.LoadoutOnline.schema + , Attribute.Loadouts.schema + , Attribute.LoadoutsOnline.schema + , Attribute.Location.schema + , Attribute.MusicStinger.schema + , Attribute.PartyLeader.schema + , Attribute.Pickup.schema + , Attribute.PickupNew.schema + , Attribute.PlayerHistoryKey.schema + , Attribute.PrivateMatchSettings.schema + , Attribute.Product.schema + , Attribute.ProductValue.schema + , Attribute.QWord.schema + , Attribute.Reservation.schema + , Attribute.RigidBodyState.schema + , Attribute.StatEvent.schema + , Attribute.String.schema + , Attribute.TeamPaint.schema + , Attribute.Title.schema + , Attribute.UniqueId.schema + , Attribute.WeldedInfo.schema + , AttributeMapping.schema + , AttributeValue.schema + , Cache.schema + , ClassMapping.schema + , CompressedWord.schema + , CompressedWordVector.schema + , contentSchema + , Dictionary.schema Property.schema + , F32.schema + , Frame.schema + , Header.schema + , I32.schema + , I64.schema + , I8.schema + , Initialization.schema + , Int8Vector.schema + , KeyFrame.schema + , List.schema Attribute.Product.schema + , Mark.schema + , Message.schema + , Property.schema + , PropertyValue.schema Property.schema + , Quaternion.schema + , RemoteId.schema + , Replay.schema (Section.schema Header.schema) + . Section.schema + $ contentSchema + , Replication.Destroyed.schema + , Replication.schema + , Replication.Spawned.schema + , Replication.Updated.schema + , ReplicationValue.schema + , Rotation.schema + , Schema.boolean + , Schema.integer + , Schema.null + , Schema.number + , Schema.string + , Section.schema contentSchema + , Section.schema Header.schema + , Str.schema + , U32.schema + , U64.schema + , U8.schema + , Vector.schema + ] + ] -getEncoder :: Config -> Rattletrap.FullReplay -> Bytes.ByteString -getEncoder config = case getMode config of - ModeDecode -> if configCompact config - then LazyBytes.toStrict . Json.encode - else Rattletrap.encodeReplayJson - ModeEncode -> Rattletrap.encodeReplayFile $ configFast config +getDecoder + :: Config.Config -> ByteString.ByteString -> Either String Replay.Replay +getDecoder config = case Config.getMode config of + Mode.Decode -> + Rattletrap.decodeReplayFile (Config.fast config) (Config.skipCrc config) + Mode.Encode -> Rattletrap.decodeReplayJson -getInput :: Config -> IO Bytes.ByteString -getInput config = case configInput config of - Nothing -> Bytes.getContents +getEncoder :: Config.Config -> Replay.Replay -> LazyByteString.ByteString +getEncoder config = case Config.getMode config of + Mode.Decode -> + if Config.compact config then Aeson.encode else Rattletrap.encodeReplayJson + Mode.Encode -> Rattletrap.encodeReplayFile $ Config.fast config + +getInput :: Config.Config -> IO ByteString.ByteString +getInput config = case Config.input config of + Nothing -> ByteString.getContents Just fileOrUrl -> case Client.parseUrlThrow fileOrUrl of - Nothing -> Bytes.readFile fileOrUrl + Nothing -> ByteString.readFile fileOrUrl Just request -> do manager <- Client.newTlsManager response <- Client.httpLbs request manager - pure (LazyBytes.toStrict (Client.responseBody response)) + pure (LazyByteString.toStrict (Client.responseBody response)) -putOutput :: Config -> Bytes.ByteString -> IO () -putOutput = maybe Bytes.putStr Bytes.writeFile . configOutput +putOutput :: Config.Config -> LazyByteString.ByteString -> IO () +putOutput = + maybe LazyByteString.putStr LazyByteString.writeFile . Config.output -getConfig :: [String] -> IO Config +getConfig :: [String] -> IO Config.Config getConfig arguments = do let - (updates, unexpectedArguments, unknownOptions, problems) = - Console.getOpt' Console.Permute options arguments - printUnexpectedArguments unexpectedArguments - printUnknownOptions unknownOptions - printProblems problems + (flags, unexpectedArguments, unknownOptions, problems) = + Console.getOpt' Console.Permute Option.all arguments + Monad.forM_ unexpectedArguments $ \x -> + IO.hPutStrLn IO.stderr $ "WARNING: unexpected argument `" <> x <> "'" + Monad.forM_ unknownOptions + $ \x -> IO.hPutStrLn IO.stderr $ "WARNING: unknown option `" <> x <> "'" + Monad.forM_ problems $ \x -> IO.hPutStr IO.stderr $ "ERROR: " <> x Monad.unless (null problems) Exit.exitFailure - either fail pure (Monad.foldM applyUpdate defaultConfig updates) - -type Option = Console.OptDescr Update - -type Update = Config -> Either String Config - -options :: [Option] -options = - [ compactOption - , fastOption - , helpOption - , inputOption - , modeOption - , outputOption - , versionOption - ] - -compactOption :: Option -compactOption = Console.Option - ['c'] - ["compact"] - (Console.NoArg (\config -> pure config { configCompact = True })) - "minify JSON output" - -fastOption :: Option -fastOption = Console.Option - ['f'] - ["fast"] - (Console.NoArg (\config -> pure config { configFast = True })) - "only encode or decode the header" - -helpOption :: Option -helpOption = Console.Option - ['h'] - ["help"] - (Console.NoArg (\config -> pure config { configHelp = True })) - "show the help" - -inputOption :: Option -inputOption = Console.Option - ['i'] - ["input"] - (Console.ReqArg - (\input config -> pure config { configInput = Just input }) - "FILE|URL" - ) - "input file or URL" - -modeOption :: Option -modeOption = Console.Option - ['m'] - ["mode"] - (Console.ReqArg - (\rawMode config -> do - mode <- parseMode rawMode - pure config { configMode = Just mode } - ) - "MODE" - ) - "decode or encode" - -outputOption :: Option -outputOption = Console.Option - ['o'] - ["output"] - (Console.ReqArg - (\output config -> pure config { configOutput = Just output }) - "FILE" - ) - "output file" - -versionOption :: Option -versionOption = Console.Option - ['v'] - ["version"] - (Console.NoArg (\config -> pure config { configVersion = True })) - "show the version" - -applyUpdate :: Config -> Update -> Either String Config -applyUpdate config update = update config - -data Config = Config - { configCompact :: Bool - , configFast :: Bool - , configHelp :: Bool - , configInput :: Maybe String - , configMode :: Maybe Mode - , configOutput :: Maybe String - , configVersion :: Bool - } deriving (Show) - -defaultConfig :: Config -defaultConfig = Config - { configCompact = False - , configFast = False - , configHelp = False - , configInput = Nothing - , configMode = Nothing - , configOutput = Nothing - , configVersion = False - } - -getMode :: Config -> Mode -getMode config = case getExtension (configInput config) of - ".json" -> ModeEncode - ".replay" -> ModeDecode - _ -> case getExtension (configOutput config) of - ".json" -> ModeDecode - ".replay" -> ModeEncode - _ -> ModeDecode - -getExtension :: Maybe String -> String -getExtension = maybe "" Path.takeExtension - -data Mode - = ModeDecode - | ModeEncode - deriving (Show) - -parseMode :: String -> Either String Mode -parseMode mode = case mode of - "decode" -> Right ModeDecode - "encode" -> Right ModeEncode - _ -> Left (Printf.printf "invalid mode: %s" (show mode)) - -printUnexpectedArguments :: [String] -> IO () -printUnexpectedArguments = mapM_ printUnexpectedArgument - -printUnexpectedArgument :: String -> IO () -printUnexpectedArgument = - warnLn . Printf.printf "WARNING: unexpected argument `%s'" - -printUnknownOptions :: [String] -> IO () -printUnknownOptions = mapM_ printUnknownOption - -printUnknownOption :: String -> IO () -printUnknownOption = warnLn . Printf.printf "WARNING: unknown option `%s'" - -printProblems :: [String] -> IO () -printProblems = mapM_ printProblem - -printProblem :: String -> IO () -printProblem = warn . Printf.printf "ERROR: %s" - -printHelp :: String -> IO () -printHelp = warn . help - -help :: String -> String -help name = Console.usageInfo (header name) options - -header :: String -> String -header name = unwords [name, "version", version] - -version :: String -version = Version.showVersion This.version - -printVersion :: IO () -printVersion = warnLn version - -warn :: String -> IO () -warn = IO.hPutStr IO.stderr - -warnLn :: String -> IO () -warnLn = IO.hPutStrLn IO.stderr + either fail pure $ Monad.foldM Config.applyFlag Config.initial flags diff --git a/src/lib/Rattletrap/Console/Mode.hs b/src/lib/Rattletrap/Console/Mode.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Console/Mode.hs @@ -0,0 +1,12 @@ +module Rattletrap.Console.Mode where + +data Mode + = Decode + | Encode + deriving (Eq, Show) + +fromString :: String -> Either String Mode +fromString string = case string of + "decode" -> Right Decode + "encode" -> Right Encode + _ -> Left $ "invalid mode: " <> show string diff --git a/src/lib/Rattletrap/Console/Option.hs b/src/lib/Rattletrap/Console/Option.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Console/Option.hs @@ -0,0 +1,62 @@ +module Rattletrap.Console.Option where + +import qualified Rattletrap.Console.Flag as Flag +import qualified System.Console.GetOpt as Console + +type Option = Console.OptDescr Flag.Flag + +all :: [Option] +all = [compact, fast, help, input, mode, output, schema, skipCrc, version] + +compact :: Option +compact = Console.Option + ['c'] + ["compact"] + (Console.NoArg Flag.Compact) + "minify JSON output" + +fast :: Option +fast = Console.Option + ['f'] + ["fast"] + (Console.NoArg Flag.Fast) + "only encode or decode the header" + +help :: Option +help = Console.Option ['h'] ["help"] (Console.NoArg Flag.Help) "show the help" + +input :: Option +input = Console.Option + ['i'] + ["input"] + (Console.ReqArg Flag.Input "FILE|URL") + "input file or URL" + +mode :: Option +mode = Console.Option + ['m'] + ["mode"] + (Console.ReqArg Flag.Mode "MODE") + "decode or encode" + +output :: Option +output = Console.Option + ['o'] + ["output"] + (Console.ReqArg Flag.Output "FILE") + "output file" + +schema :: Option +schema = + Console.Option [] ["schema"] (Console.NoArg Flag.Schema) "output the schema" + +skipCrc :: Option +skipCrc = + Console.Option [] ["skip-crc"] (Console.NoArg Flag.SkipCrc) "skip the CRC" + +version :: Option +version = Console.Option + ['v'] + ["version"] + (Console.NoArg Flag.Version) + "show the version" diff --git a/src/lib/Rattletrap/Data.hs b/src/lib/Rattletrap/Data.hs --- a/src/lib/Rattletrap/Data.hs +++ b/src/lib/Rattletrap/Data.hs @@ -1,18 +1,16 @@ -- brittany --columns 120 -module Rattletrap.Data - ( rawParentClasses - , rawClassesWithLocation - , rawClassesWithRotation - , rawObjectClasses - , rawAttributeTypes - , rawCrc32Table - ) -where +module Rattletrap.Data where -import Rattletrap.Type.AttributeType +import qualified Rattletrap.Type.AttributeType as AttributeType -rawParentClasses :: [(String, String)] -rawParentClasses = +import qualified Data.Bifunctor as Bifunctor +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified Data.Text as Text + +parentClasses :: Map.Map Text.Text Text.Text +parentClasses = Map.fromList $ fmap + (Bifunctor.bimap Text.pack Text.pack) [ ("Engine.Actor", "Core.Object") , ("Engine.GameReplicationInfo", "Engine.ReplicationInfo") , ("Engine.Info", "Engine.Actor") @@ -54,10 +52,10 @@ , ("TAGame.SpecialPickup_BallFreeze_TA", "TAGame.SpecialPickup_Targeted_TA") , ("TAGame.SpecialPickup_BallGravity_TA", "TAGame.SpecialPickup_TA") , ("TAGame.SpecialPickup_BallLasso_TA", "TAGame.SpecialPickup_GrapplingHook_TA") - , ("TAGame.SpecialPickup_Football_TA", "TAGame.SpecialPickup_TA") , ("TAGame.SpecialPickup_BallVelcro_TA", "TAGame.SpecialPickup_TA") , ("TAGame.SpecialPickup_Batarang_TA", "TAGame.SpecialPickup_BallLasso_TA") , ("TAGame.SpecialPickup_BoostOverride_TA", "TAGame.SpecialPickup_Targeted_TA") + , ("TAGame.SpecialPickup_Football_TA", "TAGame.SpecialPickup_TA") , ("TAGame.SpecialPickup_GrapplingHook_TA", "TAGame.SpecialPickup_Targeted_TA") , ("TAGame.SpecialPickup_HauntedBallBeam_TA", "TAGame.SpecialPickup_TA") , ("TAGame.SpecialPickup_HitForce_TA", "TAGame.SpecialPickup_TA") @@ -74,8 +72,9 @@ , ("TAGame.VehiclePickup_TA", "Engine.ReplicationInfo") ] -rawClassesWithLocation :: [String] -rawClassesWithLocation = +classesWithLocation :: Set.Set Text.Text +classesWithLocation = Set.fromList $ fmap + Text.pack [ "Archetypes.Ball.Ball_BasketBall_Mutator" , "Archetypes.Ball.Ball_Basketball" , "Archetypes.Ball.Ball_BasketBall" @@ -109,8 +108,8 @@ , "TAGame.GameEvent_SoccarSplitscreen_TA" , "TAGame.GRI_TA" , "TAGame.MaxTimeWarningData_TA" - , "TAGame.RumblePickups_TA" , "TAGame.PRI_TA" + , "TAGame.RumblePickups_TA" , "TAGame.SpecialPickup_BallCarSpring_TA" , "TAGame.SpecialPickup_BallFreeze_TA" , "TAGame.SpecialPickup_BallGravity_TA" @@ -133,8 +132,9 @@ , "TheWorld:PersistentLevel.VehiclePickup_Boost_TA" ] -rawClassesWithRotation :: [String] -rawClassesWithRotation = +classesWithRotation :: Set.Set Text.Text +classesWithRotation = Set.fromList $ fmap + Text.pack [ "Archetypes.Ball.Ball_BasketBall_Mutator" , "Archetypes.Ball.Ball_Basketball" , "Archetypes.Ball.Ball_BasketBall" @@ -153,8 +153,9 @@ , "TAGame.Car_TA" ] -rawObjectClasses :: [(String, String)] -rawObjectClasses = +objectClasses :: Map.Map Text.Text Text.Text +objectClasses = Map.fromList $ fmap + (Bifunctor.bimap Text.pack Text.pack) [ ("Archetypes.Ball.Ball_Anniversary", "TAGame.Ball_TA") , ("Archetypes.Ball.Ball_BasketBall_Mutator", "TAGame.Ball_TA") , ("Archetypes.Ball.Ball_Basketball", "TAGame.Ball_TA") @@ -219,8 +220,8 @@ , ("ProjectX.Default__NetModeReplicator_X", "ProjectX.NetModeReplicator") , ("TAGame.Default__CameraSettingsActor_TA", "TAGame.CameraSettingsActor_TA") , ("TAGame.Default__MaxTimeWarningData_TA", "TAGame.MaxTimeWarningData_TA") - , ("TAGame.Default__RumblePickups_TA", "TAGame.RumblePickups_TA") , ("TAGame.Default__PRI_TA", "TAGame.PRI_TA") + , ("TAGame.Default__RumblePickups_TA", "TAGame.RumblePickups_TA") , ("TheWorld:PersistentLevel.BreakOutActor_Platform_TA", "TAGame.BreakOutActor_Platform_TA") , ("TheWorld:PersistentLevel.CrowdActor_TA", "TAGame.CrowdActor_TA") , ("TheWorld:PersistentLevel.CrowdManager_TA", "TAGame.CrowdManager_TA") @@ -228,449 +229,190 @@ , ("TheWorld:PersistentLevel.VehiclePickup_Boost_TA", "TAGame.VehiclePickup_Boost_TA") ] -rawAttributeTypes :: [(String, AttributeType)] -rawAttributeTypes = - [ ("Engine.Actor:bBlockActors", AttributeTypeBoolean) - , ("Engine.Actor:bCollideActors", AttributeTypeBoolean) - , ("Engine.Actor:bHidden", AttributeTypeBoolean) - , ("Engine.Actor:DrawScale", AttributeTypeFloat) - , ("Engine.Actor:RemoteRole", AttributeTypeEnum) - , ("Engine.Actor:Role", AttributeTypeEnum) - , ("Engine.GameReplicationInfo:bMatchIsOver", AttributeTypeBoolean) - , ("Engine.GameReplicationInfo:GameClass", AttributeTypeFlaggedInt) - , ("TAGame.Car_TA:RumblePickups", AttributeTypeFlaggedInt) - , ("Engine.GameReplicationInfo:ServerName", AttributeTypeString) - , ("Engine.Pawn:PlayerReplicationInfo", AttributeTypeFlaggedInt) - , ("Engine.PlayerReplicationInfo:bBot", AttributeTypeBoolean) - , ("Engine.PlayerReplicationInfo:bIsSpectator", AttributeTypeBoolean) - , ("Engine.PlayerReplicationInfo:bReadyToPlay", AttributeTypeBoolean) - , ("Engine.PlayerReplicationInfo:bTimedOut", AttributeTypeBoolean) - , ("Engine.PlayerReplicationInfo:bWaitingPlayer", AttributeTypeBoolean) - , ("Engine.PlayerReplicationInfo:Ping", AttributeTypeByte) - , ("Engine.PlayerReplicationInfo:PlayerID", AttributeTypeInt) - , ("Engine.PlayerReplicationInfo:PlayerName", AttributeTypeString) - , ("Engine.PlayerReplicationInfo:RemoteUserData", AttributeTypeString) - , ("Engine.PlayerReplicationInfo:Score", AttributeTypeInt) - , ("Engine.PlayerReplicationInfo:Team", AttributeTypeFlaggedInt) - , ("Engine.PlayerReplicationInfo:UniqueId", AttributeTypeUniqueId) - , ("Engine.ReplicatedActor_ORS:ReplicatedOwner", AttributeTypeFlaggedInt) - , ("Engine.TeamInfo:Score", AttributeTypeInt) - , ("ProjectX.GRI_X:bGameStarted", AttributeTypeBoolean) - , ("ProjectX.GRI_X:GameServerID", AttributeTypeQWord) - , ("ProjectX.GRI_X:MatchGUID", AttributeTypeString) - , ("ProjectX.GRI_X:ReplicatedGameMutatorIndex", AttributeTypeInt) - , ("ProjectX.GRI_X:ReplicatedGamePlaylist", AttributeTypeInt) - , ("ProjectX.GRI_X:Reservations", AttributeTypeReservation) - , ("TAGame.Ball_Breakout_TA:AppliedDamage", AttributeTypeAppliedDamage) - , ("TAGame.Ball_Breakout_TA:DamageIndex", AttributeTypeInt) - , ("TAGame.Ball_Breakout_TA:LastTeamTouch", AttributeTypeByte) - , ("TAGame.Ball_God_TA:TargetSpeed", AttributeTypeFloat) - , ("TAGame.Ball_Haunted_TA:bIsBallBeamed", AttributeTypeBoolean) - , ("TAGame.Ball_Haunted_TA:DeactivatedGoalIndex", AttributeTypeByte) - , ("TAGame.Ball_Haunted_TA:LastTeamTouch", AttributeTypeByte) - , ("TAGame.Ball_Haunted_TA:ReplicatedBeamBrokenValue", AttributeTypeByte) - , ("TAGame.Ball_Haunted_TA:TotalActiveBeams", AttributeTypeByte) - , ("TAGame.Ball_TA:GameEvent", AttributeTypeFlaggedInt) - , ("TAGame.Ball_TA:HitTeamNum", AttributeTypeByte) - , ("TAGame.Ball_TA:ReplicatedAddedCarBounceScale", AttributeTypeFloat) - , ("TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale", AttributeTypeFloat) - , ("TAGame.Ball_TA:ReplicatedBallScale", AttributeTypeFloat) - , ("TAGame.Ball_TA:ReplicatedExplosionData", AttributeTypeExplosion) - , ("TAGame.Ball_TA:ReplicatedExplosionDataExtended", AttributeTypeExtendedExplosion) - , ("TAGame.Ball_TA:ReplicatedPhysMatOverride", AttributeTypeFlaggedInt) - , ("TAGame.Ball_TA:ReplicatedWorldBounceScale", AttributeTypeFloat) - , ("TAGame.BreakOutActor_Platform_TA:DamageState", AttributeTypeDamageState) - , ("TAGame.CameraSettingsActor_TA:bMouseCameraToggleEnabled", AttributeTypeBoolean) - , ("TAGame.CameraSettingsActor_TA:bUsingBehindView", AttributeTypeBoolean) - , ("TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera", AttributeTypeBoolean) - , ("TAGame.CameraSettingsActor_TA:bUsingSwivel", AttributeTypeBoolean) - , ("TAGame.CameraSettingsActor_TA:CameraPitch", AttributeTypeByte) - , ("TAGame.CameraSettingsActor_TA:CameraYaw", AttributeTypeByte) - , ("TAGame.CameraSettingsActor_TA:PRI", AttributeTypeFlaggedInt) - , ("TAGame.CameraSettingsActor_TA:ProfileSettings", AttributeTypeCamSettings) - , ("TAGame.Car_TA:AddedBallForceMultiplier", AttributeTypeFloat) - , ("TAGame.Car_TA:AddedCarForceMultiplier", AttributeTypeFloat) - , ("TAGame.Car_TA:AttachedPickup", AttributeTypeFlaggedInt) - , ("TAGame.Car_TA:ClubColors", AttributeTypeClubColors) - , ("TAGame.Car_TA:ReplicatedDemolish_CustomFX", AttributeTypeCustomDemolish) - , ("TAGame.Car_TA:ReplicatedDemolish", AttributeTypeDemolish) - , ("TAGame.Car_TA:TeamPaint", AttributeTypeTeamPaint) - , ("TAGame.CarComponent_Boost_TA:bNoBoost", AttributeTypeBoolean) - , ("TAGame.CarComponent_Boost_TA:BoostModifier", AttributeTypeFloat) - , ("TAGame.CarComponent_Boost_TA:bUnlimitedBoost", AttributeTypeBoolean) - , ("TAGame.CarComponent_Boost_TA:RechargeDelay", AttributeTypeFloat) - , ("TAGame.CarComponent_Boost_TA:RechargeRate", AttributeTypeFloat) - , ("TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount", AttributeTypeByte) - , ("TAGame.CarComponent_Boost_TA:UnlimitedBoostRefCount", AttributeTypeInt) - , ("TAGame.CarComponent_Dodge_TA:DodgeTorque", AttributeTypeLocation) - , ("TAGame.CarComponent_FlipCar_TA:bFlipRight", AttributeTypeBoolean) - , ("TAGame.CarComponent_FlipCar_TA:FlipCarTime", AttributeTypeFloat) - , ("TAGame.CarComponent_TA:ReplicatedActive", AttributeTypeByte) - , ("TAGame.CarComponent_TA:ReplicatedActivityTime", AttributeTypeFloat) - , ("TAGame.CarComponent_TA:Vehicle", AttributeTypeFlaggedInt) - , ("TAGame.CrowdActor_TA:GameEvent", AttributeTypeFlaggedInt) - , ("TAGame.CrowdActor_TA:ModifiedNoise", AttributeTypeFloat) - , ("TAGame.CrowdActor_TA:ReplicatedCountDownNumber", AttributeTypeInt) - , ("TAGame.CrowdActor_TA:ReplicatedOneShotSound", AttributeTypeFlaggedInt) - , ("TAGame.CrowdActor_TA:ReplicatedRoundCountDownNumber", AttributeTypeInt) - , ("TAGame.CrowdManager_TA:GameEvent", AttributeTypeFlaggedInt) - , ("TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound", AttributeTypeFlaggedInt) - , ("TAGame.GameEvent_Soccar_TA:bBallHasBeenHit", AttributeTypeBoolean) - , ("TAGame.GameEvent_Soccar_TA:bClubMatch", AttributeTypeBoolean) - , ("TAGame.GameEvent_Soccar_TA:bOverTime", AttributeTypeBoolean) - , ("TAGame.GameEvent_Soccar_TA:bUnlimitedTime", AttributeTypeBoolean) - , ("TAGame.GameEvent_Soccar_TA:GameTime", AttributeTypeInt) - , ("TAGame.GameEvent_Soccar_TA:MaxScore", AttributeTypeInt) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger", AttributeTypeMusicStinger) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam", AttributeTypeByte) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedServerPerformanceState", AttributeTypeByte) - , ("TAGame.GameEvent_Soccar_TA:ReplicatedStatEvent", AttributeTypeStatEvent) - , ("TAGame.GameEvent_Soccar_TA:RoundNum", AttributeTypeInt) - , ("TAGame.GameEvent_Soccar_TA:SecondsRemaining", AttributeTypeInt) - , ("TAGame.GameEvent_Soccar_TA:SeriesLength", AttributeTypeInt) - , ("TAGame.GameEvent_Soccar_TA:SubRulesArchetype", AttributeTypeFlaggedInt) - , ("TAGame.GameEvent_SoccarPrivate_TA:MatchSettings", AttributeTypePrivateMatchSettings) - , ("TAGame.GameEvent_TA:bCanVoteToForfeit", AttributeTypeBoolean) - , ("TAGame.GameEvent_TA:bHasLeaveMatchPenalty", AttributeTypeBoolean) - , ("TAGame.GameEvent_TA:BotSkill", AttributeTypeInt) - , ("TAGame.GameEvent_TA:GameMode", AttributeTypeGameMode) - , ("TAGame.GameEvent_TA:MatchTypeClass", AttributeTypeFlaggedInt) - , ("TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining", AttributeTypeInt) - , ("TAGame.GameEvent_TA:ReplicatedRoundCountDownNumber", AttributeTypeInt) - , ("TAGame.GameEvent_TA:ReplicatedStateIndex", AttributeTypeByte) - , ("TAGame.GameEvent_TA:ReplicatedStateName", AttributeTypeInt) - , ("TAGame.GameEvent_Team_TA:bForfeit", AttributeTypeBoolean) - , ("TAGame.GameEvent_Team_TA:MaxTeamSize", AttributeTypeInt) - , ("TAGame.GRI_TA:NewDedicatedServerIP", AttributeTypeString) - , ("TAGame.MaxTimeWarningData_TA:EndGameEpochTime", AttributeTypeInt64) - , ("TAGame.MaxTimeWarningData_TA:EndGameWarningEpochTime", AttributeTypeInt64) - , ("TAGame.PRI_TA:bIsDistracted", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bIsInSplitScreen", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bMatchMVP", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bOnlineLoadoutSet", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bOnlineLoadoutsSet", AttributeTypeBoolean) - , ("TAGame.PRI_TA:BotProductName", AttributeTypeInt) - , ("TAGame.PRI_TA:bReady", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bUsingBehindView", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bUsingItems", AttributeTypeBoolean) - , ("TAGame.PRI_TA:bUsingSecondaryCamera", AttributeTypeBoolean) - , ("TAGame.PRI_TA:CameraPitch", AttributeTypeByte) - , ("TAGame.PRI_TA:CameraSettings", AttributeTypeCamSettings) - , ("TAGame.PRI_TA:CameraYaw", AttributeTypeByte) - , ("TAGame.PRI_TA:ClientLoadout", AttributeTypeLoadout) - , ("TAGame.PRI_TA:ClientLoadoutOnline", AttributeTypeLoadoutOnline) - , ("TAGame.PRI_TA:ClientLoadouts", AttributeTypeLoadouts) - , ("TAGame.PRI_TA:ClientLoadoutsOnline", AttributeTypeLoadoutsOnline) - , ("TAGame.PRI_TA:ClubID", AttributeTypeInt64) - , ("TAGame.PRI_TA:MatchAssists", AttributeTypeInt) - , ("TAGame.PRI_TA:MatchBreakoutDamage", AttributeTypeInt) - , ("TAGame.PRI_TA:MatchGoals", AttributeTypeInt) - , ("TAGame.PRI_TA:MatchSaves", AttributeTypeInt) - , ("TAGame.PRI_TA:MatchScore", AttributeTypeInt) - , ("TAGame.PRI_TA:MatchShots", AttributeTypeInt) - , ("TAGame.PRI_TA:MaxTimeTillItem", AttributeTypeInt) - , ("TAGame.PRI_TA:PartyLeader", AttributeTypePartyLeader) - , ("TAGame.PRI_TA:PawnType", AttributeTypeByte) - , ("TAGame.PRI_TA:PersistentCamera", AttributeTypeFlaggedInt) - , ("TAGame.PRI_TA:PlayerHistoryKey", AttributeTypePlayerHistoryKey) - , ("TAGame.PRI_TA:PlayerHistoryValid", AttributeTypeBoolean) - , ("TAGame.PRI_TA:PrimaryTitle", AttributeTypeTitle) - , ("TAGame.PRI_TA:ReplicatedGameEvent", AttributeTypeFlaggedInt) - , ("TAGame.PRI_TA:ReplicatedWorstNetQualityBeyondLatency", AttributeTypeByte) - , ("TAGame.PRI_TA:SecondaryTitle", AttributeTypeTitle) - , ("TAGame.PRI_TA:SkillTier", AttributeTypeFlaggedByte) - , ("TAGame.PRI_TA:SpectatorShortcut", AttributeTypeInt) - , ("TAGame.PRI_TA:SteeringSensitivity", AttributeTypeFloat) - , ("TAGame.PRI_TA:TimeTillItem", AttributeTypeInt) - , ("TAGame.PRI_TA:Title", AttributeTypeInt) - , ("TAGame.PRI_TA:TotalXP", AttributeTypeInt) - , ("TAGame.RBActor_TA:bFrozen", AttributeTypeBoolean) - , ("TAGame.RBActor_TA:bIgnoreSyncing", AttributeTypeBoolean) - , ("TAGame.RBActor_TA:bReplayActor", AttributeTypeBoolean) - , ("TAGame.RBActor_TA:ReplicatedRBState", AttributeTypeRigidBodyState) - , ("TAGame.RBActor_TA:WeldedInfo", AttributeTypeWeldedInfo) - , ("TAGame.RumblePickups_TA:AttachedPickup", AttributeTypeFlaggedInt) - , ("TAGame.RumblePickups_TA:ConcurrentItemCount", AttributeTypeInt) - , ("TAGame.SpecialPickup_BallFreeze_TA:RepOrigSpeed", AttributeTypeFloat) - , ("TAGame.SpecialPickup_BallVelcro_TA:AttachTime", AttributeTypeFloat) - , ("TAGame.SpecialPickup_BallVelcro_TA:bBroken", AttributeTypeBoolean) - , ("TAGame.SpecialPickup_BallVelcro_TA:bHit", AttributeTypeBoolean) - , ("TAGame.SpecialPickup_BallVelcro_TA:BreakTime", AttributeTypeFloat) - , ("TAGame.SpecialPickup_Football_TA:WeldedBall", AttributeTypeFlaggedInt) - , ("TAGame.SpecialPickup_Rugby_TA:bBallWelded", AttributeTypeBoolean) - , ("TAGame.SpecialPickup_Targeted_TA:Targeted", AttributeTypeFlaggedInt) - , ("TAGame.Team_Soccar_TA:GameScore", AttributeTypeInt) - , ("TAGame.Team_TA:ClubColors", AttributeTypeClubColors) - , ("TAGame.Team_TA:ClubID", AttributeTypeInt64) - , ("TAGame.Team_TA:CustomTeamName", AttributeTypeString) - , ("TAGame.Team_TA:Difficulty", AttributeTypeInt) - , ("TAGame.Team_TA:GameEvent", AttributeTypeFlaggedInt) - , ("TAGame.Team_TA:LogoData", AttributeTypeFlaggedInt) - , ("TAGame.Vehicle_TA:bDriving", AttributeTypeBoolean) - , ("TAGame.Vehicle_TA:bReplicatedHandbrake", AttributeTypeBoolean) - , ("TAGame.Vehicle_TA:ReplicatedSteer", AttributeTypeByte) - , ("TAGame.Vehicle_TA:ReplicatedThrottle", AttributeTypeByte) - , ("TAGame.VehiclePickup_TA:bNoPickup", AttributeTypeBoolean) - , ("TAGame.VehiclePickup_TA:NewReplicatedPickupData", AttributeTypePickupNew) - , ("TAGame.VehiclePickup_TA:ReplicatedPickupData", AttributeTypePickup) - ] - -rawCrc32Table :: Integral a => [a] -rawCrc32Table = - [ 0x00000000 - , 0x04c11db7 - , 0x09823b6e - , 0x0d4326d9 - , 0x130476dc - , 0x17c56b6b - , 0x1a864db2 - , 0x1e475005 - , 0x2608edb8 - , 0x22c9f00f - , 0x2f8ad6d6 - , 0x2b4bcb61 - , 0x350c9b64 - , 0x31cd86d3 - , 0x3c8ea00a - , 0x384fbdbd - , 0x4c11db70 - , 0x48d0c6c7 - , 0x4593e01e - , 0x4152fda9 - , 0x5f15adac - , 0x5bd4b01b - , 0x569796c2 - , 0x52568b75 - , 0x6a1936c8 - , 0x6ed82b7f - , 0x639b0da6 - , 0x675a1011 - , 0x791d4014 - , 0x7ddc5da3 - , 0x709f7b7a - , 0x745e66cd - , 0x9823b6e0 - , 0x9ce2ab57 - , 0x91a18d8e - , 0x95609039 - , 0x8b27c03c - , 0x8fe6dd8b - , 0x82a5fb52 - , 0x8664e6e5 - , 0xbe2b5b58 - , 0xbaea46ef - , 0xb7a96036 - , 0xb3687d81 - , 0xad2f2d84 - , 0xa9ee3033 - , 0xa4ad16ea - , 0xa06c0b5d - , 0xd4326d90 - , 0xd0f37027 - , 0xddb056fe - , 0xd9714b49 - , 0xc7361b4c - , 0xc3f706fb - , 0xceb42022 - , 0xca753d95 - , 0xf23a8028 - , 0xf6fb9d9f - , 0xfbb8bb46 - , 0xff79a6f1 - , 0xe13ef6f4 - , 0xe5ffeb43 - , 0xe8bccd9a - , 0xec7dd02d - , 0x34867077 - , 0x30476dc0 - , 0x3d044b19 - , 0x39c556ae - , 0x278206ab - , 0x23431b1c - , 0x2e003dc5 - , 0x2ac12072 - , 0x128e9dcf - , 0x164f8078 - , 0x1b0ca6a1 - , 0x1fcdbb16 - , 0x018aeb13 - , 0x054bf6a4 - , 0x0808d07d - , 0x0cc9cdca - , 0x7897ab07 - , 0x7c56b6b0 - , 0x71159069 - , 0x75d48dde - , 0x6b93dddb - , 0x6f52c06c - , 0x6211e6b5 - , 0x66d0fb02 - , 0x5e9f46bf - , 0x5a5e5b08 - , 0x571d7dd1 - , 0x53dc6066 - , 0x4d9b3063 - , 0x495a2dd4 - , 0x44190b0d - , 0x40d816ba - , 0xaca5c697 - , 0xa864db20 - , 0xa527fdf9 - , 0xa1e6e04e - , 0xbfa1b04b - , 0xbb60adfc - , 0xb6238b25 - , 0xb2e29692 - , 0x8aad2b2f - , 0x8e6c3698 - , 0x832f1041 - , 0x87ee0df6 - , 0x99a95df3 - , 0x9d684044 - , 0x902b669d - , 0x94ea7b2a - , 0xe0b41de7 - , 0xe4750050 - , 0xe9362689 - , 0xedf73b3e - , 0xf3b06b3b - , 0xf771768c - , 0xfa325055 - , 0xfef34de2 - , 0xc6bcf05f - , 0xc27dede8 - , 0xcf3ecb31 - , 0xcbffd686 - , 0xd5b88683 - , 0xd1799b34 - , 0xdc3abded - , 0xd8fba05a - , 0x690ce0ee - , 0x6dcdfd59 - , 0x608edb80 - , 0x644fc637 - , 0x7a089632 - , 0x7ec98b85 - , 0x738aad5c - , 0x774bb0eb - , 0x4f040d56 - , 0x4bc510e1 - , 0x46863638 - , 0x42472b8f - , 0x5c007b8a - , 0x58c1663d - , 0x558240e4 - , 0x51435d53 - , 0x251d3b9e - , 0x21dc2629 - , 0x2c9f00f0 - , 0x285e1d47 - , 0x36194d42 - , 0x32d850f5 - , 0x3f9b762c - , 0x3b5a6b9b - , 0x0315d626 - , 0x07d4cb91 - , 0x0a97ed48 - , 0x0e56f0ff - , 0x1011a0fa - , 0x14d0bd4d - , 0x19939b94 - , 0x1d528623 - , 0xf12f560e - , 0xf5ee4bb9 - , 0xf8ad6d60 - , 0xfc6c70d7 - , 0xe22b20d2 - , 0xe6ea3d65 - , 0xeba91bbc - , 0xef68060b - , 0xd727bbb6 - , 0xd3e6a601 - , 0xdea580d8 - , 0xda649d6f - , 0xc423cd6a - , 0xc0e2d0dd - , 0xcda1f604 - , 0xc960ebb3 - , 0xbd3e8d7e - , 0xb9ff90c9 - , 0xb4bcb610 - , 0xb07daba7 - , 0xae3afba2 - , 0xaafbe615 - , 0xa7b8c0cc - , 0xa379dd7b - , 0x9b3660c6 - , 0x9ff77d71 - , 0x92b45ba8 - , 0x9675461f - , 0x8832161a - , 0x8cf30bad - , 0x81b02d74 - , 0x857130c3 - , 0x5d8a9099 - , 0x594b8d2e - , 0x5408abf7 - , 0x50c9b640 - , 0x4e8ee645 - , 0x4a4ffbf2 - , 0x470cdd2b - , 0x43cdc09c - , 0x7b827d21 - , 0x7f436096 - , 0x7200464f - , 0x76c15bf8 - , 0x68860bfd - , 0x6c47164a - , 0x61043093 - , 0x65c52d24 - , 0x119b4be9 - , 0x155a565e - , 0x18197087 - , 0x1cd86d30 - , 0x029f3d35 - , 0x065e2082 - , 0x0b1d065b - , 0x0fdc1bec - , 0x3793a651 - , 0x3352bbe6 - , 0x3e119d3f - , 0x3ad08088 - , 0x2497d08d - , 0x2056cd3a - , 0x2d15ebe3 - , 0x29d4f654 - , 0xc5a92679 - , 0xc1683bce - , 0xcc2b1d17 - , 0xc8ea00a0 - , 0xd6ad50a5 - , 0xd26c4d12 - , 0xdf2f6bcb - , 0xdbee767c - , 0xe3a1cbc1 - , 0xe760d676 - , 0xea23f0af - , 0xeee2ed18 - , 0xf0a5bd1d - , 0xf464a0aa - , 0xf9278673 - , 0xfde69bc4 - , 0x89b8fd09 - , 0x8d79e0be - , 0x803ac667 - , 0x84fbdbd0 - , 0x9abc8bd5 - , 0x9e7d9662 - , 0x933eb0bb - , 0x97ffad0c - , 0xafb010b1 - , 0xab710d06 - , 0xa6322bdf - , 0xa2f33668 - , 0xbcb4666d - , 0xb8757bda - , 0xb5365d03 - , 0xb1f740b4 +attributeTypes :: Map.Map Text.Text AttributeType.AttributeType +attributeTypes = Map.fromList $ fmap + (Bifunctor.first Text.pack) + [ ("Engine.Actor:bBlockActors", AttributeType.Boolean) + , ("Engine.Actor:bCollideActors", AttributeType.Boolean) + , ("Engine.Actor:bHidden", AttributeType.Boolean) + , ("Engine.Actor:DrawScale", AttributeType.Float) + , ("Engine.Actor:RemoteRole", AttributeType.Enum) + , ("Engine.Actor:Role", AttributeType.Enum) + , ("Engine.GameReplicationInfo:bMatchIsOver", AttributeType.Boolean) + , ("Engine.GameReplicationInfo:GameClass", AttributeType.FlaggedInt) + , ("Engine.GameReplicationInfo:ServerName", AttributeType.String) + , ("Engine.Pawn:PlayerReplicationInfo", AttributeType.FlaggedInt) + , ("Engine.PlayerReplicationInfo:bBot", AttributeType.Boolean) + , ("Engine.PlayerReplicationInfo:bIsSpectator", AttributeType.Boolean) + , ("Engine.PlayerReplicationInfo:bReadyToPlay", AttributeType.Boolean) + , ("Engine.PlayerReplicationInfo:bTimedOut", AttributeType.Boolean) + , ("Engine.PlayerReplicationInfo:bWaitingPlayer", AttributeType.Boolean) + , ("Engine.PlayerReplicationInfo:Ping", AttributeType.Byte) + , ("Engine.PlayerReplicationInfo:PlayerID", AttributeType.Int) + , ("Engine.PlayerReplicationInfo:PlayerName", AttributeType.String) + , ("Engine.PlayerReplicationInfo:RemoteUserData", AttributeType.String) + , ("Engine.PlayerReplicationInfo:Score", AttributeType.Int) + , ("Engine.PlayerReplicationInfo:Team", AttributeType.FlaggedInt) + , ("Engine.PlayerReplicationInfo:UniqueId", AttributeType.UniqueId) + , ("Engine.ReplicatedActor_ORS:ReplicatedOwner", AttributeType.FlaggedInt) + , ("Engine.TeamInfo:Score", AttributeType.Int) + , ("ProjectX.GRI_X:bGameStarted", AttributeType.Boolean) + , ("ProjectX.GRI_X:GameServerID", AttributeType.QWord) + , ("ProjectX.GRI_X:MatchGUID", AttributeType.String) + , ("ProjectX.GRI_X:ReplicatedGameMutatorIndex", AttributeType.Int) + , ("ProjectX.GRI_X:ReplicatedGamePlaylist", AttributeType.Int) + , ("ProjectX.GRI_X:Reservations", AttributeType.Reservation) + , ("TAGame.Ball_Breakout_TA:AppliedDamage", AttributeType.AppliedDamage) + , ("TAGame.Ball_Breakout_TA:DamageIndex", AttributeType.Int) + , ("TAGame.Ball_Breakout_TA:LastTeamTouch", AttributeType.Byte) + , ("TAGame.Ball_God_TA:TargetSpeed", AttributeType.Float) + , ("TAGame.Ball_Haunted_TA:bIsBallBeamed", AttributeType.Boolean) + , ("TAGame.Ball_Haunted_TA:DeactivatedGoalIndex", AttributeType.Byte) + , ("TAGame.Ball_Haunted_TA:LastTeamTouch", AttributeType.Byte) + , ("TAGame.Ball_Haunted_TA:ReplicatedBeamBrokenValue", AttributeType.Byte) + , ("TAGame.Ball_Haunted_TA:TotalActiveBeams", AttributeType.Byte) + , ("TAGame.Ball_TA:GameEvent", AttributeType.FlaggedInt) + , ("TAGame.Ball_TA:HitTeamNum", AttributeType.Byte) + , ("TAGame.Ball_TA:ReplicatedAddedCarBounceScale", AttributeType.Float) + , ("TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale", AttributeType.Float) + , ("TAGame.Ball_TA:ReplicatedBallScale", AttributeType.Float) + , ("TAGame.Ball_TA:ReplicatedExplosionData", AttributeType.Explosion) + , ("TAGame.Ball_TA:ReplicatedExplosionDataExtended", AttributeType.ExtendedExplosion) + , ("TAGame.Ball_TA:ReplicatedPhysMatOverride", AttributeType.FlaggedInt) + , ("TAGame.Ball_TA:ReplicatedWorldBounceScale", AttributeType.Float) + , ("TAGame.BreakOutActor_Platform_TA:DamageState", AttributeType.DamageState) + , ("TAGame.CameraSettingsActor_TA:bMouseCameraToggleEnabled", AttributeType.Boolean) + , ("TAGame.CameraSettingsActor_TA:bUsingBehindView", AttributeType.Boolean) + , ("TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera", AttributeType.Boolean) + , ("TAGame.CameraSettingsActor_TA:bUsingSwivel", AttributeType.Boolean) + , ("TAGame.CameraSettingsActor_TA:CameraPitch", AttributeType.Byte) + , ("TAGame.CameraSettingsActor_TA:CameraYaw", AttributeType.Byte) + , ("TAGame.CameraSettingsActor_TA:PRI", AttributeType.FlaggedInt) + , ("TAGame.CameraSettingsActor_TA:ProfileSettings", AttributeType.CamSettings) + , ("TAGame.Car_TA:AddedBallForceMultiplier", AttributeType.Float) + , ("TAGame.Car_TA:AddedCarForceMultiplier", AttributeType.Float) + , ("TAGame.Car_TA:AttachedPickup", AttributeType.FlaggedInt) + , ("TAGame.Car_TA:ClubColors", AttributeType.ClubColors) + , ("TAGame.Car_TA:ReplicatedDemolish_CustomFX", AttributeType.CustomDemolish) + , ("TAGame.Car_TA:ReplicatedDemolish", AttributeType.Demolish) + , ("TAGame.Car_TA:RumblePickups", AttributeType.FlaggedInt) + , ("TAGame.Car_TA:TeamPaint", AttributeType.TeamPaint) + , ("TAGame.CarComponent_Boost_TA:bNoBoost", AttributeType.Boolean) + , ("TAGame.CarComponent_Boost_TA:BoostModifier", AttributeType.Float) + , ("TAGame.CarComponent_Boost_TA:bUnlimitedBoost", AttributeType.Boolean) + , ("TAGame.CarComponent_Boost_TA:RechargeDelay", AttributeType.Float) + , ("TAGame.CarComponent_Boost_TA:RechargeRate", AttributeType.Float) + , ("TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount", AttributeType.Byte) + , ("TAGame.CarComponent_Boost_TA:UnlimitedBoostRefCount", AttributeType.Int) + , ("TAGame.CarComponent_Dodge_TA:DodgeTorque", AttributeType.Location) + , ("TAGame.CarComponent_FlipCar_TA:bFlipRight", AttributeType.Boolean) + , ("TAGame.CarComponent_FlipCar_TA:FlipCarTime", AttributeType.Float) + , ("TAGame.CarComponent_TA:ReplicatedActive", AttributeType.Byte) + , ("TAGame.CarComponent_TA:ReplicatedActivityTime", AttributeType.Float) + , ("TAGame.CarComponent_TA:Vehicle", AttributeType.FlaggedInt) + , ("TAGame.CrowdActor_TA:GameEvent", AttributeType.FlaggedInt) + , ("TAGame.CrowdActor_TA:ModifiedNoise", AttributeType.Float) + , ("TAGame.CrowdActor_TA:ReplicatedCountDownNumber", AttributeType.Int) + , ("TAGame.CrowdActor_TA:ReplicatedOneShotSound", AttributeType.FlaggedInt) + , ("TAGame.CrowdActor_TA:ReplicatedRoundCountDownNumber", AttributeType.Int) + , ("TAGame.CrowdManager_TA:GameEvent", AttributeType.FlaggedInt) + , ("TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound", AttributeType.FlaggedInt) + , ("TAGame.GameEvent_Soccar_TA:bBallHasBeenHit", AttributeType.Boolean) + , ("TAGame.GameEvent_Soccar_TA:bClubMatch", AttributeType.Boolean) + , ("TAGame.GameEvent_Soccar_TA:bOverTime", AttributeType.Boolean) + , ("TAGame.GameEvent_Soccar_TA:bUnlimitedTime", AttributeType.Boolean) + , ("TAGame.GameEvent_Soccar_TA:GameTime", AttributeType.Int) + , ("TAGame.GameEvent_Soccar_TA:MaxScore", AttributeType.Int) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger", AttributeType.MusicStinger) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam", AttributeType.Byte) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedServerPerformanceState", AttributeType.Byte) + , ("TAGame.GameEvent_Soccar_TA:ReplicatedStatEvent", AttributeType.StatEvent) + , ("TAGame.GameEvent_Soccar_TA:RoundNum", AttributeType.Int) + , ("TAGame.GameEvent_Soccar_TA:SecondsRemaining", AttributeType.Int) + , ("TAGame.GameEvent_Soccar_TA:SeriesLength", AttributeType.Int) + , ("TAGame.GameEvent_Soccar_TA:SubRulesArchetype", AttributeType.FlaggedInt) + , ("TAGame.GameEvent_SoccarPrivate_TA:MatchSettings", AttributeType.PrivateMatchSettings) + , ("TAGame.GameEvent_TA:bCanVoteToForfeit", AttributeType.Boolean) + , ("TAGame.GameEvent_TA:bHasLeaveMatchPenalty", AttributeType.Boolean) + , ("TAGame.GameEvent_TA:BotSkill", AttributeType.Int) + , ("TAGame.GameEvent_TA:GameMode", AttributeType.GameMode) + , ("TAGame.GameEvent_TA:MatchTypeClass", AttributeType.FlaggedInt) + , ("TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining", AttributeType.Int) + , ("TAGame.GameEvent_TA:ReplicatedRoundCountDownNumber", AttributeType.Int) + , ("TAGame.GameEvent_TA:ReplicatedStateIndex", AttributeType.Byte) + , ("TAGame.GameEvent_TA:ReplicatedStateName", AttributeType.Int) + , ("TAGame.GameEvent_Team_TA:bForfeit", AttributeType.Boolean) + , ("TAGame.GameEvent_Team_TA:MaxTeamSize", AttributeType.Int) + , ("TAGame.GRI_TA:NewDedicatedServerIP", AttributeType.String) + , ("TAGame.MaxTimeWarningData_TA:EndGameEpochTime", AttributeType.Int64) + , ("TAGame.MaxTimeWarningData_TA:EndGameWarningEpochTime", AttributeType.Int64) + , ("TAGame.PRI_TA:bIsDistracted", AttributeType.Boolean) + , ("TAGame.PRI_TA:bIsInSplitScreen", AttributeType.Boolean) + , ("TAGame.PRI_TA:bMatchMVP", AttributeType.Boolean) + , ("TAGame.PRI_TA:bOnlineLoadoutSet", AttributeType.Boolean) + , ("TAGame.PRI_TA:bOnlineLoadoutsSet", AttributeType.Boolean) + , ("TAGame.PRI_TA:BotProductName", AttributeType.Int) + , ("TAGame.PRI_TA:bReady", AttributeType.Boolean) + , ("TAGame.PRI_TA:bUsingBehindView", AttributeType.Boolean) + , ("TAGame.PRI_TA:bUsingItems", AttributeType.Boolean) + , ("TAGame.PRI_TA:bUsingSecondaryCamera", AttributeType.Boolean) + , ("TAGame.PRI_TA:CameraPitch", AttributeType.Byte) + , ("TAGame.PRI_TA:CameraSettings", AttributeType.CamSettings) + , ("TAGame.PRI_TA:CameraYaw", AttributeType.Byte) + , ("TAGame.PRI_TA:ClientLoadout", AttributeType.Loadout) + , ("TAGame.PRI_TA:ClientLoadoutOnline", AttributeType.LoadoutOnline) + , ("TAGame.PRI_TA:ClientLoadouts", AttributeType.Loadouts) + , ("TAGame.PRI_TA:ClientLoadoutsOnline", AttributeType.LoadoutsOnline) + , ("TAGame.PRI_TA:ClubID", AttributeType.Int64) + , ("TAGame.PRI_TA:MatchAssists", AttributeType.Int) + , ("TAGame.PRI_TA:MatchBreakoutDamage", AttributeType.Int) + , ("TAGame.PRI_TA:MatchGoals", AttributeType.Int) + , ("TAGame.PRI_TA:MatchSaves", AttributeType.Int) + , ("TAGame.PRI_TA:MatchScore", AttributeType.Int) + , ("TAGame.PRI_TA:MatchShots", AttributeType.Int) + , ("TAGame.PRI_TA:MaxTimeTillItem", AttributeType.Int) + , ("TAGame.PRI_TA:PartyLeader", AttributeType.PartyLeader) + , ("TAGame.PRI_TA:PawnType", AttributeType.Byte) + , ("TAGame.PRI_TA:PersistentCamera", AttributeType.FlaggedInt) + , ("TAGame.PRI_TA:PlayerHistoryKey", AttributeType.PlayerHistoryKey) + , ("TAGame.PRI_TA:PlayerHistoryValid", AttributeType.Boolean) + , ("TAGame.PRI_TA:PrimaryTitle", AttributeType.Title) + , ("TAGame.PRI_TA:ReplicatedGameEvent", AttributeType.FlaggedInt) + , ("TAGame.PRI_TA:ReplicatedWorstNetQualityBeyondLatency", AttributeType.Byte) + , ("TAGame.PRI_TA:SecondaryTitle", AttributeType.Title) + , ("TAGame.PRI_TA:SkillTier", AttributeType.FlaggedByte) + , ("TAGame.PRI_TA:SpectatorShortcut", AttributeType.Int) + , ("TAGame.PRI_TA:SteeringSensitivity", AttributeType.Float) + , ("TAGame.PRI_TA:TimeTillItem", AttributeType.Int) + , ("TAGame.PRI_TA:Title", AttributeType.Int) + , ("TAGame.PRI_TA:TotalXP", AttributeType.Int) + , ("TAGame.RBActor_TA:bFrozen", AttributeType.Boolean) + , ("TAGame.RBActor_TA:bIgnoreSyncing", AttributeType.Boolean) + , ("TAGame.RBActor_TA:bReplayActor", AttributeType.Boolean) + , ("TAGame.RBActor_TA:ReplicatedRBState", AttributeType.RigidBodyState) + , ("TAGame.RBActor_TA:WeldedInfo", AttributeType.WeldedInfo) + , ("TAGame.RumblePickups_TA:AttachedPickup", AttributeType.FlaggedInt) + , ("TAGame.RumblePickups_TA:ConcurrentItemCount", AttributeType.Int) + , ("TAGame.SpecialPickup_BallFreeze_TA:RepOrigSpeed", AttributeType.Float) + , ("TAGame.SpecialPickup_BallVelcro_TA:AttachTime", AttributeType.Float) + , ("TAGame.SpecialPickup_BallVelcro_TA:bBroken", AttributeType.Boolean) + , ("TAGame.SpecialPickup_BallVelcro_TA:bHit", AttributeType.Boolean) + , ("TAGame.SpecialPickup_BallVelcro_TA:BreakTime", AttributeType.Float) + , ("TAGame.SpecialPickup_Football_TA:WeldedBall", AttributeType.FlaggedInt) + , ("TAGame.SpecialPickup_Rugby_TA:bBallWelded", AttributeType.Boolean) + , ("TAGame.SpecialPickup_Targeted_TA:Targeted", AttributeType.FlaggedInt) + , ("TAGame.Team_Soccar_TA:GameScore", AttributeType.Int) + , ("TAGame.Team_TA:ClubColors", AttributeType.ClubColors) + , ("TAGame.Team_TA:ClubID", AttributeType.Int64) + , ("TAGame.Team_TA:CustomTeamName", AttributeType.String) + , ("TAGame.Team_TA:Difficulty", AttributeType.Int) + , ("TAGame.Team_TA:GameEvent", AttributeType.FlaggedInt) + , ("TAGame.Team_TA:LogoData", AttributeType.FlaggedInt) + , ("TAGame.Vehicle_TA:bDriving", AttributeType.Boolean) + , ("TAGame.Vehicle_TA:bReplicatedHandbrake", AttributeType.Boolean) + , ("TAGame.Vehicle_TA:ReplicatedSteer", AttributeType.Byte) + , ("TAGame.Vehicle_TA:ReplicatedThrottle", AttributeType.Byte) + , ("TAGame.VehiclePickup_TA:bNoPickup", AttributeType.Boolean) + , ("TAGame.VehiclePickup_TA:NewReplicatedPickupData", AttributeType.PickupNew) + , ("TAGame.VehiclePickup_TA:ReplicatedPickupData", AttributeType.Pickup) ] diff --git a/src/lib/Rattletrap/Decode/AppliedDamageAttribute.hs b/src/lib/Rattletrap/Decode/AppliedDamageAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/AppliedDamageAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Decode.AppliedDamageAttribute - ( decodeAppliedDamageAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Decode.Vector -import Rattletrap.Decode.Word8le -import Rattletrap.Type.AppliedDamageAttribute - -decodeAppliedDamageAttributeBits - :: (Int, Int, Int) -> DecodeBits AppliedDamageAttribute -decodeAppliedDamageAttributeBits version = - AppliedDamageAttribute - <$> decodeWord8leBits - <*> decodeVectorBits version - <*> decodeInt32leBits - <*> decodeInt32leBits diff --git a/src/lib/Rattletrap/Decode/Attribute.hs b/src/lib/Rattletrap/Decode/Attribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Attribute.hs +++ /dev/null @@ -1,73 +0,0 @@ -module Rattletrap.Decode.Attribute - ( decodeAttributesBits - ) -where - -import Rattletrap.Decode.AttributeValue -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Type.Attribute -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -decodeAttributesBits - :: (Int, Int, Int) - -> ClassAttributeMap - -> Map CompressedWord Word32le - -> CompressedWord - -> DecodeBits [Attribute] -decodeAttributesBits version classes actors actor = do - hasAttribute <- getBool - if hasAttribute - then - (:) - <$> decodeAttributeBits version classes actors actor - <*> decodeAttributesBits version classes actors actor - else pure [] - -decodeAttributeBits - :: (Int, Int, Int) - -> ClassAttributeMap - -> Map CompressedWord Word32le - -> CompressedWord - -> DecodeBits Attribute -decodeAttributeBits version classes actors actor = do - attributes <- lookupAttributeMap classes actors actor - limit <- lookupAttributeIdLimit attributes actor - attribute <- decodeCompressedWordBits limit - name <- lookupAttributeName classes attributes attribute - Attribute attribute name - <$> decodeAttributeValueBits - version - (classAttributeMapObjectMap classes) - name - -lookupAttributeMap - :: ClassAttributeMap - -> Map CompressedWord Word32le - -> CompressedWord - -> DecodeBits (Map Word32le Word32le) -lookupAttributeMap classes actors actor = fromMaybe - ("[RT01] could not get attribute map for " <> show actor) - (getAttributeMap classes actors actor) - -lookupAttributeIdLimit - :: Map Word32le Word32le -> CompressedWord -> DecodeBits Word -lookupAttributeIdLimit attributes actor = fromMaybe - ("[RT02] could not get attribute ID limit for " <> show actor) - (getAttributeIdLimit attributes) - -lookupAttributeName - :: ClassAttributeMap - -> Map Word32le Word32le - -> CompressedWord - -> DecodeBits Str -lookupAttributeName classes attributes attribute = fromMaybe - ("[RT03] could not get attribute name for " <> show attribute) - (getAttributeName classes attributes attribute) - -fromMaybe :: String -> Maybe a -> DecodeBits a -fromMaybe message = maybe (fail message) pure diff --git a/src/lib/Rattletrap/Decode/AttributeMapping.hs b/src/lib/Rattletrap/Decode/AttributeMapping.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/AttributeMapping.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.AttributeMapping - ( decodeAttributeMapping - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Type.AttributeMapping - -decodeAttributeMapping :: Decode AttributeMapping -decodeAttributeMapping = - AttributeMapping <$> decodeWord32le <*> decodeWord32le diff --git a/src/lib/Rattletrap/Decode/AttributeValue.hs b/src/lib/Rattletrap/Decode/AttributeValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/AttributeValue.hs +++ /dev/null @@ -1,131 +0,0 @@ -module Rattletrap.Decode.AttributeValue - ( decodeAttributeValueBits - ) -where - -import Rattletrap.Data -import Rattletrap.Decode.AppliedDamageAttribute -import Rattletrap.Decode.BooleanAttribute -import Rattletrap.Decode.ByteAttribute -import Rattletrap.Decode.CamSettingsAttribute -import Rattletrap.Decode.ClubColorsAttribute -import Rattletrap.Decode.Common -import Rattletrap.Decode.CustomDemolishAttribute -import Rattletrap.Decode.DamageStateAttribute -import Rattletrap.Decode.DemolishAttribute -import Rattletrap.Decode.EnumAttribute -import Rattletrap.Decode.ExplosionAttribute -import Rattletrap.Decode.ExtendedExplosionAttribute -import Rattletrap.Decode.FlaggedIntAttribute -import Rattletrap.Decode.FlaggedByteAttribute -import Rattletrap.Decode.FloatAttribute -import Rattletrap.Decode.GameModeAttribute -import Rattletrap.Decode.Int64Attribute -import Rattletrap.Decode.IntAttribute -import Rattletrap.Decode.LoadoutAttribute -import Rattletrap.Decode.LoadoutOnlineAttribute -import Rattletrap.Decode.LoadoutsAttribute -import Rattletrap.Decode.LoadoutsOnlineAttribute -import Rattletrap.Decode.LocationAttribute -import Rattletrap.Decode.MusicStingerAttribute -import Rattletrap.Decode.PartyLeaderAttribute -import Rattletrap.Decode.PickupAttribute -import Rattletrap.Decode.PickupAttributeNew -import Rattletrap.Decode.PlayerHistoryKeyAttribute -import Rattletrap.Decode.PrivateMatchSettingsAttribute -import Rattletrap.Decode.QWordAttribute -import Rattletrap.Decode.ReservationAttribute -import Rattletrap.Decode.RigidBodyStateAttribute -import Rattletrap.Decode.StatEventAttribute -import Rattletrap.Decode.StringAttribute -import Rattletrap.Decode.TeamPaintAttribute -import Rattletrap.Decode.TitleAttribute -import Rattletrap.Decode.UniqueIdAttribute -import Rattletrap.Decode.WeldedInfoAttribute -import Rattletrap.Type.AttributeType -import Rattletrap.Type.AttributeValue -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -import qualified Data.Map as Map - -decodeAttributeValueBits - :: (Int, Int, Int) -> Map Word32le Str -> Str -> DecodeBits AttributeValue -decodeAttributeValueBits version objectMap name = do - constructor <- maybe - (fail ("[RT04] don't know how to get attribute value " <> show name)) - pure - (Map.lookup name attributeTypes) - case constructor of - AttributeTypeAppliedDamage -> - AttributeValueAppliedDamage <$> decodeAppliedDamageAttributeBits version - AttributeTypeBoolean -> - AttributeValueBoolean <$> decodeBooleanAttributeBits - AttributeTypeByte -> AttributeValueByte <$> decodeByteAttributeBits - AttributeTypeCamSettings -> - AttributeValueCamSettings <$> decodeCamSettingsAttributeBits version - AttributeTypeClubColors -> - AttributeValueClubColors <$> decodeClubColorsAttributeBits - AttributeTypeCustomDemolish -> - AttributeValueCustomDemolish <$> decodeCustomDemolishAttributeBits version - AttributeTypeDamageState -> - AttributeValueDamageState <$> decodeDamageStateAttributeBits version - AttributeTypeDemolish -> - AttributeValueDemolish <$> decodeDemolishAttributeBits version - AttributeTypeEnum -> AttributeValueEnum <$> decodeEnumAttributeBits - AttributeTypeExplosion -> - AttributeValueExplosion <$> decodeExplosionAttributeBits version - AttributeTypeExtendedExplosion -> AttributeValueExtendedExplosion - <$> decodeExtendedExplosionAttributeBits version - AttributeTypeFlaggedInt -> - AttributeValueFlaggedInt <$> decodeFlaggedIntAttributeBits - AttributeTypeFlaggedByte -> - AttributeValueFlaggedByte <$> decodeFlaggedByteAttributeBits - AttributeTypeFloat -> AttributeValueFloat <$> decodeFloatAttributeBits - AttributeTypeGameMode -> - AttributeValueGameMode <$> decodeGameModeAttributeBits version - AttributeTypeInt -> AttributeValueInt <$> decodeIntAttributeBits - AttributeTypeInt64 -> AttributeValueInt64 <$> decodeInt64AttributeBits - AttributeTypeLoadout -> - AttributeValueLoadout <$> decodeLoadoutAttributeBits - AttributeTypeLoadoutOnline -> - AttributeValueLoadoutOnline - <$> decodeLoadoutOnlineAttributeBits version objectMap - AttributeTypeLoadouts -> - AttributeValueLoadouts <$> decodeLoadoutsAttributeBits - AttributeTypeLoadoutsOnline -> - AttributeValueLoadoutsOnline - <$> decodeLoadoutsOnlineAttributeBits version objectMap - AttributeTypeLocation -> - AttributeValueLocation <$> decodeLocationAttributeBits version - AttributeTypeMusicStinger -> - AttributeValueMusicStinger <$> decodeMusicStingerAttributeBits - AttributeTypePartyLeader -> - AttributeValuePartyLeader <$> decodePartyLeaderAttributeBits version - AttributeTypePickup -> AttributeValuePickup <$> decodePickupAttributeBits - AttributeTypePickupNew -> - AttributeValuePickupNew <$> decodePickupAttributeNewBits - AttributeTypePlayerHistoryKey -> - AttributeValuePlayerHistoryKey <$> decodePlayerHistoryKeyAttributeBits - AttributeTypePrivateMatchSettings -> - AttributeValuePrivateMatchSettings - <$> decodePrivateMatchSettingsAttributeBits - AttributeTypeQWord -> AttributeValueQWord <$> decodeQWordAttributeBits - AttributeTypeReservation -> - AttributeValueReservation <$> decodeReservationAttributeBits version - AttributeTypeRigidBodyState -> AttributeValueRigidBodyState - <$> decodeRigidBodyStateAttributeBits version - AttributeTypeStatEvent -> - AttributeValueStatEvent <$> decodeStatEventAttributeBits - AttributeTypeString -> AttributeValueString <$> decodeStringAttributeBits - AttributeTypeTeamPaint -> - AttributeValueTeamPaint <$> decodeTeamPaintAttributeBits - AttributeTypeTitle -> AttributeValueTitle <$> decodeTitleAttributeBits - AttributeTypeUniqueId -> - AttributeValueUniqueId <$> decodeUniqueIdAttributeBits version - AttributeTypeWeldedInfo -> - AttributeValueWeldedInfo <$> decodeWeldedInfoAttributeBits version - -attributeTypes :: Map Str AttributeType -attributeTypes = Map.mapKeys toStr (Map.fromList rawAttributeTypes) diff --git a/src/lib/Rattletrap/Decode/BooleanAttribute.hs b/src/lib/Rattletrap/Decode/BooleanAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/BooleanAttribute.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Rattletrap.Decode.BooleanAttribute - ( decodeBooleanAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.BooleanAttribute - -decodeBooleanAttributeBits :: DecodeBits BooleanAttribute -decodeBooleanAttributeBits = BooleanAttribute <$> getBool diff --git a/src/lib/Rattletrap/Decode/ByteAttribute.hs b/src/lib/Rattletrap/Decode/ByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ByteAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.ByteAttribute - ( decodeByteAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word8le -import Rattletrap.Type.ByteAttribute - -decodeByteAttributeBits :: DecodeBits ByteAttribute -decodeByteAttributeBits = ByteAttribute <$> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/Cache.hs b/src/lib/Rattletrap/Decode/Cache.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Cache.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Decode.Cache - ( decodeCache - ) -where - -import Rattletrap.Decode.AttributeMapping -import Rattletrap.Decode.Common -import Rattletrap.Decode.List -import Rattletrap.Decode.Word32le -import Rattletrap.Type.Cache - -decodeCache :: Decode Cache -decodeCache = - Cache - <$> decodeWord32le - <*> decodeWord32le - <*> decodeWord32le - <*> decodeList decodeAttributeMapping diff --git a/src/lib/Rattletrap/Decode/CamSettingsAttribute.hs b/src/lib/Rattletrap/Decode/CamSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/CamSettingsAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Decode.CamSettingsAttribute - ( decodeCamSettingsAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Float32le -import Rattletrap.Type.CamSettingsAttribute - -decodeCamSettingsAttributeBits - :: (Int, Int, Int) -> DecodeBits CamSettingsAttribute -decodeCamSettingsAttributeBits version = - CamSettingsAttribute - <$> decodeFloat32leBits - <*> decodeFloat32leBits - <*> decodeFloat32leBits - <*> decodeFloat32leBits - <*> decodeFloat32leBits - <*> decodeFloat32leBits - <*> decodeWhen (version >= (868, 20, 0)) decodeFloat32leBits diff --git a/src/lib/Rattletrap/Decode/ClassMapping.hs b/src/lib/Rattletrap/Decode/ClassMapping.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ClassMapping.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.ClassMapping - ( decodeClassMapping - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.ClassMapping - -decodeClassMapping :: Decode ClassMapping -decodeClassMapping = ClassMapping <$> decodeStr <*> decodeWord32le diff --git a/src/lib/Rattletrap/Decode/ClubColorsAttribute.hs b/src/lib/Rattletrap/Decode/ClubColorsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ClubColorsAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.ClubColorsAttribute - ( decodeClubColorsAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word8le -import Rattletrap.Type.ClubColorsAttribute - -decodeClubColorsAttributeBits :: DecodeBits ClubColorsAttribute -decodeClubColorsAttributeBits = - ClubColorsAttribute - <$> getBool - <*> decodeWord8leBits - <*> getBool - <*> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/Common.hs b/src/lib/Rattletrap/Decode/Common.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Common.hs +++ /dev/null @@ -1,70 +0,0 @@ -module Rattletrap.Decode.Common - ( Decode - , DecodeBits - , decodeWhen - , getBitsLE - , getByteStringBits - , getWord8Bits - , runDecode - , runDecodeBits - , toBits - , Binary.getFloatle - , Binary.getByteString - , Binary.getInt8 - , Binary.getInt32le - , Binary.getInt64le - , Binary.getWord8 - , Binary.getWord32le - , Binary.getWord64le - , BinaryBits.getBool - ) -where - -import qualified Control.Applicative as Applicative -import qualified Control.Monad as Monad -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Get as BinaryBits -import qualified Data.Binary.Get as Binary -import qualified Data.Bits as Bits -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as LazyBytes -import qualified Data.Word as Word -import qualified Rattletrap.Utility.Bytes as Utility - -type Decode = Binary.Get - -type DecodeBits = BinaryBits.BitGet - -decodeWhen - :: (Applicative m, Applicative.Alternative f) => Bool -> m a -> m (f a) -decodeWhen p f = if p then fmap pure f else pure Applicative.empty - -getByteStringBits :: Int -> DecodeBits Bytes.ByteString -getByteStringBits = BinaryBits.getByteString - -getWord8Bits :: Int -> DecodeBits Word.Word8 -getWord8Bits = BinaryBits.getWord8 - -runDecode :: Decode a -> Bytes.ByteString -> Either String a -runDecode decode bytes = - case Binary.runGetOrFail decode (LazyBytes.fromStrict bytes) of - Left (_, _, x) -> Left x - Right (_, _, x) -> Right x - -runDecodeBits :: DecodeBits a -> Bytes.ByteString -> Either String a -runDecodeBits = runDecode . BinaryBits.runBitGet - -toBits :: Decode a -> Int -> DecodeBits a -toBits decode size = do - bytes <- BinaryBits.getByteString size - case runDecode decode (Utility.reverseBytes bytes) of - Left problem -> fail problem - Right result -> pure result - -getBitsLE :: Bits.Bits a => Int -> BinaryBits.BitGet a -getBitsLE size = do - bits <- Monad.replicateM size BinaryBits.getBool - pure $ foldr - (\bit x -> let y = Bits.shiftL x 1 in if bit then Bits.setBit y 0 else y) - Bits.zeroBits - bits diff --git a/src/lib/Rattletrap/Decode/CompressedWord.hs b/src/lib/Rattletrap/Decode/CompressedWord.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/CompressedWord.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Rattletrap.Decode.CompressedWord - ( decodeCompressedWordBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.CompressedWord - -import qualified Data.Bits as Bits - -decodeCompressedWordBits :: Word -> DecodeBits CompressedWord -decodeCompressedWordBits limit = - CompressedWord limit <$> step limit (getMaxBits limit) 0 0 - -getMaxBits :: Word -> Word -getMaxBits x = do - let - n :: Word - n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) - if x < 1024 && x == 2 ^ n then n + 1 else n - -step :: Word -> Word -> Word -> Word -> DecodeBits Word -step limit maxBits position value = do - let x = Bits.shiftL 1 (fromIntegral position) :: Word - if position < maxBits && value + x <= limit - then do - bit <- getBool - let newValue = if bit then value + x else value - step limit maxBits (position + 1) newValue - else pure value diff --git a/src/lib/Rattletrap/Decode/CompressedWordVector.hs b/src/lib/Rattletrap/Decode/CompressedWordVector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/CompressedWordVector.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Decode.CompressedWordVector - ( decodeCompressedWordVectorBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Type.CompressedWordVector - -decodeCompressedWordVectorBits :: DecodeBits CompressedWordVector -decodeCompressedWordVectorBits = - CompressedWordVector - <$> decodeCompressedWordBits limit - <*> decodeCompressedWordBits limit - <*> decodeCompressedWordBits limit - -limit :: Word -limit = 65536 diff --git a/src/lib/Rattletrap/Decode/Content.hs b/src/lib/Rattletrap/Decode/Content.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Content.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Rattletrap.Decode.Content - ( decodeContent - ) -where - -import Rattletrap.Decode.Cache -import Rattletrap.Decode.ClassMapping -import Rattletrap.Decode.Common -import Rattletrap.Decode.Frame -import Rattletrap.Decode.KeyFrame -import Rattletrap.Decode.List -import Rattletrap.Decode.Mark -import Rattletrap.Decode.Message -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.Content -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Bytes - -import qualified Control.Monad.Trans.State as State -import qualified Data.Binary.Get as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -decodeContent - :: (Int, Int, Int) - -- ^ Version numbers, usually from 'Rattletrap.Header.getVersion'. - -> Int - -- ^ The number of frames in the stream, usually from - -- 'Rattletrap.Header.getNumFrames'. - -> Word - -- ^ The maximum number of channels in the stream, usually from - -- 'Rattletrap.Header.getMaxChannels'. - -> Decode Content -decodeContent version numFrames maxChannels = do - (levels, keyFrames, streamSize) <- - (,,) - <$> decodeList decodeStr - <*> decodeList decodeKeyFrame - <*> decodeWord32le - (stream, messages, marks, packages, objects, names, classMappings, caches) <- - (,,,,,,,) - <$> getByteString (fromIntegral (word32leValue streamSize)) - <*> decodeList decodeMessage - <*> decodeList decodeMark - <*> decodeList decodeStr - <*> decodeList decodeStr - <*> decodeList decodeStr - <*> decodeList decodeClassMapping - <*> decodeList decodeCache - let - classAttributeMap = - makeClassAttributeMap objects classMappings caches names - bitGet = State.evalStateT - (decodeFramesBits version numFrames maxChannels classAttributeMap) - mempty - frames <- either fail pure (runDecodeBits bitGet (reverseBytes stream)) - Content - levels - keyFrames - streamSize - frames - messages - marks - packages - objects - names - classMappings - caches - . LazyBytes.unpack - <$> Binary.getRemainingLazyByteString diff --git a/src/lib/Rattletrap/Decode/CustomDemolishAttribute.hs b/src/lib/Rattletrap/Decode/CustomDemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/CustomDemolishAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.CustomDemolishAttribute - ( decodeCustomDemolishAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.DemolishAttribute -import Rattletrap.Decode.Int32le -import Rattletrap.Type.CustomDemolishAttribute - -decodeCustomDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits CustomDemolishAttribute -decodeCustomDemolishAttributeBits version = - CustomDemolishAttribute - <$> getBool - <*> decodeInt32leBits - <*> decodeDemolishAttributeBits version diff --git a/src/lib/Rattletrap/Decode/DamageStateAttribute.hs b/src/lib/Rattletrap/Decode/DamageStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/DamageStateAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Decode.DamageStateAttribute - ( decodeDamageStateAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Decode.Vector -import Rattletrap.Decode.Word8le -import Rattletrap.Type.DamageStateAttribute - -decodeDamageStateAttributeBits - :: (Int, Int, Int) -> DecodeBits DamageStateAttribute -decodeDamageStateAttributeBits version = - DamageStateAttribute - <$> decodeWord8leBits - <*> getBool - <*> decodeInt32leBits - <*> decodeVectorBits version - <*> getBool - <*> getBool diff --git a/src/lib/Rattletrap/Decode/DemolishAttribute.hs b/src/lib/Rattletrap/Decode/DemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/DemolishAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Decode.DemolishAttribute - ( decodeDemolishAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Vector -import Rattletrap.Decode.Word32le -import Rattletrap.Type.DemolishAttribute - -decodeDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits DemolishAttribute -decodeDemolishAttributeBits version = - DemolishAttribute - <$> getBool - <*> decodeWord32leBits - <*> getBool - <*> decodeWord32leBits - <*> decodeVectorBits version - <*> decodeVectorBits version diff --git a/src/lib/Rattletrap/Decode/DestroyedReplication.hs b/src/lib/Rattletrap/Decode/DestroyedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/DestroyedReplication.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Rattletrap.Decode.DestroyedReplication - ( decodeDestroyedReplicationBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.DestroyedReplication - -decodeDestroyedReplicationBits :: DecodeBits DestroyedReplication -decodeDestroyedReplicationBits = pure DestroyedReplication diff --git a/src/lib/Rattletrap/Decode/Dictionary.hs b/src/lib/Rattletrap/Decode/Dictionary.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Dictionary.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.Decode.Dictionary - ( decodeDictionary - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Type.Dictionary -import Rattletrap.Type.Str - -decodeDictionary :: Decode a -> Decode (Dictionary a) -decodeDictionary decodeValue = do - key <- decodeStr - case filter (/= '\x00') (fromStr key) of - "None" -> pure (DictionaryEnd key) - _ -> - DictionaryElement key <$> decodeValue <*> decodeDictionary decodeValue diff --git a/src/lib/Rattletrap/Decode/EnumAttribute.hs b/src/lib/Rattletrap/Decode/EnumAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/EnumAttribute.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Rattletrap.Decode.EnumAttribute - ( decodeEnumAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.EnumAttribute - -decodeEnumAttributeBits :: DecodeBits EnumAttribute -decodeEnumAttributeBits = EnumAttribute <$> getBitsLE 11 diff --git a/src/lib/Rattletrap/Decode/ExplosionAttribute.hs b/src/lib/Rattletrap/Decode/ExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ExplosionAttribute.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.Decode.ExplosionAttribute - ( decodeExplosionAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Decode.Vector -import Rattletrap.Type.ExplosionAttribute - -decodeExplosionAttributeBits - :: (Int, Int, Int) -> DecodeBits ExplosionAttribute -decodeExplosionAttributeBits version = - ExplosionAttribute - <$> getBool - <*> decodeInt32leBits - <*> decodeVectorBits version diff --git a/src/lib/Rattletrap/Decode/ExtendedExplosionAttribute.hs b/src/lib/Rattletrap/Decode/ExtendedExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ExtendedExplosionAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.ExtendedExplosionAttribute - ( decodeExtendedExplosionAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.ExplosionAttribute -import Rattletrap.Decode.FlaggedIntAttribute -import Rattletrap.Type.ExtendedExplosionAttribute - -decodeExtendedExplosionAttributeBits - :: (Int, Int, Int) -> DecodeBits ExtendedExplosionAttribute -decodeExtendedExplosionAttributeBits version = - ExtendedExplosionAttribute - <$> decodeExplosionAttributeBits version - <*> decodeFlaggedIntAttributeBits diff --git a/src/lib/Rattletrap/Decode/FlaggedByteAttribute.hs b/src/lib/Rattletrap/Decode/FlaggedByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/FlaggedByteAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Decode.FlaggedByteAttribute - ( decodeFlaggedByteAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word8le -import Rattletrap.Type.FlaggedByteAttribute - - -decodeFlaggedByteAttributeBits :: DecodeBits FlaggedByteAttribute -decodeFlaggedByteAttributeBits = - FlaggedByteAttribute <$> getBool <*> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/FlaggedIntAttribute.hs b/src/lib/Rattletrap/Decode/FlaggedIntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/FlaggedIntAttribute.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.FlaggedIntAttribute - ( decodeFlaggedIntAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Type.FlaggedIntAttribute - -decodeFlaggedIntAttributeBits :: DecodeBits FlaggedIntAttribute -decodeFlaggedIntAttributeBits = - FlaggedIntAttribute <$> getBool <*> decodeInt32leBits diff --git a/src/lib/Rattletrap/Decode/Float32le.hs b/src/lib/Rattletrap/Decode/Float32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Float32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Float32le - ( decodeFloat32le - , decodeFloat32leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Float32le - -decodeFloat32le :: Decode Float32le -decodeFloat32le = Float32le <$> getFloatle - -decodeFloat32leBits :: DecodeBits Float32le -decodeFloat32leBits = toBits decodeFloat32le 4 diff --git a/src/lib/Rattletrap/Decode/FloatAttribute.hs b/src/lib/Rattletrap/Decode/FloatAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/FloatAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.FloatAttribute - ( decodeFloatAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Float32le -import Rattletrap.Type.FloatAttribute - -decodeFloatAttributeBits :: DecodeBits FloatAttribute -decodeFloatAttributeBits = FloatAttribute <$> decodeFloat32leBits diff --git a/src/lib/Rattletrap/Decode/Frame.hs b/src/lib/Rattletrap/Decode/Frame.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Frame.hs +++ /dev/null @@ -1,43 +0,0 @@ -module Rattletrap.Decode.Frame - ( decodeFramesBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Float32le -import Rattletrap.Decode.Replication -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Frame -import Rattletrap.Type.Word32le - -import qualified Control.Monad.Trans.Class as Trans -import qualified Control.Monad.Trans.State as State -import qualified Data.Map as Map - -decodeFramesBits - :: (Int, Int, Int) - -> Int - -> Word - -> ClassAttributeMap - -> State.StateT - (Map.Map CompressedWord Word32le) - DecodeBits - [Frame] -decodeFramesBits version count limit classes = if count <= 0 - then pure [] - else - (:) - <$> decodeFrameBits version limit classes - <*> decodeFramesBits version (count - 1) limit classes - -decodeFrameBits - :: (Int, Int, Int) - -> Word - -> ClassAttributeMap - -> State.StateT (Map.Map CompressedWord Word32le) DecodeBits Frame -decodeFrameBits version limit classes = - Frame - <$> Trans.lift decodeFloat32leBits - <*> Trans.lift decodeFloat32leBits - <*> decodeReplicationsBits version limit classes diff --git a/src/lib/Rattletrap/Decode/GameModeAttribute.hs b/src/lib/Rattletrap/Decode/GameModeAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/GameModeAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Decode.GameModeAttribute - ( decodeGameModeAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.GameModeAttribute - -decodeGameModeAttributeBits :: (Int, Int, Int) -> DecodeBits GameModeAttribute -decodeGameModeAttributeBits version = - GameModeAttribute <$> pure (numBits version) <*> getWord8Bits - (numBits version) - -numBits :: (Int, Int, Int) -> Int -numBits version = if version >= (868, 12, 0) then 8 else 2 diff --git a/src/lib/Rattletrap/Decode/Header.hs b/src/lib/Rattletrap/Decode/Header.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Header.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.Decode.Header - ( decodeHeader - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Dictionary -import Rattletrap.Decode.Property -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.Header -import Rattletrap.Type.Word32le - -decodeHeader :: Decode Header -decodeHeader = do - (major, minor) <- (,) <$> decodeWord32le <*> decodeWord32le - Header major minor - <$> decodeWhen - (major >= Word32le 868 && minor >= Word32le 18) - decodeWord32le - <*> decodeStr - <*> decodeDictionary decodeProperty diff --git a/src/lib/Rattletrap/Decode/Initialization.hs b/src/lib/Rattletrap/Decode/Initialization.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Initialization.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.Initialization - ( decodeInitializationBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int8Vector -import Rattletrap.Decode.Vector -import Rattletrap.Type.Initialization - -decodeInitializationBits - :: (Int, Int, Int) -> Bool -> Bool -> DecodeBits Initialization -decodeInitializationBits version hasLocation hasRotation = - Initialization - <$> decodeWhen hasLocation (decodeVectorBits version) - <*> decodeWhen hasRotation decodeInt8VectorBits diff --git a/src/lib/Rattletrap/Decode/Int32le.hs b/src/lib/Rattletrap/Decode/Int32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Int32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Int32le - ( decodeInt32le - , decodeInt32leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Int32le - -decodeInt32le :: Decode Int32le -decodeInt32le = Int32le <$> getInt32le - -decodeInt32leBits :: DecodeBits Int32le -decodeInt32leBits = toBits decodeInt32le 4 diff --git a/src/lib/Rattletrap/Decode/Int64Attribute.hs b/src/lib/Rattletrap/Decode/Int64Attribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Int64Attribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.Int64Attribute - ( decodeInt64AttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int64le -import Rattletrap.Type.Int64Attribute - -decodeInt64AttributeBits :: DecodeBits Int64Attribute -decodeInt64AttributeBits = Int64Attribute <$> decodeInt64leBits diff --git a/src/lib/Rattletrap/Decode/Int64le.hs b/src/lib/Rattletrap/Decode/Int64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Int64le.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Decode.Int64le - ( decodeInt64leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Int64le - -decodeInt64le :: Decode Int64le -decodeInt64le = Int64le <$> getInt64le - -decodeInt64leBits :: DecodeBits Int64le -decodeInt64leBits = toBits decodeInt64le 8 diff --git a/src/lib/Rattletrap/Decode/Int8Vector.hs b/src/lib/Rattletrap/Decode/Int8Vector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Int8Vector.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Decode.Int8Vector - ( decodeInt8VectorBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int8le -import Rattletrap.Type.Int8Vector -import Rattletrap.Type.Int8le - -decodeInt8VectorBits :: DecodeBits Int8Vector -decodeInt8VectorBits = - Int8Vector <$> decodeFieldBits <*> decodeFieldBits <*> decodeFieldBits - -decodeFieldBits :: DecodeBits (Maybe Int8le) -decodeFieldBits = do - hasField <- getBool - decodeWhen hasField decodeInt8leBits diff --git a/src/lib/Rattletrap/Decode/Int8le.hs b/src/lib/Rattletrap/Decode/Int8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Int8le.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Decode.Int8le - ( decodeInt8leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Int8le - -decodeInt8le :: Decode Int8le -decodeInt8le = Int8le <$> getInt8 - -decodeInt8leBits :: DecodeBits Int8le -decodeInt8leBits = toBits decodeInt8le 1 diff --git a/src/lib/Rattletrap/Decode/IntAttribute.hs b/src/lib/Rattletrap/Decode/IntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/IntAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.IntAttribute - ( decodeIntAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Type.IntAttribute - -decodeIntAttributeBits :: DecodeBits IntAttribute -decodeIntAttributeBits = IntAttribute <$> decodeInt32leBits diff --git a/src/lib/Rattletrap/Decode/KeyFrame.hs b/src/lib/Rattletrap/Decode/KeyFrame.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/KeyFrame.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Decode.KeyFrame - ( decodeKeyFrame - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Float32le -import Rattletrap.Decode.Word32le -import Rattletrap.Type.KeyFrame - -decodeKeyFrame :: Decode KeyFrame -decodeKeyFrame = - KeyFrame <$> decodeFloat32le <*> decodeWord32le <*> decodeWord32le diff --git a/src/lib/Rattletrap/Decode/List.hs b/src/lib/Rattletrap/Decode/List.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/List.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.List - ( decodeList - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Type.List -import Rattletrap.Type.Word32le - -import qualified Control.Monad as Monad - -decodeList :: Decode a -> Decode (List a) -decodeList decodeElement = do - size <- decodeWord32le - List <$> Monad.replicateM (fromIntegral (word32leValue size)) decodeElement diff --git a/src/lib/Rattletrap/Decode/LoadoutAttribute.hs b/src/lib/Rattletrap/Decode/LoadoutAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/LoadoutAttribute.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.Decode.LoadoutAttribute - ( decodeLoadoutAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Decode.Word8le -import Rattletrap.Type.LoadoutAttribute -import Rattletrap.Type.Word8le - -decodeLoadoutAttributeBits :: DecodeBits LoadoutAttribute -decodeLoadoutAttributeBits = do - version <- decodeWord8leBits - LoadoutAttribute version - <$> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWhen (version >= Word8le 11) decodeWord32leBits - <*> decodeWhen (version >= Word8le 16) decodeWord32leBits - <*> decodeWhen (version >= Word8le 16) decodeWord32leBits - <*> decodeWhen (version >= Word8le 16) decodeWord32leBits - <*> decodeWhen (version >= Word8le 17) decodeWord32leBits - <*> decodeWhen (version >= Word8le 19) decodeWord32leBits - <*> decodeWhen (version >= Word8le 22) decodeWord32leBits - <*> decodeWhen (version >= Word8le 22) decodeWord32leBits - <*> decodeWhen (version >= Word8le 22) decodeWord32leBits diff --git a/src/lib/Rattletrap/Decode/LoadoutOnlineAttribute.hs b/src/lib/Rattletrap/Decode/LoadoutOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/LoadoutOnlineAttribute.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Rattletrap.Decode.LoadoutOnlineAttribute - ( decodeLoadoutOnlineAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.ProductAttribute -import Rattletrap.Decode.Word8le -import Rattletrap.Type.LoadoutOnlineAttribute -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le -import Rattletrap.Type.Word8le - -import qualified Control.Monad as Monad -import qualified Data.Map as Map - -decodeLoadoutOnlineAttributeBits - :: (Int, Int, Int) - -> Map.Map Word32le Str - -> DecodeBits LoadoutOnlineAttribute -decodeLoadoutOnlineAttributeBits version objectMap = do - size <- decodeWord8leBits - LoadoutOnlineAttribute <$> Monad.replicateM - (fromIntegral (word8leValue size)) - (decodeProductAttributesBits version objectMap) diff --git a/src/lib/Rattletrap/Decode/LoadoutsAttribute.hs b/src/lib/Rattletrap/Decode/LoadoutsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/LoadoutsAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.LoadoutsAttribute - ( decodeLoadoutsAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.LoadoutAttribute -import Rattletrap.Type.LoadoutsAttribute - -decodeLoadoutsAttributeBits :: DecodeBits LoadoutsAttribute -decodeLoadoutsAttributeBits = - LoadoutsAttribute - <$> decodeLoadoutAttributeBits - <*> decodeLoadoutAttributeBits diff --git a/src/lib/Rattletrap/Decode/LoadoutsOnlineAttribute.hs b/src/lib/Rattletrap/Decode/LoadoutsOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/LoadoutsOnlineAttribute.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Rattletrap.Decode.LoadoutsOnlineAttribute - ( decodeLoadoutsOnlineAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.LoadoutOnlineAttribute -import Rattletrap.Type.LoadoutsOnlineAttribute -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -import qualified Data.Map as Map - -decodeLoadoutsOnlineAttributeBits - :: (Int, Int, Int) - -> Map.Map Word32le Str - -> DecodeBits LoadoutsOnlineAttribute -decodeLoadoutsOnlineAttributeBits version objectMap = - LoadoutsOnlineAttribute - <$> decodeLoadoutOnlineAttributeBits version objectMap - <*> decodeLoadoutOnlineAttributeBits version objectMap - <*> getBool - <*> getBool diff --git a/src/lib/Rattletrap/Decode/LocationAttribute.hs b/src/lib/Rattletrap/Decode/LocationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/LocationAttribute.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.LocationAttribute - ( decodeLocationAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Vector -import Rattletrap.Type.LocationAttribute - -decodeLocationAttributeBits :: (Int, Int, Int) -> DecodeBits LocationAttribute -decodeLocationAttributeBits version = - LocationAttribute <$> decodeVectorBits version diff --git a/src/lib/Rattletrap/Decode/Mark.hs b/src/lib/Rattletrap/Decode/Mark.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Mark.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.Mark - ( decodeMark - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.Mark - -decodeMark :: Decode Mark -decodeMark = Mark <$> decodeStr <*> decodeWord32le diff --git a/src/lib/Rattletrap/Decode/Message.hs b/src/lib/Rattletrap/Decode/Message.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Message.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.Message - ( decodeMessage - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.Message - -decodeMessage :: Decode Message -decodeMessage = Message <$> decodeWord32le <*> decodeStr <*> decodeStr diff --git a/src/lib/Rattletrap/Decode/MusicStingerAttribute.hs b/src/lib/Rattletrap/Decode/MusicStingerAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/MusicStingerAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.MusicStingerAttribute - ( decodeMusicStingerAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Decode.Word8le -import Rattletrap.Type.MusicStingerAttribute - -decodeMusicStingerAttributeBits :: DecodeBits MusicStingerAttribute -decodeMusicStingerAttributeBits = - MusicStingerAttribute - <$> getBool - <*> decodeWord32leBits - <*> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/PartyLeaderAttribute.hs b/src/lib/Rattletrap/Decode/PartyLeaderAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PartyLeaderAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Decode.PartyLeaderAttribute - ( decodePartyLeaderAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.RemoteId -import Rattletrap.Decode.Word8le -import Rattletrap.Type.PartyLeaderAttribute -import Rattletrap.Type.Word8le - -decodePartyLeaderAttributeBits - :: (Int, Int, Int) -> DecodeBits PartyLeaderAttribute -decodePartyLeaderAttributeBits version = do - systemId <- decodeWord8leBits - PartyLeaderAttribute systemId <$> decodeWhen - (systemId /= Word8le 0) - ((,) <$> decodeRemoteIdBits version systemId <*> decodeWord8leBits) diff --git a/src/lib/Rattletrap/Decode/PickupAttribute.hs b/src/lib/Rattletrap/Decode/PickupAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PickupAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Decode.PickupAttribute - ( decodePickupAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Type.PickupAttribute - -decodePickupAttributeBits :: DecodeBits PickupAttribute -decodePickupAttributeBits = do - instigator <- getBool - PickupAttribute <$> decodeWhen instigator decodeWord32leBits <*> getBool diff --git a/src/lib/Rattletrap/Decode/PickupAttributeNew.hs b/src/lib/Rattletrap/Decode/PickupAttributeNew.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PickupAttributeNew.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.PickupAttributeNew - ( decodePickupAttributeNewBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word8le -import Rattletrap.Decode.Word32le -import Rattletrap.Type.PickupAttributeNew - -decodePickupAttributeNewBits :: DecodeBits PickupAttributeNew -decodePickupAttributeNewBits = do - instigator <- getBool - PickupAttributeNew - <$> decodeWhen instigator decodeWord32leBits - <*> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/PlayerHistoryKeyAttribute.hs b/src/lib/Rattletrap/Decode/PlayerHistoryKeyAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PlayerHistoryKeyAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.PlayerHistoryKeyAttribute - ( decodePlayerHistoryKeyAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.PlayerHistoryKeyAttribute - -decodePlayerHistoryKeyAttributeBits :: DecodeBits PlayerHistoryKeyAttribute -decodePlayerHistoryKeyAttributeBits = - PlayerHistoryKeyAttribute <$> getBitsLE 14 diff --git a/src/lib/Rattletrap/Decode/PrivateMatchSettingsAttribute.hs b/src/lib/Rattletrap/Decode/PrivateMatchSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PrivateMatchSettingsAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Decode.PrivateMatchSettingsAttribute - ( decodePrivateMatchSettingsAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word32le -import Rattletrap.Type.PrivateMatchSettingsAttribute - -decodePrivateMatchSettingsAttributeBits - :: DecodeBits PrivateMatchSettingsAttribute -decodePrivateMatchSettingsAttributeBits = - PrivateMatchSettingsAttribute - <$> decodeStrBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeStrBits - <*> decodeStrBits - <*> getBool diff --git a/src/lib/Rattletrap/Decode/ProductAttribute.hs b/src/lib/Rattletrap/Decode/ProductAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ProductAttribute.hs +++ /dev/null @@ -1,70 +0,0 @@ -module Rattletrap.Decode.ProductAttribute - ( decodeProductAttributesBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Decode.Word32le -import Rattletrap.Decode.Word8le -import Rattletrap.Decode.Str -import Rattletrap.Type.Common -import Rattletrap.Type.ProductAttribute -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le -import Rattletrap.Type.Word8le - -import qualified Control.Monad as Monad -import qualified Data.Map as Map - -decodeProductAttributesBits - :: (Int, Int, Int) -> Map Word32le Str -> DecodeBits [ProductAttribute] -decodeProductAttributesBits version objectMap = do - size <- decodeWord8leBits - Monad.replicateM - (fromIntegral (word8leValue size)) - (decodeProductAttributeBits version objectMap) - -decodeProductAttributeBits - :: (Int, Int, Int) -> Map Word32le Str -> DecodeBits ProductAttribute -decodeProductAttributeBits version objectMap = do - flag <- getBool - objectId <- decodeWord32leBits - let maybeObjectName = Map.lookup objectId objectMap - value <- case fromStr <$> maybeObjectName of - Just "TAGame.ProductAttribute_Painted_TA" -> decodePainted version - Just "TAGame.ProductAttribute_SpecialEdition_TA" -> decodeSpecialEdition - Just "TAGame.ProductAttribute_TeamEdition_TA" -> decodeTeamEdition version - Just "TAGame.ProductAttribute_TitleID_TA" -> decodeTitle - Just "TAGame.ProductAttribute_UserColor_TA" -> decodeColor version - Just objectName -> fail - ("[RT05] unknown object name " - <> show objectName - <> " for ID " - <> show objectId - ) - Nothing -> fail ("[RT06] missing object name for ID " <> show objectId) - pure (ProductAttribute flag objectId maybeObjectName value) - -decodeSpecialEdition :: DecodeBits ProductAttributeValue -decodeSpecialEdition = ProductAttributeValueSpecialEdition <$> getBitsLE 31 - -decodePainted :: (Int, Int, Int) -> DecodeBits ProductAttributeValue -decodePainted version = if version >= (868, 18, 0) - then ProductAttributeValuePaintedNew <$> getBitsLE 31 - else ProductAttributeValuePaintedOld <$> decodeCompressedWordBits 13 - -decodeTeamEdition :: (Int, Int, Int) -> DecodeBits ProductAttributeValue -decodeTeamEdition version = if version >= (868, 18, 0) - then ProductAttributeValueTeamEditionNew <$> getBitsLE 31 - else ProductAttributeValueTeamEditionOld <$> decodeCompressedWordBits 13 - -decodeColor :: (Int, Int, Int) -> DecodeBits ProductAttributeValue -decodeColor version = if version >= (868, 23, 8) - then ProductAttributeValueUserColorNew <$> decodeWord32leBits - else do - hasValue <- getBool - ProductAttributeValueUserColorOld <$> decodeWhen hasValue (getBitsLE 31) - -decodeTitle :: DecodeBits ProductAttributeValue -decodeTitle = ProductAttributeValueTitleId <$> decodeStrBits diff --git a/src/lib/Rattletrap/Decode/Property.hs b/src/lib/Rattletrap/Decode/Property.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Property.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Decode.Property - ( decodeProperty - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.PropertyValue -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word64le -import Rattletrap.Type.Property - -decodeProperty :: Decode Property -decodeProperty = do - kind <- decodeStr - Property kind <$> decodeWord64le <*> decodePropertyValue decodeProperty kind diff --git a/src/lib/Rattletrap/Decode/PropertyValue.hs b/src/lib/Rattletrap/Decode/PropertyValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/PropertyValue.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.Decode.PropertyValue - ( decodePropertyValue - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Dictionary -import Rattletrap.Decode.Float32le -import Rattletrap.Decode.Int32le -import Rattletrap.Decode.List -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word64le -import Rattletrap.Decode.Word8le -import Rattletrap.Type.PropertyValue -import Rattletrap.Type.Str - -decodePropertyValue :: Decode a -> Str -> Decode (PropertyValue a) -decodePropertyValue getProperty kind = case fromStr kind of - "ArrayProperty" -> - PropertyValueArray <$> decodeList (decodeDictionary getProperty) - "BoolProperty" -> PropertyValueBool <$> decodeWord8le - "ByteProperty" -> do - k <- decodeStr - PropertyValueByte k - <$> decodeWhen (fromStr k /= "OnlinePlatform_Steam") decodeStr - "FloatProperty" -> PropertyValueFloat <$> decodeFloat32le - "IntProperty" -> PropertyValueInt <$> decodeInt32le - "NameProperty" -> PropertyValueName <$> decodeStr - "QWordProperty" -> PropertyValueQWord <$> decodeWord64le - "StrProperty" -> PropertyValueStr <$> decodeStr - _ -> fail ("[RT07] don't know how to read property value " <> show kind) diff --git a/src/lib/Rattletrap/Decode/QWordAttribute.hs b/src/lib/Rattletrap/Decode/QWordAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/QWordAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.QWordAttribute - ( decodeQWordAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word64le -import Rattletrap.Type.QWordAttribute - -decodeQWordAttributeBits :: DecodeBits QWordAttribute -decodeQWordAttributeBits = QWordAttribute <$> decodeWord64leBits diff --git a/src/lib/Rattletrap/Decode/Quaternion.hs b/src/lib/Rattletrap/Decode/Quaternion.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Quaternion.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.Decode.Quaternion - ( decodeQuaternionBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Quaternion - -decodeQuaternionBits :: DecodeBits Quaternion -decodeQuaternionBits = - toQuaternion <$> decodeComponent <*> decodePart <*> decodePart <*> decodePart - -decodeComponent :: DecodeBits Component -decodeComponent = do - x <- decodeCompressedWordBits 3 - case compressedWordValue x of - 0 -> pure ComponentX - 1 -> pure ComponentY - 2 -> pure ComponentZ - 3 -> pure ComponentW - y -> fail ("[RT08] invalid component: " <> show y) - -decodePart :: DecodeBits Double -decodePart = decompressPart <$> decodeCompressedWordBits maxCompressedValue diff --git a/src/lib/Rattletrap/Decode/RemoteId.hs b/src/lib/Rattletrap/Decode/RemoteId.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/RemoteId.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Rattletrap.Decode.RemoteId - ( decodeRemoteIdBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Decode.Word64le -import Rattletrap.Type.RemoteId -import Rattletrap.Type.Word64le -import Rattletrap.Type.Word8le -import Rattletrap.Utility.Bytes - -import qualified Data.ByteString as Bytes -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Word as Word - -decodeRemoteIdBits :: (Int, Int, Int) -> Word8le -> DecodeBits RemoteId -decodeRemoteIdBits version systemId = case word8leValue systemId of - 0 -> RemoteIdSplitscreen <$> getBitsLE 24 - 1 -> RemoteIdSteam <$> decodeWord64leBits - 2 -> RemoteIdPlayStation <$> decodePsName <*> decodePsBytes version - 4 -> RemoteIdXbox <$> decodeWord64leBits - 6 -> do - (a, b, c, d) <- getWord256 - pure $ RemoteIdSwitch a b c d - 7 -> if version >= (868, 24, 10) - then RemoteIdPsyNet . Left <$> decodeWord64leBits - else RemoteIdPsyNet . Right <$> getWord256 - 11 -> RemoteIdEpic <$> decodeStrBits - _ -> fail ("[RT09] unknown system id " <> show systemId) - -decodePsName :: DecodeBits Text.Text -decodePsName = fmap - (Text.dropWhileEnd (== '\x00') . Text.decodeLatin1 . reverseBytes) - (getByteStringBits 16) - -decodePsBytes :: (Int, Int, Int) -> DecodeBits [Word.Word8] -decodePsBytes version = Bytes.unpack - <$> getByteStringBits (if version >= (868, 20, 1) then 24 else 16) - -getWord256 :: DecodeBits (Word64le, Word64le, Word64le, Word64le) -getWord256 = do - a <- decodeWord64leBits - b <- decodeWord64leBits - c <- decodeWord64leBits - d <- decodeWord64leBits - pure (a, b, c, d) diff --git a/src/lib/Rattletrap/Decode/Replay.hs b/src/lib/Rattletrap/Decode/Replay.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Replay.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Rattletrap.Decode.Replay - ( decodeReplay - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Content -import Rattletrap.Decode.Header -import Rattletrap.Decode.Section -import Rattletrap.Encode.Content -import Rattletrap.Type.Content -import Rattletrap.Type.Dictionary -import Rattletrap.Type.Header -import Rattletrap.Type.Int32le -import Rattletrap.Type.Property -import Rattletrap.Type.PropertyValue -import Rattletrap.Type.Replay -import Rattletrap.Type.Section -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -decodeReplay :: Bool -> Decode FullReplay -decodeReplay fast = do - header <- decodeSection decodeHeader - content <- if fast - then pure $ toSection putContent defaultContent - else - let body = sectionBody header - in - decodeSection $ decodeContent - (getVersion body) - (getNumFrames body) - (getMaxChannels body) - pure $ Replay header content - -getVersion :: Header -> (Int, Int, Int) -getVersion header = - ( fromIntegral (word32leValue (headerEngineVersion header)) - , fromIntegral (word32leValue (headerLicenseeVersion header)) - , getPatchVersion header - ) - -getPatchVersion :: Header -> Int -getPatchVersion header = case headerPatchVersion header of - Just version -> fromIntegral (word32leValue version) - Nothing -> - case dictionaryLookup (toStr "MatchType") (headerProperties header) of - -- This is an ugly, ugly hack to handle replays from season 2 of RLCS. - -- See `decodeSpawnedReplicationBits` and #85. - Just Property { propertyValue = PropertyValueName str } - | fromStr str == "Lan" -> -1 - _ -> 0 - -getNumFrames :: Header -> Int -getNumFrames header = - case dictionaryLookup (toStr "NumFrames") (headerProperties header) of - Just (Property _ _ (PropertyValueInt numFrames)) -> - fromIntegral (int32leValue numFrames) - _ -> 0 - -getMaxChannels :: Header -> Word -getMaxChannels header = - case dictionaryLookup (toStr "MaxChannels") (headerProperties header) of - Just (Property _ _ (PropertyValueInt numFrames)) -> - fromIntegral (int32leValue numFrames) - _ -> 1023 diff --git a/src/lib/Rattletrap/Decode/Replication.hs b/src/lib/Rattletrap/Decode/Replication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Replication.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Rattletrap.Decode.Replication - ( decodeReplicationsBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Decode.ReplicationValue -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Replication -import Rattletrap.Type.Word32le - -import qualified Control.Monad.Trans.Class as Trans -import qualified Control.Monad.Trans.State as State -import qualified Data.Map as Map - -decodeReplicationsBits - :: (Int, Int, Int) - -> Word - -> ClassAttributeMap - -> State.StateT - (Map.Map CompressedWord Word32le) - DecodeBits - [Replication] -decodeReplicationsBits version limit classes = do - hasReplication <- Trans.lift getBool - if hasReplication - then - (:) - <$> decodeReplicationBits version limit classes - <*> decodeReplicationsBits version limit classes - else pure [] - -decodeReplicationBits - :: (Int, Int, Int) - -> Word - -> ClassAttributeMap - -> State.StateT - (Map.Map CompressedWord Word32le) - DecodeBits - Replication -decodeReplicationBits version limit classes = do - actor <- Trans.lift (decodeCompressedWordBits limit) - Replication actor <$> decodeReplicationValueBits version classes actor diff --git a/src/lib/Rattletrap/Decode/ReplicationValue.hs b/src/lib/Rattletrap/Decode/ReplicationValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ReplicationValue.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Rattletrap.Decode.ReplicationValue - ( decodeReplicationValueBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.DestroyedReplication -import Rattletrap.Decode.SpawnedReplication -import Rattletrap.Decode.UpdatedReplication -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.ReplicationValue -import Rattletrap.Type.Word32le - -import qualified Control.Monad.Trans.Class as Trans -import qualified Control.Monad.Trans.State as State -import qualified Data.Map as Map - -decodeReplicationValueBits - :: (Int, Int, Int) - -> ClassAttributeMap - -> CompressedWord - -> State.StateT - (Map.Map CompressedWord Word32le) - DecodeBits - ReplicationValue -decodeReplicationValueBits version classAttributeMap actorId = do - actorMap <- State.get - isOpen <- Trans.lift getBool - if isOpen - then do - isNew <- Trans.lift getBool - if isNew - then - ReplicationValueSpawned - <$> decodeSpawnedReplicationBits version classAttributeMap actorId - else ReplicationValueUpdated <$> Trans.lift - (decodeUpdatedReplicationBits - version - classAttributeMap - actorMap - actorId - ) - else ReplicationValueDestroyed - <$> Trans.lift decodeDestroyedReplicationBits diff --git a/src/lib/Rattletrap/Decode/ReservationAttribute.hs b/src/lib/Rattletrap/Decode/ReservationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/ReservationAttribute.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Rattletrap.Decode.ReservationAttribute - ( decodeReservationAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Decode.Str -import Rattletrap.Decode.UniqueIdAttribute -import Rattletrap.Type.ReservationAttribute -import Rattletrap.Type.UniqueIdAttribute -import Rattletrap.Type.Word8le - -decodeReservationAttributeBits - :: (Int, Int, Int) -> DecodeBits ReservationAttribute -decodeReservationAttributeBits version = do - number <- decodeCompressedWordBits 7 - uniqueId <- decodeUniqueIdAttributeBits version - ReservationAttribute number uniqueId - <$> decodeWhen - (uniqueIdAttributeSystemId uniqueId /= Word8le 0) - decodeStrBits - <*> getBool - <*> getBool - <*> decodeWhen (version >= (868, 12, 0)) (getWord8Bits 6) diff --git a/src/lib/Rattletrap/Decode/RigidBodyStateAttribute.hs b/src/lib/Rattletrap/Decode/RigidBodyStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/RigidBodyStateAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Decode.RigidBodyStateAttribute - ( decodeRigidBodyStateAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Rotation -import Rattletrap.Decode.Vector -import Rattletrap.Type.RigidBodyStateAttribute - -decodeRigidBodyStateAttributeBits - :: (Int, Int, Int) -> DecodeBits RigidBodyStateAttribute -decodeRigidBodyStateAttributeBits version = do - sleeping <- getBool - RigidBodyStateAttribute sleeping - <$> decodeVectorBits version - <*> decodeRotationBits version - <*> decodeWhen (not sleeping) (decodeVectorBits version) - <*> decodeWhen (not sleeping) (decodeVectorBits version) diff --git a/src/lib/Rattletrap/Decode/Rotation.hs b/src/lib/Rattletrap/Decode/Rotation.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Rotation.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Rotation - ( decodeRotationBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWordVector -import Rattletrap.Decode.Quaternion -import Rattletrap.Type.Rotation - -decodeRotationBits :: (Int, Int, Int) -> DecodeBits Rotation -decodeRotationBits version = if version >= (868, 22, 7) - then RotationQuaternion <$> decodeQuaternionBits - else RotationCompressedWordVector <$> decodeCompressedWordVectorBits diff --git a/src/lib/Rattletrap/Decode/Section.hs b/src/lib/Rattletrap/Decode/Section.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Section.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Rattletrap.Decode.Section - ( decodeSection - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Type.Section -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Crc - -import qualified Control.Monad as Monad - -decodeSection :: Decode a -> Decode (Section a) -decodeSection getBody = do - size <- decodeWord32le - crc <- decodeWord32le - rawBody <- getByteString (fromIntegral (word32leValue size)) - let actualCrc = Word32le (getCrc32 rawBody) - Monad.when (actualCrc /= crc) (fail (crcMessage actualCrc crc)) - body <- either fail pure (runDecode getBody rawBody) - pure (Section size crc body) - -crcMessage :: Word32le -> Word32le -> String -crcMessage actual expected = unwords - [ "[RT10] actual CRC" - , show actual - , "does not match expected CRC" - , show expected - ] diff --git a/src/lib/Rattletrap/Decode/SpawnedReplication.hs b/src/lib/Rattletrap/Decode/SpawnedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/SpawnedReplication.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Rattletrap.Decode.SpawnedReplication - ( decodeSpawnedReplicationBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Initialization -import Rattletrap.Decode.Word32le -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.SpawnedReplication -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -import qualified Control.Monad.Trans.Class as Trans -import qualified Control.Monad.Trans.State as State -import qualified Data.Map as Map - -decodeSpawnedReplicationBits - :: (Int, Int, Int) - -> ClassAttributeMap - -> CompressedWord - -> State.StateT - (Map.Map CompressedWord Word32le) - DecodeBits - SpawnedReplication -decodeSpawnedReplicationBits version classAttributeMap actorId = do - flag <- Trans.lift getBool - nameIndex <- decodeWhen - (version >= (868, 14, 0)) - (Trans.lift decodeWord32leBits) - name <- either fail pure (lookupName classAttributeMap nameIndex) - objectId <- Trans.lift decodeWord32leBits - State.modify (Map.insert actorId objectId) - objectName <- either fail pure (lookupObjectName classAttributeMap objectId) - className <- either fail pure (lookupClassName objectName) - let hasLocation = classHasLocation className - let hasRotation = classHasRotation className - initialization <- Trans.lift - (decodeInitializationBits version hasLocation hasRotation) - pure - (SpawnedReplication - flag - nameIndex - name - objectId - objectName - className - initialization - ) - -lookupName :: ClassAttributeMap -> Maybe Word32le -> Either String (Maybe Str) -lookupName classAttributeMap maybeNameIndex = case maybeNameIndex of - Nothing -> Right Nothing - Just nameIndex -> - case getName (classAttributeMapNameMap classAttributeMap) nameIndex of - Nothing -> - Left ("[RT11] could not get name for index " <> show nameIndex) - Just name -> Right (Just name) - -lookupObjectName :: ClassAttributeMap -> Word32le -> Either String Str -lookupObjectName classAttributeMap objectId = - case getObjectName (classAttributeMapObjectMap classAttributeMap) objectId of - Nothing -> - Left ("[RT12] could not get object name for id " <> show objectId) - Just objectName -> Right objectName - -lookupClassName :: Str -> Either String Str -lookupClassName objectName = case getClassName objectName of - Nothing -> - Left ("[RT13] could not get class name for object " <> show objectName) - Just className -> Right className diff --git a/src/lib/Rattletrap/Decode/StatEventAttribute.hs b/src/lib/Rattletrap/Decode/StatEventAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/StatEventAttribute.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Decode.StatEventAttribute - ( decodeStatEventAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Type.StatEventAttribute - -decodeStatEventAttributeBits :: DecodeBits StatEventAttribute -decodeStatEventAttributeBits = - StatEventAttribute <$> getBool <*> decodeInt32leBits diff --git a/src/lib/Rattletrap/Decode/Str.hs b/src/lib/Rattletrap/Decode/Str.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Str.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Rattletrap.Decode.Str - ( decodeStr - , decodeStrBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Int32le -import Rattletrap.Type.Int32le -import Rattletrap.Type.Str -import Rattletrap.Utility.Bytes - -import qualified Data.ByteString as Bytes -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import qualified Data.Text.Encoding.Error as Text -import qualified Debug.Trace as Debug - -decodeStr :: Decode Str -decodeStr = do - rawSize <- decodeInt32le - bytes <- getByteString (normalizeTextSize rawSize) - pure (Str (dropNull (getTextDecoder rawSize bytes))) - -decodeStrBits :: DecodeBits Str -decodeStrBits = do - rawSize <- decodeInt32leBits - bytes <- getByteStringBits (normalizeTextSize rawSize) - pure (Str (dropNull (getTextDecoder rawSize (reverseBytes bytes)))) - -normalizeTextSize :: Integral a => Int32le -> a -normalizeTextSize size = case int32leValue size of - 0x05000000 -> 8 - x -> if x < 0 then (-2 * fromIntegral x) else fromIntegral x - -getTextDecoder :: Int32le -> Bytes.ByteString -> Text.Text -getTextDecoder size bytes = - let - decode = if size < Int32le 0 - then Text.decodeUtf16LEWith $ \message input -> do - Debug.traceM $ "WARNING: " <> show (Text.DecodeError message input) - Text.lenientDecode message input - else Text.decodeLatin1 - in decode bytes - -dropNull :: Text.Text -> Text.Text -dropNull = Text.dropWhileEnd (== '\x00') diff --git a/src/lib/Rattletrap/Decode/StringAttribute.hs b/src/lib/Rattletrap/Decode/StringAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/StringAttribute.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Decode.StringAttribute - ( decodeStringAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Str -import Rattletrap.Type.StringAttribute - -decodeStringAttributeBits :: DecodeBits StringAttribute -decodeStringAttributeBits = StringAttribute <$> decodeStrBits diff --git a/src/lib/Rattletrap/Decode/TeamPaintAttribute.hs b/src/lib/Rattletrap/Decode/TeamPaintAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/TeamPaintAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Decode.TeamPaintAttribute - ( decodeTeamPaintAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Decode.Word8le -import Rattletrap.Type.TeamPaintAttribute - -decodeTeamPaintAttributeBits :: DecodeBits TeamPaintAttribute -decodeTeamPaintAttributeBits = - TeamPaintAttribute - <$> decodeWord8leBits - <*> decodeWord8leBits - <*> decodeWord8leBits - <*> decodeWord32leBits - <*> decodeWord32leBits diff --git a/src/lib/Rattletrap/Decode/TitleAttribute.hs b/src/lib/Rattletrap/Decode/TitleAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/TitleAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Decode.TitleAttribute - ( decodeTitleAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Word32le -import Rattletrap.Type.TitleAttribute - -decodeTitleAttributeBits :: DecodeBits TitleAttribute -decodeTitleAttributeBits = - TitleAttribute - <$> getBool - <*> getBool - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> decodeWord32leBits - <*> getBool diff --git a/src/lib/Rattletrap/Decode/UniqueIdAttribute.hs b/src/lib/Rattletrap/Decode/UniqueIdAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/UniqueIdAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Decode.UniqueIdAttribute - ( decodeUniqueIdAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.RemoteId -import Rattletrap.Decode.Word8le -import Rattletrap.Type.UniqueIdAttribute - -decodeUniqueIdAttributeBits :: (Int, Int, Int) -> DecodeBits UniqueIdAttribute -decodeUniqueIdAttributeBits version = do - systemId <- decodeWord8leBits - UniqueIdAttribute systemId - <$> decodeRemoteIdBits version systemId - <*> decodeWord8leBits diff --git a/src/lib/Rattletrap/Decode/UpdatedReplication.hs b/src/lib/Rattletrap/Decode/UpdatedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/UpdatedReplication.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.Decode.UpdatedReplication - ( decodeUpdatedReplicationBits - ) -where - -import Rattletrap.Decode.Attribute -import Rattletrap.Decode.Common -import Rattletrap.Type.ClassAttributeMap -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.UpdatedReplication -import Rattletrap.Type.Word32le - -import qualified Data.Map as Map - -decodeUpdatedReplicationBits - :: (Int, Int, Int) - -> ClassAttributeMap - -> Map.Map CompressedWord Word32le - -> CompressedWord - -> DecodeBits UpdatedReplication -decodeUpdatedReplicationBits version classes actors actor = - UpdatedReplication <$> decodeAttributesBits version classes actors actor diff --git a/src/lib/Rattletrap/Decode/Vector.hs b/src/lib/Rattletrap/Decode/Vector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Vector.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Rattletrap.Decode.Vector - ( decodeVectorBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.CompressedWord -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Vector - -decodeVectorBits :: (Int, Int, Int) -> DecodeBits Vector -decodeVectorBits version = do - size <- decodeCompressedWordBits (if version >= (868, 22, 7) then 21 else 19) - let - limit = getLimit size - bias = getBias size - Vector size bias - <$> fmap (fromDelta bias) (decodeCompressedWordBits limit) - <*> fmap (fromDelta bias) (decodeCompressedWordBits limit) - <*> fmap (fromDelta bias) (decodeCompressedWordBits limit) - -getLimit :: CompressedWord -> Word -getLimit = (2 ^) . (+ 2) . compressedWordValue - -getBias :: CompressedWord -> Word -getBias = (2 ^) . (+ 1) . compressedWordValue - -fromDelta :: Word -> CompressedWord -> Int -fromDelta bias x = fromIntegral (compressedWordValue x) - fromIntegral bias diff --git a/src/lib/Rattletrap/Decode/WeldedInfoAttribute.hs b/src/lib/Rattletrap/Decode/WeldedInfoAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/WeldedInfoAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Decode.WeldedInfoAttribute - ( decodeWeldedInfoAttributeBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Decode.Float32le -import Rattletrap.Decode.Int32le -import Rattletrap.Decode.Int8Vector -import Rattletrap.Decode.Vector -import Rattletrap.Type.WeldedInfoAttribute - -decodeWeldedInfoAttributeBits - :: (Int, Int, Int) -> DecodeBits WeldedInfoAttribute -decodeWeldedInfoAttributeBits version = - WeldedInfoAttribute - <$> getBool - <*> decodeInt32leBits - <*> decodeVectorBits version - <*> decodeFloat32leBits - <*> decodeInt8VectorBits diff --git a/src/lib/Rattletrap/Decode/Word32le.hs b/src/lib/Rattletrap/Decode/Word32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Word32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Word32le - ( decodeWord32le - , decodeWord32leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Word32le - -decodeWord32le :: Decode Word32le -decodeWord32le = Word32le <$> getWord32le - -decodeWord32leBits :: DecodeBits Word32le -decodeWord32leBits = toBits decodeWord32le 4 diff --git a/src/lib/Rattletrap/Decode/Word64le.hs b/src/lib/Rattletrap/Decode/Word64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Word64le.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Word64le - ( decodeWord64le - , decodeWord64leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Word64le - -decodeWord64le :: Decode Word64le -decodeWord64le = Word64le <$> getWord64le - -decodeWord64leBits :: DecodeBits Word64le -decodeWord64leBits = toBits decodeWord64le 8 diff --git a/src/lib/Rattletrap/Decode/Word8le.hs b/src/lib/Rattletrap/Decode/Word8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Decode/Word8le.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Decode.Word8le - ( decodeWord8le - , decodeWord8leBits - ) -where - -import Rattletrap.Decode.Common -import Rattletrap.Type.Word8le - -decodeWord8le :: Decode Word8le -decodeWord8le = Word8le <$> getWord8 - -decodeWord8leBits :: DecodeBits Word8le -decodeWord8leBits = toBits decodeWord8le 1 diff --git a/src/lib/Rattletrap/Encode/AppliedDamageAttribute.hs b/src/lib/Rattletrap/Encode/AppliedDamageAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/AppliedDamageAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Encode.AppliedDamageAttribute - ( putAppliedDamageAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Encode.Vector -import Rattletrap.Encode.Word8le -import Rattletrap.Type.AppliedDamageAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putAppliedDamageAttribute :: AppliedDamageAttribute -> BinaryBits.BitPut () -putAppliedDamageAttribute appliedDamageAttribute = do - putWord8Bits (appliedDamageAttributeUnknown1 appliedDamageAttribute) - putVector (appliedDamageAttributeLocation appliedDamageAttribute) - putInt32Bits (appliedDamageAttributeUnknown3 appliedDamageAttribute) - putInt32Bits (appliedDamageAttributeUnknown4 appliedDamageAttribute) diff --git a/src/lib/Rattletrap/Encode/Attribute.hs b/src/lib/Rattletrap/Encode/Attribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Attribute.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.Encode.Attribute - ( putAttributes - ) -where - -import Rattletrap.Encode.AttributeValue -import Rattletrap.Encode.CompressedWord -import Rattletrap.Type.Attribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putAttributes :: [Attribute] -> BinaryBits.BitPut () -putAttributes attributes = case attributes of - [] -> BinaryBits.putBool False - [attribute] -> do - putAttribute attribute - BinaryBits.putBool False - first : rest -> do - putAttribute first - putAttributes rest - -putAttribute :: Attribute -> BinaryBits.BitPut () -putAttribute attribute = do - BinaryBits.putBool True - putCompressedWord (attributeId attribute) - putAttributeValue (attributeValue attribute) diff --git a/src/lib/Rattletrap/Encode/AttributeMapping.hs b/src/lib/Rattletrap/Encode/AttributeMapping.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/AttributeMapping.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.AttributeMapping - ( putAttributeMapping - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Type.AttributeMapping - -import qualified Data.Binary as Binary - -putAttributeMapping :: AttributeMapping -> Binary.Put -putAttributeMapping attributeMapping = do - putWord32 (attributeMappingObjectId attributeMapping) - putWord32 (attributeMappingStreamId attributeMapping) diff --git a/src/lib/Rattletrap/Encode/AttributeValue.hs b/src/lib/Rattletrap/Encode/AttributeValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/AttributeValue.hs +++ /dev/null @@ -1,85 +0,0 @@ -module Rattletrap.Encode.AttributeValue - ( putAttributeValue - ) -where - -import Rattletrap.Encode.AppliedDamageAttribute -import Rattletrap.Encode.BooleanAttribute -import Rattletrap.Encode.ByteAttribute -import Rattletrap.Encode.CamSettingsAttribute -import Rattletrap.Encode.ClubColorsAttribute -import Rattletrap.Encode.CustomDemolishAttribute -import Rattletrap.Encode.DamageStateAttribute -import Rattletrap.Encode.DemolishAttribute -import Rattletrap.Encode.EnumAttribute -import Rattletrap.Encode.ExplosionAttribute -import Rattletrap.Encode.ExtendedExplosionAttribute -import Rattletrap.Encode.FlaggedIntAttribute -import Rattletrap.Encode.FlaggedByteAttribute -import Rattletrap.Encode.FloatAttribute -import Rattletrap.Encode.GameModeAttribute -import Rattletrap.Encode.Int64Attribute -import Rattletrap.Encode.IntAttribute -import Rattletrap.Encode.LoadoutAttribute -import Rattletrap.Encode.LoadoutOnlineAttribute -import Rattletrap.Encode.LoadoutsAttribute -import Rattletrap.Encode.LoadoutsOnlineAttribute -import Rattletrap.Encode.LocationAttribute -import Rattletrap.Encode.MusicStingerAttribute -import Rattletrap.Encode.PartyLeaderAttribute -import Rattletrap.Encode.PickupAttribute -import Rattletrap.Encode.PickupAttributeNew -import Rattletrap.Encode.PlayerHistoryKeyAttribute -import Rattletrap.Encode.PrivateMatchSettingsAttribute -import Rattletrap.Encode.QWordAttribute -import Rattletrap.Encode.ReservationAttribute -import Rattletrap.Encode.RigidBodyStateAttribute -import Rattletrap.Encode.StatEventAttribute -import Rattletrap.Encode.StringAttribute -import Rattletrap.Encode.TeamPaintAttribute -import Rattletrap.Encode.TitleAttribute -import Rattletrap.Encode.UniqueIdAttribute -import Rattletrap.Encode.WeldedInfoAttribute -import Rattletrap.Type.AttributeValue - -import qualified Data.Binary.Bits.Put as BinaryBits - -putAttributeValue :: AttributeValue -> BinaryBits.BitPut () -putAttributeValue value = case value of - AttributeValueAppliedDamage x -> putAppliedDamageAttribute x - AttributeValueBoolean x -> putBooleanAttribute x - AttributeValueByte x -> putByteAttribute x - AttributeValueCamSettings x -> putCamSettingsAttribute x - AttributeValueClubColors x -> putClubColorsAttribute x - AttributeValueCustomDemolish x -> putCustomDemolishAttribute x - AttributeValueDamageState x -> putDamageStateAttribute x - AttributeValueDemolish x -> putDemolishAttribute x - AttributeValueEnum x -> putEnumAttribute x - AttributeValueExplosion x -> putExplosionAttribute x - AttributeValueExtendedExplosion x -> putExtendedExplosionAttribute x - AttributeValueFlaggedInt x -> putFlaggedIntAttribute x - AttributeValueFlaggedByte x -> putFlaggedByteAttribute x - AttributeValueFloat x -> putFloatAttribute x - AttributeValueGameMode x -> putGameModeAttribute x - AttributeValueInt x -> putIntAttribute x - AttributeValueInt64 x -> putInt64Attribute x - AttributeValueLoadout x -> putLoadoutAttribute x - AttributeValueLoadoutOnline x -> putLoadoutOnlineAttribute x - AttributeValueLoadouts x -> putLoadoutsAttribute x - AttributeValueLoadoutsOnline x -> putLoadoutsOnlineAttribute x - AttributeValueLocation x -> putLocationAttribute x - AttributeValueMusicStinger x -> putMusicStingerAttribute x - AttributeValuePartyLeader x -> putPartyLeaderAttribute x - AttributeValuePickup x -> putPickupAttribute x - AttributeValuePickupNew x -> putPickupAttributeNew x - AttributeValuePlayerHistoryKey x -> putPlayerHistoryKeyAttribute x - AttributeValuePrivateMatchSettings x -> putPrivateMatchSettingsAttribute x - AttributeValueQWord x -> putQWordAttribute x - AttributeValueReservation x -> putReservationAttribute x - AttributeValueRigidBodyState x -> putRigidBodyStateAttribute x - AttributeValueStatEvent x -> putStatEventAttribute x - AttributeValueString x -> putStringAttribute x - AttributeValueTeamPaint x -> putTeamPaintAttribute x - AttributeValueTitle x -> putTitleAttribute x - AttributeValueUniqueId x -> putUniqueIdAttribute x - AttributeValueWeldedInfo x -> putWeldedInfoAttribute x diff --git a/src/lib/Rattletrap/Encode/BooleanAttribute.hs b/src/lib/Rattletrap/Encode/BooleanAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/BooleanAttribute.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Encode.BooleanAttribute - ( putBooleanAttribute - ) -where - -import Rattletrap.Type.BooleanAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putBooleanAttribute :: BooleanAttribute -> BinaryBits.BitPut () -putBooleanAttribute booleanAttribute = - BinaryBits.putBool (booleanAttributeValue booleanAttribute) diff --git a/src/lib/Rattletrap/Encode/ByteAttribute.hs b/src/lib/Rattletrap/Encode/ByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ByteAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.ByteAttribute - ( putByteAttribute - ) -where - -import Rattletrap.Encode.Word8le -import Rattletrap.Type.ByteAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putByteAttribute :: ByteAttribute -> BinaryBits.BitPut () -putByteAttribute byteAttribute = - putWord8Bits (byteAttributeValue byteAttribute) diff --git a/src/lib/Rattletrap/Encode/Cache.hs b/src/lib/Rattletrap/Encode/Cache.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Cache.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Encode.Cache - ( putCache - ) -where - -import Rattletrap.Encode.AttributeMapping -import Rattletrap.Encode.List -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Cache - -import qualified Data.Binary as Binary - -putCache :: Cache -> Binary.Put -putCache cache = do - putWord32 (cacheClassId cache) - putWord32 (cacheParentCacheId cache) - putWord32 (cacheCacheId cache) - putList putAttributeMapping (cacheAttributeMappings cache) diff --git a/src/lib/Rattletrap/Encode/CamSettingsAttribute.hs b/src/lib/Rattletrap/Encode/CamSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/CamSettingsAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.CamSettingsAttribute - ( putCamSettingsAttribute - ) -where - -import Rattletrap.Encode.Float32le -import Rattletrap.Type.CamSettingsAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putCamSettingsAttribute :: CamSettingsAttribute -> BinaryBits.BitPut () -putCamSettingsAttribute camSettingsAttribute = do - putFloat32Bits (camSettingsAttributeFov camSettingsAttribute) - putFloat32Bits (camSettingsAttributeHeight camSettingsAttribute) - putFloat32Bits (camSettingsAttributeAngle camSettingsAttribute) - putFloat32Bits (camSettingsAttributeDistance camSettingsAttribute) - putFloat32Bits (camSettingsAttributeStiffness camSettingsAttribute) - putFloat32Bits (camSettingsAttributeSwivelSpeed camSettingsAttribute) - case camSettingsAttributeTransitionSpeed camSettingsAttribute of - Nothing -> pure () - Just transitionSpeed -> putFloat32Bits transitionSpeed diff --git a/src/lib/Rattletrap/Encode/ClassMapping.hs b/src/lib/Rattletrap/Encode/ClassMapping.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ClassMapping.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Encode.ClassMapping - ( putClassMapping - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.ClassMapping - -import qualified Data.Binary as Binary - -putClassMapping :: ClassMapping -> Binary.Put -putClassMapping classMapping = do - putText (classMappingName classMapping) - putWord32 (classMappingStreamId classMapping) diff --git a/src/lib/Rattletrap/Encode/ClubColorsAttribute.hs b/src/lib/Rattletrap/Encode/ClubColorsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ClubColorsAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.ClubColorsAttribute - ( putClubColorsAttribute - ) -where - -import Rattletrap.Encode.Word8le -import Rattletrap.Type.ClubColorsAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putClubColorsAttribute :: ClubColorsAttribute -> BinaryBits.BitPut () -putClubColorsAttribute clubColorsAttribute = do - BinaryBits.putBool (clubColorsAttributeBlueFlag clubColorsAttribute) - putWord8Bits (clubColorsAttributeBlueColor clubColorsAttribute) - BinaryBits.putBool (clubColorsAttributeOrangeFlag clubColorsAttribute) - putWord8Bits (clubColorsAttributeOrangeColor clubColorsAttribute) diff --git a/src/lib/Rattletrap/Encode/Common.hs b/src/lib/Rattletrap/Encode/Common.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Common.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Rattletrap.Encode.Common - ( putBitsLE - ) -where - -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Bits as Bits - -putBitsLE :: Bits.Bits a => Int -> a -> BinaryBits.BitPut () -putBitsLE size x = mapM_ (BinaryBits.putBool . Bits.testBit x) [0 .. size - 1] diff --git a/src/lib/Rattletrap/Encode/CompressedWord.hs b/src/lib/Rattletrap/Encode/CompressedWord.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/CompressedWord.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Rattletrap.Encode.CompressedWord - ( putCompressedWord - ) -where - -import Rattletrap.Type.CompressedWord - -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Bits as Bits - -putCompressedWord :: CompressedWord -> BinaryBits.BitPut () -putCompressedWord compressedWord = - let - limit = compressedWordLimit compressedWord - value = compressedWordValue compressedWord - maxBits = getMaxBits limit - in putCompressedWordStep limit value maxBits 0 0 - -putCompressedWordStep - :: Word -> Word -> Int -> Int -> Word -> BinaryBits.BitPut () -putCompressedWordStep limit value maxBits position soFar = - if position < maxBits - then do - let x = Bits.shiftL 1 position :: Word - if maxBits > 1 && position == maxBits - 1 && soFar + x > limit - then pure () - else do - let bit = Bits.testBit value position - BinaryBits.putBool bit - let delta = if bit then x else 0 - putCompressedWordStep - limit - value - maxBits - (position + 1) - (soFar + delta) - else pure () - -getMaxBits :: Word -> Int -getMaxBits x = - let - n :: Int - n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) - in if x < 1024 && x == 2 ^ n then n + 1 else n diff --git a/src/lib/Rattletrap/Encode/CompressedWordVector.hs b/src/lib/Rattletrap/Encode/CompressedWordVector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/CompressedWordVector.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Encode.CompressedWordVector - ( putCompressedWordVector - ) -where - -import Rattletrap.Encode.CompressedWord -import Rattletrap.Type.CompressedWordVector - -import qualified Data.Binary.Bits.Put as BinaryBits - -putCompressedWordVector :: CompressedWordVector -> BinaryBits.BitPut () -putCompressedWordVector compressedWordVector = do - putCompressedWord (compressedWordVectorX compressedWordVector) - putCompressedWord (compressedWordVectorY compressedWordVector) - putCompressedWord (compressedWordVectorZ compressedWordVector) diff --git a/src/lib/Rattletrap/Encode/Content.hs b/src/lib/Rattletrap/Encode/Content.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Content.hs +++ /dev/null @@ -1,58 +0,0 @@ -module Rattletrap.Encode.Content - ( putContent - ) -where - -import Rattletrap.Encode.Cache -import Rattletrap.Encode.ClassMapping -import Rattletrap.Encode.Frame -import Rattletrap.Encode.KeyFrame -import Rattletrap.Encode.List -import Rattletrap.Encode.Mark -import Rattletrap.Encode.Message -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Content -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as LazyBytes - -putContent :: Content -> Binary.Put -putContent content = do - putList putText (contentLevels content) - putList putKeyFrame (contentKeyFrames content) - let - stream = LazyBytes.toStrict - (Binary.runPut (BinaryBits.runBitPut (putFrames (contentFrames content))) - ) - -- This is a little strange. When parsing a binary replay, the stream size - -- is given before the stream itself. When generating the JSON, the stream - -- size is included. That allows a bit-for-bit identical binary replay to - -- be generated from the JSON. However if you modify the JSON before - -- converting it back into binary, the stream size might be different. - -- - -- If it was possible to know how much padding the stream required without - -- carrying it along as extra data on the side, this logic could go away. - -- Unforunately that isn't currently known. See this issue for details: - -- . - expectedStreamSize = contentStreamSize content - actualStreamSize = Word32le . fromIntegral $ Bytes.length stream - streamSize = Word32le $ max - (word32leValue expectedStreamSize) - (word32leValue actualStreamSize) - putWord32 streamSize - Binary.putByteString - (reverseBytes (padBytes (word32leValue streamSize) stream)) - putList putMessage (contentMessages content) - putList putMark (contentMarks content) - putList putText (contentPackages content) - putList putText (contentObjects content) - putList putText (contentNames content) - putList putClassMapping (contentClassMappings content) - putList putCache (contentCaches content) - mapM_ Binary.putWord8 (contentUnknown content) diff --git a/src/lib/Rattletrap/Encode/CustomDemolishAttribute.hs b/src/lib/Rattletrap/Encode/CustomDemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/CustomDemolishAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.CustomDemolishAttribute - ( putCustomDemolishAttribute - ) -where - -import Rattletrap.Encode.DemolishAttribute -import Rattletrap.Encode.Int32le -import Rattletrap.Type.CustomDemolishAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putCustomDemolishAttribute :: CustomDemolishAttribute -> BinaryBits.BitPut () -putCustomDemolishAttribute x = do - BinaryBits.putBool (customDemolishAttributeFlag x) - putInt32Bits (customDemolishAttributeId x) - putDemolishAttribute (customDemolishAttributeDemolish x) diff --git a/src/lib/Rattletrap/Encode/DamageStateAttribute.hs b/src/lib/Rattletrap/Encode/DamageStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/DamageStateAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Encode.DamageStateAttribute - ( putDamageStateAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Encode.Vector -import Rattletrap.Encode.Word8le -import Rattletrap.Type.DamageStateAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putDamageStateAttribute :: DamageStateAttribute -> BinaryBits.BitPut () -putDamageStateAttribute damageStateAttribute = do - putWord8Bits (damageStateAttributeUnknown1 damageStateAttribute) - BinaryBits.putBool (damageStateAttributeUnknown2 damageStateAttribute) - putInt32Bits (damageStateAttributeUnknown3 damageStateAttribute) - putVector (damageStateAttributeUnknown4 damageStateAttribute) - BinaryBits.putBool (damageStateAttributeUnknown5 damageStateAttribute) - BinaryBits.putBool (damageStateAttributeUnknown6 damageStateAttribute) diff --git a/src/lib/Rattletrap/Encode/DemolishAttribute.hs b/src/lib/Rattletrap/Encode/DemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/DemolishAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.DemolishAttribute - ( putDemolishAttribute - ) -where - -import Rattletrap.Encode.Vector -import Rattletrap.Encode.Word32le -import Rattletrap.Type.DemolishAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putDemolishAttribute :: DemolishAttribute -> BinaryBits.BitPut () -putDemolishAttribute demolishAttribute = do - BinaryBits.putBool (demolishAttributeAttackerFlag demolishAttribute) - putWord32Bits (demolishAttributeAttackerActorId demolishAttribute) - BinaryBits.putBool (demolishAttributeVictimFlag demolishAttribute) - putWord32Bits (demolishAttributeVictimActorId demolishAttribute) - putVector (demolishAttributeAttackerVelocity demolishAttribute) - putVector (demolishAttributeVictimVelocity demolishAttribute) diff --git a/src/lib/Rattletrap/Encode/DestroyedReplication.hs b/src/lib/Rattletrap/Encode/DestroyedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/DestroyedReplication.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Rattletrap.Encode.DestroyedReplication - ( putDestroyedReplication - ) -where - -import Rattletrap.Type.DestroyedReplication - -import qualified Data.Binary.Bits.Put as BinaryBits - -putDestroyedReplication :: DestroyedReplication -> BinaryBits.BitPut () -putDestroyedReplication _ = pure () diff --git a/src/lib/Rattletrap/Encode/Dictionary.hs b/src/lib/Rattletrap/Encode/Dictionary.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Dictionary.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.Encode.Dictionary - ( putDictionary - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Type.Dictionary - -import qualified Data.Binary as Binary - -putDictionary :: (a -> Binary.Put) -> Dictionary a -> Binary.Put -putDictionary f x = case x of - DictionaryElement k v y -> do - putText k - f v - putDictionary f y - DictionaryEnd y -> putText y diff --git a/src/lib/Rattletrap/Encode/EnumAttribute.hs b/src/lib/Rattletrap/Encode/EnumAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/EnumAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.EnumAttribute - ( putEnumAttribute - ) -where - -import Rattletrap.Encode.Common -import Rattletrap.Type.EnumAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putEnumAttribute :: EnumAttribute -> BinaryBits.BitPut () -putEnumAttribute enumAttribute = - putBitsLE 11 (enumAttributeValue enumAttribute) diff --git a/src/lib/Rattletrap/Encode/ExplosionAttribute.hs b/src/lib/Rattletrap/Encode/ExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ExplosionAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.ExplosionAttribute - ( putExplosionAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Encode.Vector -import Rattletrap.Type.ExplosionAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putExplosionAttribute :: ExplosionAttribute -> BinaryBits.BitPut () -putExplosionAttribute explosionAttribute = do - BinaryBits.putBool False - putInt32Bits (explosionAttributeActorId explosionAttribute) - putVector (explosionAttributeLocation explosionAttribute) diff --git a/src/lib/Rattletrap/Encode/ExtendedExplosionAttribute.hs b/src/lib/Rattletrap/Encode/ExtendedExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ExtendedExplosionAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.ExtendedExplosionAttribute - ( putExtendedExplosionAttribute - ) -where - -import Rattletrap.Encode.ExplosionAttribute -import Rattletrap.Encode.FlaggedIntAttribute -import Rattletrap.Type.ExtendedExplosionAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putExtendedExplosionAttribute - :: ExtendedExplosionAttribute -> BinaryBits.BitPut () -putExtendedExplosionAttribute x = do - putExplosionAttribute (extendedExplosionAttributeExplosion x) - putFlaggedIntAttribute (extendedExplosionAttributeUnknown x) diff --git a/src/lib/Rattletrap/Encode/FlaggedByteAttribute.hs b/src/lib/Rattletrap/Encode/FlaggedByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/FlaggedByteAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.FlaggedByteAttribute - ( putFlaggedByteAttribute - ) -where - -import Rattletrap.Encode.Word8le -import Rattletrap.Type.FlaggedByteAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putFlaggedByteAttribute :: FlaggedByteAttribute -> BinaryBits.BitPut () -putFlaggedByteAttribute flaggedByteAttribute = do - BinaryBits.putBool (flaggedByteAttributeFlag flaggedByteAttribute) - putWord8Bits (flaggedByteAttributeByte flaggedByteAttribute) diff --git a/src/lib/Rattletrap/Encode/FlaggedIntAttribute.hs b/src/lib/Rattletrap/Encode/FlaggedIntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/FlaggedIntAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.FlaggedIntAttribute - ( putFlaggedIntAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Type.FlaggedIntAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putFlaggedIntAttribute :: FlaggedIntAttribute -> BinaryBits.BitPut () -putFlaggedIntAttribute flaggedIntAttribute = do - BinaryBits.putBool (flaggedIntAttributeFlag flaggedIntAttribute) - putInt32Bits (flaggedIntAttributeInt flaggedIntAttribute) diff --git a/src/lib/Rattletrap/Encode/Float32le.hs b/src/lib/Rattletrap/Encode/Float32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Float32le.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Float32le - ( putFloat32 - , putFloat32Bits - ) -where - -import Rattletrap.Type.Float32le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putFloat32 :: Float32le -> Binary.Put -putFloat32 = Binary.putFloatle . float32leValue - -putFloat32Bits :: Float32le -> BinaryBits.BitPut () -putFloat32Bits float32 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putFloat32 float32)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/FloatAttribute.hs b/src/lib/Rattletrap/Encode/FloatAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/FloatAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.FloatAttribute - ( putFloatAttribute - ) -where - -import Rattletrap.Encode.Float32le -import Rattletrap.Type.FloatAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putFloatAttribute :: FloatAttribute -> BinaryBits.BitPut () -putFloatAttribute floatAttribute = - putFloat32Bits (floatAttributeValue floatAttribute) diff --git a/src/lib/Rattletrap/Encode/Frame.hs b/src/lib/Rattletrap/Encode/Frame.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Frame.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Rattletrap.Encode.Frame - ( putFrames - ) -where - -import Rattletrap.Encode.Float32le -import Rattletrap.Encode.Replication -import Rattletrap.Type.Frame - -import qualified Data.Binary.Bits.Put as BinaryBits - -putFrames :: [Frame] -> BinaryBits.BitPut () -putFrames frames = case frames of - [] -> pure () - [frame] -> putFrame frame - first : rest -> do - putFrame first - putFrames rest - -putFrame :: Frame -> BinaryBits.BitPut () -putFrame frame = do - putFloat32Bits (frameTime frame) - putFloat32Bits (frameDelta frame) - putReplications (frameReplications frame) diff --git a/src/lib/Rattletrap/Encode/GameModeAttribute.hs b/src/lib/Rattletrap/Encode/GameModeAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/GameModeAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.GameModeAttribute - ( putGameModeAttribute - ) -where - -import Rattletrap.Type.GameModeAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putGameModeAttribute :: GameModeAttribute -> BinaryBits.BitPut () -putGameModeAttribute gameModeAttribute = do - let numBits = gameModeAttributeNumBits gameModeAttribute - let word = gameModeAttributeWord gameModeAttribute - BinaryBits.putWord8 numBits word diff --git a/src/lib/Rattletrap/Encode/Header.hs b/src/lib/Rattletrap/Encode/Header.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Header.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.Encode.Header - ( putHeader - ) -where - -import Rattletrap.Encode.Dictionary -import Rattletrap.Encode.Property -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Header - -import qualified Data.Binary as Binary - -putHeader :: Header -> Binary.Put -putHeader header = do - putWord32 (headerEngineVersion header) - putWord32 (headerLicenseeVersion header) - case headerPatchVersion header of - Nothing -> pure () - Just patchVersion -> putWord32 patchVersion - putText (headerLabel header) - putDictionary putProperty (headerProperties header) diff --git a/src/lib/Rattletrap/Encode/Initialization.hs b/src/lib/Rattletrap/Encode/Initialization.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Initialization.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.Initialization - ( putInitialization - ) -where - -import Rattletrap.Encode.Int8Vector -import Rattletrap.Encode.Vector -import Rattletrap.Type.Initialization - -import qualified Data.Binary.Bits.Put as BinaryBits - -putInitialization :: Initialization -> BinaryBits.BitPut () -putInitialization initialization = do - case initializationLocation initialization of - Nothing -> pure () - Just location -> putVector location - case initializationRotation initialization of - Nothing -> pure () - Just rotation -> putInt8Vector rotation diff --git a/src/lib/Rattletrap/Encode/Int32le.hs b/src/lib/Rattletrap/Encode/Int32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Int32le.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Int32le - ( putInt32 - , putInt32Bits - ) -where - -import Rattletrap.Type.Int32le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putInt32 :: Int32le -> Binary.Put -putInt32 int32 = Binary.putInt32le (int32leValue int32) - -putInt32Bits :: Int32le -> BinaryBits.BitPut () -putInt32Bits int32 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putInt32 int32)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/Int64Attribute.hs b/src/lib/Rattletrap/Encode/Int64Attribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Int64Attribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.Int64Attribute - ( putInt64Attribute - ) -where - -import Rattletrap.Encode.Int64le -import Rattletrap.Type.Int64Attribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putInt64Attribute :: Int64Attribute -> BinaryBits.BitPut () -putInt64Attribute int64Attribute = - putInt64Bits (int64AttributeValue int64Attribute) diff --git a/src/lib/Rattletrap/Encode/Int64le.hs b/src/lib/Rattletrap/Encode/Int64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Int64le.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Encode.Int64le - ( putInt64Bits - ) -where - -import Rattletrap.Type.Int64le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putInt64 :: Int64le -> Binary.Put -putInt64 int64 = Binary.putInt64le (int64leValue int64) - -putInt64Bits :: Int64le -> BinaryBits.BitPut () -putInt64Bits int64 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putInt64 int64)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/Int8Vector.hs b/src/lib/Rattletrap/Encode/Int8Vector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Int8Vector.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Rattletrap.Encode.Int8Vector - ( putInt8Vector - ) -where - -import Rattletrap.Encode.Int8le -import Rattletrap.Type.Int8Vector -import Rattletrap.Type.Int8le - -import qualified Data.Binary.Bits.Put as BinaryBits - -putInt8Vector :: Int8Vector -> BinaryBits.BitPut () -putInt8Vector int8Vector = do - putInt8VectorField (int8VectorX int8Vector) - putInt8VectorField (int8VectorY int8Vector) - putInt8VectorField (int8VectorZ int8Vector) - -putInt8VectorField :: Maybe Int8le -> BinaryBits.BitPut () -putInt8VectorField maybeField = case maybeField of - Nothing -> BinaryBits.putBool False - Just field -> do - BinaryBits.putBool True - putInt8Bits field diff --git a/src/lib/Rattletrap/Encode/Int8le.hs b/src/lib/Rattletrap/Encode/Int8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Int8le.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.Int8le - ( putInt8Bits - ) -where - -import Rattletrap.Type.Int8le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putInt8 :: Int8le -> Binary.Put -putInt8 int8 = Binary.putInt8 (int8leValue int8) - -putInt8Bits :: Int8le -> BinaryBits.BitPut () -putInt8Bits int8 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putInt8 int8)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/IntAttribute.hs b/src/lib/Rattletrap/Encode/IntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/IntAttribute.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Rattletrap.Encode.IntAttribute - ( putIntAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Type.IntAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putIntAttribute :: IntAttribute -> BinaryBits.BitPut () -putIntAttribute intAttribute = putInt32Bits (intAttributeValue intAttribute) diff --git a/src/lib/Rattletrap/Encode/KeyFrame.hs b/src/lib/Rattletrap/Encode/KeyFrame.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/KeyFrame.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.KeyFrame - ( putKeyFrame - ) -where - -import Rattletrap.Encode.Float32le -import Rattletrap.Encode.Word32le -import Rattletrap.Type.KeyFrame - -import qualified Data.Binary as Binary - -putKeyFrame :: KeyFrame -> Binary.Put -putKeyFrame keyFrame = do - putFloat32 (keyFrameTime keyFrame) - putWord32 (keyFrameFrame keyFrame) - putWord32 (keyFramePosition keyFrame) diff --git a/src/lib/Rattletrap/Encode/List.hs b/src/lib/Rattletrap/Encode/List.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/List.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.List - ( putList - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Type.List -import Rattletrap.Type.Word32le - -import qualified Data.Binary as Binary - -putList :: (a -> Binary.Put) -> List a -> Binary.Put -putList putElement list = do - let elements = listValue list - putWord32 (Word32le (fromIntegral (length elements))) - mapM_ putElement elements diff --git a/src/lib/Rattletrap/Encode/LoadoutAttribute.hs b/src/lib/Rattletrap/Encode/LoadoutAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/LoadoutAttribute.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Rattletrap.Encode.LoadoutAttribute - ( putLoadoutAttribute - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Encode.Word8le -import Rattletrap.Type.LoadoutAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putLoadoutAttribute :: LoadoutAttribute -> BinaryBits.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) - putOptional (loadoutAttributeUnknown2 loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeEngineAudio loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeTrail loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeGoalExplosion loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeBanner loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeUnknown3 loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeUnknown4 loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeUnknown5 loadoutAttribute) putWord32Bits - putOptional (loadoutAttributeUnknown6 loadoutAttribute) putWord32Bits - -putOptional :: Maybe a -> (a -> BinaryBits.BitPut ()) -> BinaryBits.BitPut () -putOptional m f = case m of - Just x -> f x - Nothing -> pure () diff --git a/src/lib/Rattletrap/Encode/LoadoutOnlineAttribute.hs b/src/lib/Rattletrap/Encode/LoadoutOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/LoadoutOnlineAttribute.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.Encode.LoadoutOnlineAttribute - ( putLoadoutOnlineAttribute - ) -where - -import Rattletrap.Encode.ProductAttribute -import Rattletrap.Encode.Word8le -import Rattletrap.Type.LoadoutOnlineAttribute -import Rattletrap.Type.Word8le - -import qualified Data.Binary.Bits.Put as BinaryBits - -putLoadoutOnlineAttribute :: LoadoutOnlineAttribute -> BinaryBits.BitPut () -putLoadoutOnlineAttribute loadoutAttribute = do - let attributes = loadoutAttributeValue loadoutAttribute - putWord8Bits (Word8le (fromIntegral (length attributes))) - mapM_ putProductAttributes attributes diff --git a/src/lib/Rattletrap/Encode/LoadoutsAttribute.hs b/src/lib/Rattletrap/Encode/LoadoutsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/LoadoutsAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.LoadoutsAttribute - ( putLoadoutsAttribute - ) -where - -import Rattletrap.Encode.LoadoutAttribute -import Rattletrap.Type.LoadoutsAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putLoadoutsAttribute :: LoadoutsAttribute -> BinaryBits.BitPut () -putLoadoutsAttribute loadoutsAttribute = do - putLoadoutAttribute (loadoutsAttributeBlue loadoutsAttribute) - putLoadoutAttribute (loadoutsAttributeOrange loadoutsAttribute) diff --git a/src/lib/Rattletrap/Encode/LoadoutsOnlineAttribute.hs b/src/lib/Rattletrap/Encode/LoadoutsOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/LoadoutsOnlineAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Encode.LoadoutsOnlineAttribute - ( putLoadoutsOnlineAttribute - ) -where - -import Rattletrap.Encode.LoadoutOnlineAttribute -import Rattletrap.Type.LoadoutsOnlineAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putLoadoutsOnlineAttribute :: LoadoutsOnlineAttribute -> BinaryBits.BitPut () -putLoadoutsOnlineAttribute loadoutsOnlineAttribute = do - putLoadoutOnlineAttribute - (loadoutsOnlineAttributeBlue loadoutsOnlineAttribute) - putLoadoutOnlineAttribute - (loadoutsOnlineAttributeOrange loadoutsOnlineAttribute) - BinaryBits.putBool (loadoutsOnlineAttributeUnknown1 loadoutsOnlineAttribute) - BinaryBits.putBool (loadoutsOnlineAttributeUnknown2 loadoutsOnlineAttribute) diff --git a/src/lib/Rattletrap/Encode/LocationAttribute.hs b/src/lib/Rattletrap/Encode/LocationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/LocationAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.LocationAttribute - ( putLocationAttribute - ) -where - -import Rattletrap.Encode.Vector -import Rattletrap.Type.LocationAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putLocationAttribute :: LocationAttribute -> BinaryBits.BitPut () -putLocationAttribute locationAttribute = - putVector (locationAttributeValue locationAttribute) diff --git a/src/lib/Rattletrap/Encode/Mark.hs b/src/lib/Rattletrap/Encode/Mark.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Mark.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Encode.Mark - ( putMark - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Mark - -import qualified Data.Binary as Binary - -putMark :: Mark -> Binary.Put -putMark mark = do - putText (markValue mark) - putWord32 (markFrame mark) diff --git a/src/lib/Rattletrap/Encode/Message.hs b/src/lib/Rattletrap/Encode/Message.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Message.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.Message - ( putMessage - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Message - -import qualified Data.Binary as Binary - -putMessage :: Message -> Binary.Put -putMessage message = do - putWord32 (messageFrame message) - putText (messageName message) - putText (messageValue message) diff --git a/src/lib/Rattletrap/Encode/MusicStingerAttribute.hs b/src/lib/Rattletrap/Encode/MusicStingerAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/MusicStingerAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.MusicStingerAttribute - ( putMusicStingerAttribute - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Encode.Word8le -import Rattletrap.Type.MusicStingerAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putMusicStingerAttribute :: MusicStingerAttribute -> BinaryBits.BitPut () -putMusicStingerAttribute musicStingerAttribute = do - BinaryBits.putBool (musicStingerAttributeFlag musicStingerAttribute) - putWord32Bits (musicStingerAttributeCue musicStingerAttribute) - putWord8Bits (musicStingerAttributeTrigger musicStingerAttribute) diff --git a/src/lib/Rattletrap/Encode/PartyLeaderAttribute.hs b/src/lib/Rattletrap/Encode/PartyLeaderAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PartyLeaderAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.PartyLeaderAttribute - ( putPartyLeaderAttribute - ) -where - -import Rattletrap.Encode.RemoteId -import Rattletrap.Encode.Word8le -import Rattletrap.Type.PartyLeaderAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putPartyLeaderAttribute :: PartyLeaderAttribute -> BinaryBits.BitPut () -putPartyLeaderAttribute partyLeaderAttribute = do - putWord8Bits (partyLeaderAttributeSystemId partyLeaderAttribute) - case partyLeaderAttributeId partyLeaderAttribute of - Nothing -> pure () - Just (remoteId, localId) -> do - putRemoteId remoteId - putWord8Bits localId diff --git a/src/lib/Rattletrap/Encode/PickupAttribute.hs b/src/lib/Rattletrap/Encode/PickupAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PickupAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Encode.PickupAttribute - ( putPickupAttribute - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Type.PickupAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putPickupAttribute :: PickupAttribute -> BinaryBits.BitPut () -putPickupAttribute pickupAttribute = do - case pickupAttributeInstigatorId pickupAttribute of - Nothing -> BinaryBits.putBool False - Just instigatorId -> do - BinaryBits.putBool True - putWord32Bits instigatorId - BinaryBits.putBool (pickupAttributePickedUp pickupAttribute) diff --git a/src/lib/Rattletrap/Encode/PickupAttributeNew.hs b/src/lib/Rattletrap/Encode/PickupAttributeNew.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PickupAttributeNew.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.PickupAttributeNew - ( putPickupAttributeNew - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Encode.Word8le -import Rattletrap.Type.PickupAttributeNew - -import qualified Data.Binary.Bits.Put as BinaryBits - -putPickupAttributeNew :: PickupAttributeNew -> BinaryBits.BitPut () -putPickupAttributeNew pickupAttributeNew = do - case pickupAttributeNewInstigatorId pickupAttributeNew of - Nothing -> BinaryBits.putBool False - Just instigatorId -> do - BinaryBits.putBool True - putWord32Bits instigatorId - putWord8Bits (pickupAttributeNewPickedUp pickupAttributeNew) diff --git a/src/lib/Rattletrap/Encode/PlayerHistoryKeyAttribute.hs b/src/lib/Rattletrap/Encode/PlayerHistoryKeyAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PlayerHistoryKeyAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.PlayerHistoryKeyAttribute - ( putPlayerHistoryKeyAttribute - ) -where - -import Rattletrap.Encode.Common -import Rattletrap.Type.PlayerHistoryKeyAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putPlayerHistoryKeyAttribute - :: PlayerHistoryKeyAttribute -> BinaryBits.BitPut () -putPlayerHistoryKeyAttribute = putBitsLE 14 . playerHistoryKeyAttributeUnknown diff --git a/src/lib/Rattletrap/Encode/PrivateMatchSettingsAttribute.hs b/src/lib/Rattletrap/Encode/PrivateMatchSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PrivateMatchSettingsAttribute.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.Encode.PrivateMatchSettingsAttribute - ( putPrivateMatchSettingsAttribute - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word32le -import Rattletrap.Type.PrivateMatchSettingsAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putPrivateMatchSettingsAttribute - :: PrivateMatchSettingsAttribute -> BinaryBits.BitPut () -putPrivateMatchSettingsAttribute privateMatchSettingsAttribute = do - putTextBits - (privateMatchSettingsAttributeMutators privateMatchSettingsAttribute) - putWord32Bits - (privateMatchSettingsAttributeJoinableBy privateMatchSettingsAttribute) - putWord32Bits - (privateMatchSettingsAttributeMaxPlayers privateMatchSettingsAttribute) - putTextBits - (privateMatchSettingsAttributeGameName privateMatchSettingsAttribute) - putTextBits - (privateMatchSettingsAttributePassword privateMatchSettingsAttribute) - BinaryBits.putBool - (privateMatchSettingsAttributeFlag privateMatchSettingsAttribute) diff --git a/src/lib/Rattletrap/Encode/ProductAttribute.hs b/src/lib/Rattletrap/Encode/ProductAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ProductAttribute.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Rattletrap.Encode.ProductAttribute - ( putProductAttributes - ) -where - -import Rattletrap.Encode.Common -import Rattletrap.Encode.CompressedWord -import Rattletrap.Encode.Word32le -import Rattletrap.Encode.Word8le -import Rattletrap.Encode.Str -import Rattletrap.Type.ProductAttribute -import Rattletrap.Type.Word8le - -import qualified Data.Binary.Bits.Put as BinaryBits - -putProductAttributes :: [ProductAttribute] -> BinaryBits.BitPut () -putProductAttributes attributes = do - putWord8Bits (Word8le (fromIntegral (length attributes))) - mapM_ putProductAttribute attributes - -putProductAttribute :: ProductAttribute -> BinaryBits.BitPut () -putProductAttribute attribute = do - BinaryBits.putBool (productAttributeUnknown attribute) - putWord32Bits (productAttributeObjectId attribute) - case productAttributeValue attribute of - ProductAttributeValuePaintedOld x -> putCompressedWord x - ProductAttributeValuePaintedNew x -> putBitsLE 31 x - ProductAttributeValueTeamEditionOld x -> putCompressedWord x - ProductAttributeValueTeamEditionNew x -> putBitsLE 31 x - ProductAttributeValueSpecialEdition x -> putBitsLE 31 x - ProductAttributeValueUserColorOld x -> case x of - Nothing -> BinaryBits.putBool False - Just y -> do - BinaryBits.putBool True - putBitsLE 31 y - ProductAttributeValueUserColorNew x -> putWord32Bits x - ProductAttributeValueTitleId x -> putTextBits x diff --git a/src/lib/Rattletrap/Encode/Property.hs b/src/lib/Rattletrap/Encode/Property.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Property.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Rattletrap.Encode.Property - ( putProperty - ) -where - -import Rattletrap.Encode.PropertyValue -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word64le -import Rattletrap.Type.Property - -import qualified Data.Binary as Binary - -putProperty :: Property -> Binary.Put -putProperty property = do - putText (propertyKind property) - putWord64 (propertySize property) - putPropertyValue putProperty (propertyValue property) diff --git a/src/lib/Rattletrap/Encode/PropertyValue.hs b/src/lib/Rattletrap/Encode/PropertyValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/PropertyValue.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Rattletrap.Encode.PropertyValue - ( putPropertyValue - ) -where - -import Rattletrap.Encode.Dictionary -import Rattletrap.Encode.Float32le -import Rattletrap.Encode.Int32le -import Rattletrap.Encode.List -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word64le -import Rattletrap.Encode.Word8le -import Rattletrap.Type.PropertyValue - -import qualified Data.Binary as Binary - -putPropertyValue :: (a -> Binary.Put) -> PropertyValue a -> Binary.Put -putPropertyValue putProperty value = case value of - PropertyValueArray list -> putList (putDictionary putProperty) list - PropertyValueBool word8 -> putWord8 word8 - PropertyValueByte k mv -> do - putText k - case mv of - Nothing -> pure () - Just v -> putText v - PropertyValueFloat float32 -> putFloat32 float32 - PropertyValueInt int32 -> putInt32 int32 - PropertyValueName text -> putText text - PropertyValueQWord word64 -> putWord64 word64 - PropertyValueStr text -> putText text diff --git a/src/lib/Rattletrap/Encode/QWordAttribute.hs b/src/lib/Rattletrap/Encode/QWordAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/QWordAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.QWordAttribute - ( putQWordAttribute - ) -where - -import Rattletrap.Encode.Word64le -import Rattletrap.Type.QWordAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putQWordAttribute :: QWordAttribute -> BinaryBits.BitPut () -putQWordAttribute qWordAttribute = - putWord64Bits (qWordAttributeValue qWordAttribute) diff --git a/src/lib/Rattletrap/Encode/Quaternion.hs b/src/lib/Rattletrap/Encode/Quaternion.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Quaternion.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Rattletrap.Encode.Quaternion - ( putQuaternion - ) -where - -import Rattletrap.Encode.CompressedWord -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Quaternion - -import qualified Data.Binary.Bits.Put as BinaryBits - -putQuaternion :: Quaternion -> BinaryBits.BitPut () -putQuaternion q = do - let c = maxComponent q - putComponent c - case c of - ComponentX -> putParts (quaternionY q) (quaternionZ q) (quaternionW q) - ComponentY -> putParts (quaternionX q) (quaternionZ q) (quaternionW q) - ComponentZ -> putParts (quaternionX q) (quaternionY q) (quaternionW q) - ComponentW -> putParts (quaternionX q) (quaternionY q) (quaternionZ q) - -putComponent :: Component -> BinaryBits.BitPut () -putComponent component = putCompressedWord - (CompressedWord - 3 - (case component of - ComponentX -> 0 - ComponentY -> 1 - ComponentZ -> 2 - ComponentW -> 3 - ) - ) - -putParts :: Double -> Double -> Double -> BinaryBits.BitPut () -putParts a b c = do - putPart a - putPart b - putPart c - -putPart :: Double -> BinaryBits.BitPut () -putPart = putCompressedWord . compressPart diff --git a/src/lib/Rattletrap/Encode/RemoteId.hs b/src/lib/Rattletrap/Encode/RemoteId.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/RemoteId.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Rattletrap.Encode.RemoteId - ( putRemoteId - ) -where - -import Rattletrap.Encode.Common -import Rattletrap.Encode.Str -import Rattletrap.Encode.Word64le -import Rattletrap.Type.RemoteId -import Rattletrap.Type.Word64le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.ByteString as Bytes - -putRemoteId :: RemoteId -> BinaryBits.BitPut () -putRemoteId remoteId = case remoteId of - RemoteIdPlayStation name bytes -> do - let rawName = reverseBytes (padBytes (16 :: Int) (encodeLatin1 name)) - BinaryBits.putByteString rawName - BinaryBits.putByteString (Bytes.pack bytes) - RemoteIdPsyNet e -> case e of - Left l -> putWord64Bits l - Right (a, b, c, d) -> putWord256 a b c d - RemoteIdSplitscreen word24 -> putBitsLE 24 word24 - RemoteIdSteam word64 -> putWord64Bits word64 - RemoteIdSwitch a b c d -> putWord256 a b c d - RemoteIdXbox word64 -> putWord64Bits word64 - RemoteIdEpic str -> putTextBits str - -putWord256 - :: Word64le -> Word64le -> Word64le -> Word64le -> BinaryBits.BitPut () -putWord256 a b c d = do - putWord64Bits a - putWord64Bits b - putWord64Bits c - putWord64Bits d diff --git a/src/lib/Rattletrap/Encode/Replay.hs b/src/lib/Rattletrap/Encode/Replay.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Replay.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Replay - ( putReplay - ) -where - -import Rattletrap.Encode.Content -import Rattletrap.Encode.Header -import Rattletrap.Encode.Section -import Rattletrap.Type.Replay - -import qualified Data.Binary as Binary - --- | Generates a raw replay. Use this with 'Data.Binary.Put.runPut'. --- --- @ --- let bytes = 'Data.Binary.Put.runPut' ('putReplay' replay) --- @ -putReplay :: FullReplay -> Binary.Put -putReplay replay = do - putSection putHeader (replayHeader replay) - putSection putContent (replayContent replay) diff --git a/src/lib/Rattletrap/Encode/Replication.hs b/src/lib/Rattletrap/Encode/Replication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Replication.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Rattletrap.Encode.Replication - ( putReplications - ) -where - -import Rattletrap.Encode.CompressedWord -import Rattletrap.Encode.ReplicationValue -import Rattletrap.Type.Replication - -import qualified Data.Binary.Bits.Put as BinaryBits - -putReplications :: [Replication] -> BinaryBits.BitPut () -putReplications replications = case replications of - [] -> BinaryBits.putBool False - [replication] -> do - putReplication replication - BinaryBits.putBool False - first : rest -> do - putReplication first - putReplications rest - -putReplication :: Replication -> BinaryBits.BitPut () -putReplication replication = do - BinaryBits.putBool True - putCompressedWord (replicationActorId replication) - putReplicationValue (replicationValue replication) diff --git a/src/lib/Rattletrap/Encode/ReplicationValue.hs b/src/lib/Rattletrap/Encode/ReplicationValue.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ReplicationValue.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Rattletrap.Encode.ReplicationValue - ( putReplicationValue - ) -where - -import Rattletrap.Encode.DestroyedReplication -import Rattletrap.Encode.SpawnedReplication -import Rattletrap.Encode.UpdatedReplication -import Rattletrap.Type.ReplicationValue - -import qualified Data.Binary.Bits.Put as BinaryBits - -putReplicationValue :: ReplicationValue -> BinaryBits.BitPut () -putReplicationValue value = case value of - ReplicationValueSpawned x -> do - BinaryBits.putBool True - BinaryBits.putBool True - putSpawnedReplication x - ReplicationValueUpdated x -> do - BinaryBits.putBool True - BinaryBits.putBool False - putUpdatedReplication x - ReplicationValueDestroyed x -> do - BinaryBits.putBool False - putDestroyedReplication x diff --git a/src/lib/Rattletrap/Encode/ReservationAttribute.hs b/src/lib/Rattletrap/Encode/ReservationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/ReservationAttribute.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Rattletrap.Encode.ReservationAttribute - ( putReservationAttribute - ) -where - -import Rattletrap.Encode.CompressedWord -import Rattletrap.Encode.Str -import Rattletrap.Encode.UniqueIdAttribute -import Rattletrap.Type.ReservationAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putReservationAttribute :: ReservationAttribute -> BinaryBits.BitPut () -putReservationAttribute reservationAttribute = do - putCompressedWord (reservationAttributeNumber reservationAttribute) - putUniqueIdAttribute (reservationAttributeUniqueId reservationAttribute) - case reservationAttributeName reservationAttribute of - Nothing -> pure () - Just name -> putTextBits name - BinaryBits.putBool (reservationAttributeUnknown1 reservationAttribute) - BinaryBits.putBool (reservationAttributeUnknown2 reservationAttribute) - case reservationAttributeUnknown3 reservationAttribute of - Nothing -> pure () - Just c -> BinaryBits.putWord8 6 c diff --git a/src/lib/Rattletrap/Encode/RigidBodyStateAttribute.hs b/src/lib/Rattletrap/Encode/RigidBodyStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/RigidBodyStateAttribute.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Rattletrap.Encode.RigidBodyStateAttribute - ( putRigidBodyStateAttribute - ) -where - -import Rattletrap.Encode.Rotation -import Rattletrap.Encode.Vector -import Rattletrap.Type.RigidBodyStateAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putRigidBodyStateAttribute :: RigidBodyStateAttribute -> BinaryBits.BitPut () -putRigidBodyStateAttribute rigidBodyStateAttribute = do - BinaryBits.putBool (rigidBodyStateAttributeSleeping rigidBodyStateAttribute) - putVector (rigidBodyStateAttributeLocation rigidBodyStateAttribute) - putRotation (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/src/lib/Rattletrap/Encode/Rotation.hs b/src/lib/Rattletrap/Encode/Rotation.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Rotation.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Rattletrap.Encode.Rotation - ( putRotation - ) -where - -import Rattletrap.Encode.CompressedWordVector -import Rattletrap.Encode.Quaternion -import Rattletrap.Type.Rotation - -import qualified Data.Binary.Bits.Put as BinaryBits - -putRotation :: Rotation -> BinaryBits.BitPut () -putRotation r = case r of - RotationCompressedWordVector cwv -> putCompressedWordVector cwv - RotationQuaternion q -> putQuaternion q diff --git a/src/lib/Rattletrap/Encode/Section.hs b/src/lib/Rattletrap/Encode/Section.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Section.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Rattletrap.Encode.Section - ( putSection - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Type.Section -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Crc - -import qualified Data.Binary as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as LazyBytes - --- | Given a way to put the 'sectionBody', puts a section. This will also put --- the size and CRC. --- --- @ --- let bytes = 'Data.Binary.Put.runPut' ('putSection' 'Rattletrap.Content.putContent' content) --- @ -putSection :: (a -> Binary.Put) -> Section a -> Binary.Put -putSection putBody section = do - let - rawBody = - LazyBytes.toStrict (Binary.runPut (putBody (sectionBody section))) - let size = Bytes.length rawBody - let crc = getCrc32 rawBody - putWord32 (Word32le (fromIntegral size)) - putWord32 (Word32le crc) - Binary.putByteString rawBody diff --git a/src/lib/Rattletrap/Encode/SpawnedReplication.hs b/src/lib/Rattletrap/Encode/SpawnedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/SpawnedReplication.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Rattletrap.Encode.SpawnedReplication - ( putSpawnedReplication - ) -where - -import Rattletrap.Encode.Initialization -import Rattletrap.Encode.Word32le -import Rattletrap.Type.SpawnedReplication - -import qualified Data.Binary.Bits.Put as BinaryBits - -putSpawnedReplication :: SpawnedReplication -> BinaryBits.BitPut () -putSpawnedReplication spawnedReplication = do - BinaryBits.putBool (spawnedReplicationFlag spawnedReplication) - case spawnedReplicationNameIndex spawnedReplication of - Nothing -> pure () - Just nameIndex -> putWord32Bits nameIndex - putWord32Bits (spawnedReplicationObjectId spawnedReplication) - putInitialization (spawnedReplicationInitialization spawnedReplication) diff --git a/src/lib/Rattletrap/Encode/StatEventAttribute.hs b/src/lib/Rattletrap/Encode/StatEventAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/StatEventAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Rattletrap.Encode.StatEventAttribute - ( putStatEventAttribute - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Type.StatEventAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putStatEventAttribute :: StatEventAttribute -> BinaryBits.BitPut () -putStatEventAttribute statEventAttribute = do - BinaryBits.putBool (statEventAttributeUnknown statEventAttribute) - putInt32Bits (statEventAttributeObjectId statEventAttribute) diff --git a/src/lib/Rattletrap/Encode/Str.hs b/src/lib/Rattletrap/Encode/Str.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Str.hs +++ /dev/null @@ -1,53 +0,0 @@ -module Rattletrap.Encode.Str - ( putText - , putTextBits - ) -where - -import Rattletrap.Encode.Int32le -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le -import Rattletrap.Type.Str -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString as Bytes -import qualified Data.Char as Char -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text - -putText :: Str -> Binary.Put -putText text = do - let size = getTextSize text - let encode = getTextEncoder size - putInt32 size - Binary.putByteString (encode (addNull (strValue text))) - -putTextBits :: Str -> BinaryBits.BitPut () -putTextBits text = do - let size = getTextSize text - let encode = getTextEncoder size - putInt32Bits size - BinaryBits.putByteString (reverseBytes (encode (addNull (strValue text)))) - -getTextSize :: Str -> Int32le -getTextSize text = - let - value = strValue text - scale = if Text.all Char.isLatin1 value then 1 else -1 :: Int32 - rawSize = if Text.null value - then 0 - else fromIntegral (Text.length value) + 1 :: Int32 - size = if value == Text.pack "\x00\x00\x00None" - then 0x05000000 - else scale * rawSize :: Int32 - in Int32le size - -getTextEncoder :: Int32le -> Text.Text -> Bytes.ByteString -getTextEncoder size text = - if size < Int32le 0 then Text.encodeUtf16LE text else encodeLatin1 text - -addNull :: Text.Text -> Text.Text -addNull text = if Text.null text then text else Text.snoc text '\x00' diff --git a/src/lib/Rattletrap/Encode/StringAttribute.hs b/src/lib/Rattletrap/Encode/StringAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/StringAttribute.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.StringAttribute - ( putStringAttribute - ) -where - -import Rattletrap.Encode.Str -import Rattletrap.Type.StringAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putStringAttribute :: StringAttribute -> BinaryBits.BitPut () -putStringAttribute stringAttribute = - putTextBits (stringAttributeValue stringAttribute) diff --git a/src/lib/Rattletrap/Encode/TeamPaintAttribute.hs b/src/lib/Rattletrap/Encode/TeamPaintAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/TeamPaintAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Rattletrap.Encode.TeamPaintAttribute - ( putTeamPaintAttribute - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Encode.Word8le -import Rattletrap.Type.TeamPaintAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putTeamPaintAttribute :: TeamPaintAttribute -> BinaryBits.BitPut () -putTeamPaintAttribute teamPaintAttribute = do - putWord8Bits (teamPaintAttributeTeam teamPaintAttribute) - putWord8Bits (teamPaintAttributePrimaryColor teamPaintAttribute) - putWord8Bits (teamPaintAttributeAccentColor teamPaintAttribute) - putWord32Bits (teamPaintAttributePrimaryFinish teamPaintAttribute) - putWord32Bits (teamPaintAttributeAccentFinish teamPaintAttribute) diff --git a/src/lib/Rattletrap/Encode/TitleAttribute.hs b/src/lib/Rattletrap/Encode/TitleAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/TitleAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Encode.TitleAttribute - ( putTitleAttribute - ) -where - -import Rattletrap.Encode.Word32le -import Rattletrap.Type.TitleAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putTitleAttribute :: TitleAttribute -> BinaryBits.BitPut () -putTitleAttribute titleAttribute = do - BinaryBits.putBool (titleAttributeUnknown1 titleAttribute) - BinaryBits.putBool (titleAttributeUnknown2 titleAttribute) - putWord32Bits (titleAttributeUnknown3 titleAttribute) - putWord32Bits (titleAttributeUnknown4 titleAttribute) - putWord32Bits (titleAttributeUnknown5 titleAttribute) - putWord32Bits (titleAttributeUnknown6 titleAttribute) - putWord32Bits (titleAttributeUnknown7 titleAttribute) - BinaryBits.putBool (titleAttributeUnknown8 titleAttribute) diff --git a/src/lib/Rattletrap/Encode/UniqueIdAttribute.hs b/src/lib/Rattletrap/Encode/UniqueIdAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/UniqueIdAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Rattletrap.Encode.UniqueIdAttribute - ( putUniqueIdAttribute - ) -where - -import Rattletrap.Encode.RemoteId -import Rattletrap.Encode.Word8le -import Rattletrap.Type.UniqueIdAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putUniqueIdAttribute :: UniqueIdAttribute -> BinaryBits.BitPut () -putUniqueIdAttribute uniqueIdAttribute = do - putWord8Bits (uniqueIdAttributeSystemId uniqueIdAttribute) - putRemoteId (uniqueIdAttributeRemoteId uniqueIdAttribute) - putWord8Bits (uniqueIdAttributeLocalId uniqueIdAttribute) diff --git a/src/lib/Rattletrap/Encode/UpdatedReplication.hs b/src/lib/Rattletrap/Encode/UpdatedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/UpdatedReplication.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Rattletrap.Encode.UpdatedReplication - ( putUpdatedReplication - ) -where - -import Rattletrap.Encode.Attribute -import Rattletrap.Type.UpdatedReplication - -import qualified Data.Binary.Bits.Put as BinaryBits - -putUpdatedReplication :: UpdatedReplication -> BinaryBits.BitPut () -putUpdatedReplication updatedReplication = - putAttributes (updatedReplicationAttributes updatedReplication) diff --git a/src/lib/Rattletrap/Encode/Vector.hs b/src/lib/Rattletrap/Encode/Vector.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Vector.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Rattletrap.Encode.Vector - ( putVector - ) -where - -import Rattletrap.Encode.CompressedWord -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Vector - -import qualified Data.Binary.Bits.Put as BinaryBits - -putVector :: Vector -> BinaryBits.BitPut () -putVector vector = do - let - bitSize = - round (logBase (2 :: Float) (fromIntegral (vectorBias vector))) - 1 :: Word - dx = - fromIntegral (vectorX vector + fromIntegral (vectorBias vector)) :: Word - dy = - fromIntegral (vectorY vector + fromIntegral (vectorBias vector)) :: Word - dz = - fromIntegral (vectorZ vector + fromIntegral (vectorBias vector)) :: Word - limit = 2 ^ (bitSize + 2) :: Word - putCompressedWord (vectorSize vector) - putCompressedWord (CompressedWord limit dx) - putCompressedWord (CompressedWord limit dy) - putCompressedWord (CompressedWord limit dz) diff --git a/src/lib/Rattletrap/Encode/WeldedInfoAttribute.hs b/src/lib/Rattletrap/Encode/WeldedInfoAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/WeldedInfoAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Rattletrap.Encode.WeldedInfoAttribute - ( putWeldedInfoAttribute - ) -where - -import Rattletrap.Encode.Float32le -import Rattletrap.Encode.Int32le -import Rattletrap.Encode.Int8Vector -import Rattletrap.Encode.Vector -import Rattletrap.Type.WeldedInfoAttribute - -import qualified Data.Binary.Bits.Put as BinaryBits - -putWeldedInfoAttribute :: WeldedInfoAttribute -> BinaryBits.BitPut () -putWeldedInfoAttribute weldedInfoAttribute = do - BinaryBits.putBool (weldedInfoAttributeActive weldedInfoAttribute) - putInt32Bits (weldedInfoAttributeActorId weldedInfoAttribute) - putVector (weldedInfoAttributeOffset weldedInfoAttribute) - putFloat32Bits (weldedInfoAttributeMass weldedInfoAttribute) - putInt8Vector (weldedInfoAttributeRotation weldedInfoAttribute) diff --git a/src/lib/Rattletrap/Encode/Word32le.hs b/src/lib/Rattletrap/Encode/Word32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Word32le.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Word32le - ( putWord32 - , putWord32Bits - ) -where - -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putWord32 :: Word32le -> Binary.Put -putWord32 word32 = Binary.putWord32le (word32leValue word32) - -putWord32Bits :: Word32le -> BinaryBits.BitPut () -putWord32Bits word32 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putWord32 word32)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/Word64le.hs b/src/lib/Rattletrap/Encode/Word64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Word64le.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Word64le - ( putWord64 - , putWord64Bits - ) -where - -import Rattletrap.Type.Word64le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putWord64 :: Word64le -> Binary.Put -putWord64 word64 = Binary.putWord64le (word64leValue word64) - -putWord64Bits :: Word64le -> BinaryBits.BitPut () -putWord64Bits word64 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putWord64 word64)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Encode/Word8le.hs b/src/lib/Rattletrap/Encode/Word8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Encode/Word8le.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Rattletrap.Encode.Word8le - ( putWord8 - , putWord8Bits - ) -where - -import Rattletrap.Type.Word8le -import Rattletrap.Utility.Bytes - -import qualified Data.Binary as Binary -import qualified Data.Binary.Bits.Put as BinaryBits -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as LazyBytes - -putWord8 :: Word8le -> Binary.Put -putWord8 word8 = Binary.putWord8 (word8leValue word8) - -putWord8Bits :: Word8le -> BinaryBits.BitPut () -putWord8Bits word8 = do - let bytes = LazyBytes.toStrict (Binary.runPut (putWord8 word8)) - BinaryBits.putByteString (reverseBytes bytes) diff --git a/src/lib/Rattletrap/Get.hs b/src/lib/Rattletrap/Get.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Get.hs @@ -0,0 +1,48 @@ +module Rattletrap.Get where + +import qualified Control.Applicative as Applicative + +newtype Get s m a = Get (s -> m (Either String (s, a))) + +instance Functor m => Functor (Get s m) where + fmap f g = Get $ fmap (fmap (fmap f)) . run g + +instance Monad m => Applicative (Get s m) where + pure x = Get $ \s -> pure $ Right (s, x) + + gf <*> gx = Get $ \s1 -> do + r <- run gf s1 + case r of + Left e -> pure $ Left e + Right (s2, f) -> run (fmap f gx) s2 + +instance Monad m => Monad (Get s m) where + g >>= f = Get $ \s1 -> do + r <- run g s1 + case r of + Left e -> pure $ Left e + Right (s2, x) -> run (f x) s2 + +instance Monad m => MonadFail (Get s m) where + fail = Get . const . pure . Left + +instance Monad m => Applicative.Alternative (Get s m) where + empty = fail "empty" + + gx <|> gy = Get $ \s -> do + r <- run gx s + case r of + Left _ -> run gy s + Right x -> pure $ Right x + +run :: Get s m a -> s -> m (Either String (s, a)) +run (Get f) = f + +get :: Applicative m => Get s m s +get = Get $ \s -> pure $ Right (s, s) + +put :: Applicative m => s -> Get s m () +put s = Get $ \_ -> pure $ Right (s, ()) + +lift :: Functor m => m a -> Get s m a +lift m = Get $ \s -> fmap (\x -> Right (s, x)) m diff --git a/src/lib/Rattletrap/Schema.hs b/src/lib/Rattletrap/Schema.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Schema.hs @@ -0,0 +1,61 @@ +module Rattletrap.Schema where + +import qualified Data.Text as Text +import qualified Rattletrap.Utility.Json as Json + +data Schema = Schema + { name :: Text.Text + , json :: Json.Value + } + deriving (Eq, Show) + +named :: String -> Json.Value -> Schema +named n j = Schema { name = Text.pack n, json = j } + +ref :: Schema -> Json.Value +ref s = Json.object [Json.pair "$ref" $ Text.pack "#/definitions/" <> name s] + +object :: [((Text.Text, Json.Value), Bool)] -> Json.Value +object xs = Json.object + [ Json.pair "type" "object" + , Json.pair "properties" . Json.object $ fmap fst xs + , Json.pair "required" . fmap (fst . fst) $ filter snd xs + ] + +maybe :: Schema -> Schema +maybe s = Schema + { name = Text.pack "maybe-" <> name s + , json = oneOf [ref s, json Rattletrap.Schema.null] + } + +oneOf :: [Json.Value] -> Json.Value +oneOf xs = Json.object [Json.pair "oneOf" xs] + +tuple :: [Json.Value] -> Json.Value +tuple xs = Json.object + [ Json.pair "type" "array" + , Json.pair "items" xs + , Json.pair "minItems" $ length xs + , Json.pair "maxItems" $ length xs + ] + +array :: Schema -> Schema +array s = Schema + { name = Text.pack "array-" <> name s + , json = Json.object [Json.pair "type" "array", Json.pair "items" $ ref s] + } + +boolean :: Schema +boolean = named "boolean" $ Json.object [Json.pair "type" "boolean"] + +integer :: Schema +integer = named "integer" $ Json.object [Json.pair "type" "integer"] + +null :: Schema +null = named "null" $ Json.object [Json.pair "type" "null"] + +number :: Schema +number = named "number" $ Json.object [Json.pair "type" "number"] + +string :: Schema +string = named "string" $ Json.object [Json.pair "type" "string"] diff --git a/src/lib/Rattletrap/Type/AppliedDamageAttribute.hs b/src/lib/Rattletrap/Type/AppliedDamageAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/AppliedDamageAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.AppliedDamageAttribute - ( AppliedDamageAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le -import Rattletrap.Type.Vector -import Rattletrap.Type.Word8le - -data AppliedDamageAttribute = AppliedDamageAttribute - { appliedDamageAttributeUnknown1 :: Word8le - , appliedDamageAttributeLocation :: Vector - , appliedDamageAttributeUnknown3 :: Int32le - , appliedDamageAttributeUnknown4 :: Int32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''AppliedDamageAttribute) diff --git a/src/lib/Rattletrap/Type/Attribute.hs b/src/lib/Rattletrap/Type/Attribute.hs --- a/src/lib/Rattletrap/Type/Attribute.hs +++ b/src/lib/Rattletrap/Type/Attribute.hs @@ -1,21 +1,95 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Attribute - ( Attribute(..) - ) -where +module Rattletrap.Type.Attribute where -import Rattletrap.Type.AttributeValue -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Str +import qualified Data.Map as Map +import Prelude hiding (id) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.AttributeValue as AttributeValue +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json data Attribute = Attribute - { attributeId :: CompressedWord - , attributeName :: Str + { id :: CompressedWord.CompressedWord + , name :: Str.Str -- ^ Read-only! Changing an attribute's name requires editing the class -- attribute map. - , attributeValue :: AttributeValue - } deriving (Eq, Ord, Show) + , value :: AttributeValue.AttributeValue + } + deriving (Eq, Show) -$(deriveJson ''Attribute) +instance Json.FromJSON Attribute where + parseJSON = Json.withObject "Attribute" $ \object -> do + id <- Json.required object "id" + name <- Json.required object "name" + value <- Json.required object "value" + pure Attribute { id, name, value } + +instance Json.ToJSON Attribute where + toJSON x = Json.object + [ Json.pair "id" $ id x + , Json.pair "name" $ name x + , Json.pair "value" $ value x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute" $ Schema.object + [ (Json.pair "id" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "name" $ Schema.ref Str.schema, True) + , (Json.pair "value" $ Schema.ref AttributeValue.schema, True) + ] + +bitPut :: Attribute -> BitPut.BitPut +bitPut attribute = + CompressedWord.bitPut (Rattletrap.Type.Attribute.id attribute) + <> AttributeValue.bitPut (value attribute) + +bitGet + :: Version.Version + -> ClassAttributeMap.ClassAttributeMap + -> Map.Map CompressedWord.CompressedWord U32.U32 + -> CompressedWord.CompressedWord + -> BitGet.BitGet Attribute +bitGet version classes actors actor = do + attributes <- lookupAttributeMap classes actors actor + limit <- lookupAttributeIdLimit attributes actor + attribute <- CompressedWord.bitGet limit + name_ <- lookupAttributeName classes attributes attribute + Attribute attribute name_ + <$> AttributeValue.bitGet + version + (ClassAttributeMap.objectMap classes) + name_ + +lookupAttributeMap + :: ClassAttributeMap.ClassAttributeMap + -> Map.Map CompressedWord.CompressedWord U32.U32 + -> CompressedWord.CompressedWord + -> BitGet.BitGet (Map.Map U32.U32 U32.U32) +lookupAttributeMap classes actors actor = fromMaybe + ("[RT01] could not get attribute map for " <> show actor) + (ClassAttributeMap.getAttributeMap classes actors actor) + +lookupAttributeIdLimit + :: Map.Map U32.U32 U32.U32 + -> CompressedWord.CompressedWord + -> BitGet.BitGet Word +lookupAttributeIdLimit attributes actor = fromMaybe + ("[RT02] could not get attribute ID limit for " <> show actor) + (ClassAttributeMap.getAttributeIdLimit attributes) + +lookupAttributeName + :: ClassAttributeMap.ClassAttributeMap + -> Map.Map U32.U32 U32.U32 + -> CompressedWord.CompressedWord + -> BitGet.BitGet Str.Str +lookupAttributeName classes attributes attribute = fromMaybe + ("[RT03] could not get attribute name for " <> show attribute) + (ClassAttributeMap.getAttributeName classes attributes attribute) + +fromMaybe :: String -> Maybe a -> BitGet.BitGet a +fromMaybe message = maybe (fail message) pure diff --git a/src/lib/Rattletrap/Type/Attribute/AppliedDamage.hs b/src/lib/Rattletrap/Type/Attribute/AppliedDamage.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/AppliedDamage.hs @@ -0,0 +1,57 @@ +module Rattletrap.Type.Attribute.AppliedDamage where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data AppliedDamage = AppliedDamage + { unknown1 :: U8.U8 + , location :: Vector.Vector + , unknown3 :: I32.I32 + , unknown4 :: I32.I32 + } + deriving (Eq, Show) + +instance Json.FromJSON AppliedDamage where + parseJSON = Json.withObject "AppliedDamage" $ \object -> do + unknown1 <- Json.required object "unknown1" + location <- Json.required object "location" + unknown3 <- Json.required object "unknown3" + unknown4 <- Json.required object "unknown4" + pure AppliedDamage { unknown1, location, unknown3, unknown4 } + +instance Json.ToJSON AppliedDamage where + toJSON x = Json.object + [ Json.pair "unknown1" $ unknown1 x + , Json.pair "location" $ location x + , Json.pair "unknown3" $ unknown3 x + , Json.pair "unknown4" $ unknown4 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-applied-damage" $ Schema.object + [ (Json.pair "unknown1" $ Schema.ref U8.schema, True) + , (Json.pair "location" $ Schema.ref Vector.schema, True) + , (Json.pair "unknown3" $ Schema.ref I32.schema, True) + , (Json.pair "unknown4" $ Schema.ref I32.schema, True) + ] + +bitPut :: AppliedDamage -> BitPut.BitPut +bitPut appliedDamageAttribute = + U8.bitPut (unknown1 appliedDamageAttribute) + <> Vector.bitPut (location appliedDamageAttribute) + <> I32.bitPut (unknown3 appliedDamageAttribute) + <> I32.bitPut (unknown4 appliedDamageAttribute) + +bitGet :: Version.Version -> BitGet.BitGet AppliedDamage +bitGet version = + AppliedDamage + <$> U8.bitGet + <*> Vector.bitGet version + <*> I32.bitGet + <*> I32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Boolean.hs b/src/lib/Rattletrap/Type/Attribute/Boolean.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Boolean.hs @@ -0,0 +1,25 @@ +module Rattletrap.Type.Attribute.Boolean where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype Boolean = Boolean + { value :: Bool + } deriving (Eq, Show) + +instance Json.FromJSON Boolean where + parseJSON = fmap Boolean . Json.parseJSON + +instance Json.ToJSON Boolean where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-boolean" $ Schema.ref Schema.boolean + +bitPut :: Boolean -> BitPut.BitPut +bitPut booleanAttribute = BitPut.bool (value booleanAttribute) + +bitGet :: BitGet.BitGet Boolean +bitGet = Boolean <$> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/Byte.hs b/src/lib/Rattletrap/Type/Attribute/Byte.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Byte.hs @@ -0,0 +1,26 @@ +module Rattletrap.Type.Attribute.Byte where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json + +newtype Byte = Byte + { value :: U8.U8 + } deriving (Eq, Show) + +instance Json.FromJSON Byte where + parseJSON = fmap Byte . Json.parseJSON + +instance Json.ToJSON Byte where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-byte" $ Schema.ref U8.schema + +bitPut :: Byte -> BitPut.BitPut +bitPut byteAttribute = U8.bitPut (value byteAttribute) + +bitGet :: BitGet.BitGet Byte +bitGet = Byte <$> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/CamSettings.hs b/src/lib/Rattletrap/Type/Attribute/CamSettings.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/CamSettings.hs @@ -0,0 +1,88 @@ +module Rattletrap.Type.Attribute.CamSettings where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data CamSettings = CamSettings + { fov :: F32.F32 + , height :: F32.F32 + , angle :: F32.F32 + , distance :: F32.F32 + , stiffness :: F32.F32 + , swivelSpeed :: F32.F32 + , transitionSpeed :: Maybe F32.F32 + } + deriving (Eq, Show) + +instance Json.FromJSON CamSettings where + parseJSON = Json.withObject "CamSettings" $ \object -> do + fov <- Json.required object "fov" + height <- Json.required object "height" + angle <- Json.required object "angle" + distance <- Json.required object "distance" + stiffness <- Json.required object "stiffness" + swivelSpeed <- Json.required object "swivel_speed" + transitionSpeed <- Json.optional object "transition_speed" + pure CamSettings + { fov + , height + , angle + , distance + , stiffness + , swivelSpeed + , transitionSpeed + } + +instance Json.ToJSON CamSettings where + toJSON x = Json.object + [ Json.pair "fov" $ fov x + , Json.pair "height" $ height x + , Json.pair "angle" $ angle x + , Json.pair "distance" $ distance x + , Json.pair "stiffness" $ stiffness x + , Json.pair "swivel_speed" $ swivelSpeed x + , Json.pair "transition_speed" $ transitionSpeed x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-cam-settings" $ Schema.object + [ (Json.pair "fov" $ Schema.ref F32.schema, True) + , (Json.pair "height" $ Schema.ref F32.schema, True) + , (Json.pair "angle" $ Schema.ref F32.schema, True) + , (Json.pair "distance" $ Schema.ref F32.schema, True) + , (Json.pair "stiffness" $ Schema.ref F32.schema, True) + , (Json.pair "swivel_speed" $ Schema.ref F32.schema, True) + , ( Json.pair "transition_speed" . Schema.json $ Schema.maybe F32.schema + , False + ) + ] + +bitPut :: CamSettings -> BitPut.BitPut +bitPut camSettingsAttribute = + F32.bitPut (fov camSettingsAttribute) + <> F32.bitPut (height camSettingsAttribute) + <> F32.bitPut (angle camSettingsAttribute) + <> F32.bitPut (distance camSettingsAttribute) + <> F32.bitPut (stiffness camSettingsAttribute) + <> F32.bitPut (swivelSpeed camSettingsAttribute) + <> foldMap F32.bitPut (transitionSpeed camSettingsAttribute) + +bitGet :: Version.Version -> BitGet.BitGet CamSettings +bitGet version = + CamSettings + <$> F32.bitGet + <*> F32.bitGet + <*> F32.bitGet + <*> F32.bitGet + <*> F32.bitGet + <*> F32.bitGet + <*> whenMaybe (hasTransitionSpeed version) F32.bitGet + +hasTransitionSpeed :: Version.Version -> Bool +hasTransitionSpeed v = + Version.major v >= 868 && Version.minor v >= 20 && Version.patch v >= 0 diff --git a/src/lib/Rattletrap/Type/Attribute/ClubColors.hs b/src/lib/Rattletrap/Type/Attribute/ClubColors.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/ClubColors.hs @@ -0,0 +1,50 @@ +module Rattletrap.Type.Attribute.ClubColors where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json + +data ClubColors = ClubColors + { blueFlag :: Bool + , blueColor :: U8.U8 + , orangeFlag :: Bool + , orangeColor :: U8.U8 + } + deriving (Eq, Show) + +instance Json.FromJSON ClubColors where + parseJSON = Json.withObject "ClubColors" $ \object -> do + blueFlag <- Json.required object "blue_flag" + blueColor <- Json.required object "blue_color" + orangeFlag <- Json.required object "orange_flag" + orangeColor <- Json.required object "orange_color" + pure ClubColors { blueFlag, blueColor, orangeFlag, orangeColor } + +instance Json.ToJSON ClubColors where + toJSON x = Json.object + [ Json.pair "blue_flag" $ blueFlag x + , Json.pair "blue_color" $ blueColor x + , Json.pair "orange_flag" $ orangeFlag x + , Json.pair "orange_color" $ orangeColor x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-club-colors" $ Schema.object + [ (Json.pair "blue_flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "blue_color" $ Schema.ref U8.schema, True) + , (Json.pair "orange_flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "orange_color" $ Schema.ref U8.schema, True) + ] + +bitPut :: ClubColors -> BitPut.BitPut +bitPut clubColorsAttribute = + BitPut.bool (blueFlag clubColorsAttribute) + <> U8.bitPut (blueColor clubColorsAttribute) + <> BitPut.bool (orangeFlag clubColorsAttribute) + <> U8.bitPut (orangeColor clubColorsAttribute) + +bitGet :: BitGet.BitGet ClubColors +bitGet = + ClubColors <$> BitGet.bool <*> U8.bitGet <*> BitGet.bool <*> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/CustomDemolish.hs b/src/lib/Rattletrap/Type/Attribute/CustomDemolish.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/CustomDemolish.hs @@ -0,0 +1,48 @@ +module Rattletrap.Type.Attribute.CustomDemolish where + +import Prelude hiding (id) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.Demolish as Demolish +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data CustomDemolish = CustomDemolish + { flag :: Bool + , id :: I32.I32 + , demolish :: Demolish.Demolish + } + deriving (Eq, Show) + +instance Json.FromJSON CustomDemolish where + parseJSON = Json.withObject "CustomDemolish" $ \object -> do + flag <- Json.required object "flag" + id <- Json.required object "id" + demolish <- Json.required object "demolish" + pure CustomDemolish { flag, id, demolish } + +instance Json.ToJSON CustomDemolish where + toJSON x = Json.object + [ Json.pair "flag" $ flag x + , Json.pair "id" $ id x + , Json.pair "demolish" $ demolish x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-custom-demolish" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "id" $ Schema.ref I32.schema, True) + , (Json.pair "demolish" $ Schema.ref Demolish.schema, True) + ] + +bitPut :: CustomDemolish -> BitPut.BitPut +bitPut x = + BitPut.bool (flag x) + <> I32.bitPut (Rattletrap.Type.Attribute.CustomDemolish.id x) + <> Demolish.bitPut (demolish x) + +bitGet :: Version.Version -> BitGet.BitGet CustomDemolish +bitGet version = + CustomDemolish <$> BitGet.bool <*> I32.bitGet <*> Demolish.bitGet version diff --git a/src/lib/Rattletrap/Type/Attribute/DamageState.hs b/src/lib/Rattletrap/Type/Attribute/DamageState.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/DamageState.hs @@ -0,0 +1,76 @@ +module Rattletrap.Type.Attribute.DamageState where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data DamageState = DamageState + { unknown1 :: U8.U8 + , unknown2 :: Bool + , unknown3 :: I32.I32 + , unknown4 :: Vector.Vector + , unknown5 :: Bool + , unknown6 :: Bool + } + deriving (Eq, Show) + +instance Json.FromJSON DamageState where + parseJSON = Json.withObject "DamageState" $ \object -> do + unknown1 <- Json.required object "unknown1" + unknown2 <- Json.required object "unknown2" + unknown3 <- Json.required object "unknown3" + unknown4 <- Json.required object "unknown4" + unknown5 <- Json.required object "unknown5" + unknown6 <- Json.required object "unknown6" + pure DamageState + { unknown1 + , unknown2 + , unknown3 + , unknown4 + , unknown5 + , unknown6 + } + +instance Json.ToJSON DamageState where + toJSON x = Json.object + [ Json.pair "unknown1" $ unknown1 x + , Json.pair "unknown2" $ unknown2 x + , Json.pair "unknown3" $ unknown3 x + , Json.pair "unknown4" $ unknown4 x + , Json.pair "unknown5" $ unknown5 x + , Json.pair "unknown6" $ unknown6 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-damage-state" $ Schema.object + [ (Json.pair "unknown1" $ Schema.ref U8.schema, True) + , (Json.pair "unknown2" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown3" $ Schema.ref I32.schema, True) + , (Json.pair "unknown4" $ Schema.ref Vector.schema, True) + , (Json.pair "unknown5" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown6" $ Schema.ref Schema.boolean, True) + ] + +bitPut :: DamageState -> BitPut.BitPut +bitPut damageStateAttribute = + U8.bitPut (unknown1 damageStateAttribute) + <> BitPut.bool (unknown2 damageStateAttribute) + <> I32.bitPut (unknown3 damageStateAttribute) + <> Vector.bitPut (unknown4 damageStateAttribute) + <> BitPut.bool (unknown5 damageStateAttribute) + <> BitPut.bool (unknown6 damageStateAttribute) + +bitGet :: Version.Version -> BitGet.BitGet DamageState +bitGet version = + DamageState + <$> U8.bitGet + <*> BitGet.bool + <*> I32.bitGet + <*> Vector.bitGet version + <*> BitGet.bool + <*> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/Demolish.hs b/src/lib/Rattletrap/Type/Attribute/Demolish.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Demolish.hs @@ -0,0 +1,75 @@ +module Rattletrap.Type.Attribute.Demolish where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data Demolish = Demolish + { attackerFlag :: Bool + , attackerActorId :: U32.U32 + , victimFlag :: Bool + , victimActorId :: U32.U32 + , attackerVelocity :: Vector.Vector + , victimVelocity :: Vector.Vector + } + deriving (Eq, Show) + +instance Json.FromJSON Demolish where + parseJSON = Json.withObject "Demolish" $ \object -> do + attackerFlag <- Json.required object "attacker_flag" + attackerActorId <- Json.required object "attacker_actor_id" + victimFlag <- Json.required object "victim_flag" + victimActorId <- Json.required object "victim_actor_id" + attackerVelocity <- Json.required object "attacker_velocity" + victimVelocity <- Json.required object "victim_velocity" + pure Demolish + { attackerFlag + , attackerActorId + , victimFlag + , victimActorId + , attackerVelocity + , victimVelocity + } + +instance Json.ToJSON Demolish where + toJSON x = Json.object + [ Json.pair "attacker_flag" $ attackerFlag x + , Json.pair "attacker_actor_id" $ attackerActorId x + , Json.pair "victim_flag" $ victimFlag x + , Json.pair "victim_actor_id" $ victimActorId x + , Json.pair "attacker_velocity" $ attackerVelocity x + , Json.pair "victim_velocity" $ victimVelocity x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-demolish" $ Schema.object + [ (Json.pair "attacker_flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "attacker_actor_id" $ Schema.ref U32.schema, True) + , (Json.pair "victim_flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "victim_actor_id" $ Schema.ref U32.schema, True) + , (Json.pair "attacker_velocity" $ Schema.ref Vector.schema, True) + , (Json.pair "victim_velocity" $ Schema.ref Vector.schema, True) + ] + +bitPut :: Demolish -> BitPut.BitPut +bitPut demolishAttribute = + BitPut.bool (attackerFlag demolishAttribute) + <> U32.bitPut (attackerActorId demolishAttribute) + <> BitPut.bool (victimFlag demolishAttribute) + <> U32.bitPut (victimActorId demolishAttribute) + <> Vector.bitPut (attackerVelocity demolishAttribute) + <> Vector.bitPut (victimVelocity demolishAttribute) + +bitGet :: Version.Version -> BitGet.BitGet Demolish +bitGet version = + Demolish + <$> BitGet.bool + <*> U32.bitGet + <*> BitGet.bool + <*> U32.bitGet + <*> Vector.bitGet version + <*> Vector.bitGet version diff --git a/src/lib/Rattletrap/Type/Attribute/Enum.hs b/src/lib/Rattletrap/Type/Attribute/Enum.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Enum.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.Enum where + +import qualified Data.Word as Word +import Prelude hiding (Enum) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype Enum = Enum + { value :: Word.Word16 + } deriving (Eq, Show) + +instance Json.FromJSON Enum where + parseJSON = fmap Enum . Json.parseJSON + +instance Json.ToJSON Enum where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-enum" $ Schema.ref Schema.integer + +bitPut :: Enum -> BitPut.BitPut +bitPut enumAttribute = BitPut.bits 11 (value enumAttribute) + +bitGet :: BitGet.BitGet Enum +bitGet = Enum <$> BitGet.bits 11 diff --git a/src/lib/Rattletrap/Type/Attribute/Explosion.hs b/src/lib/Rattletrap/Type/Attribute/Explosion.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Explosion.hs @@ -0,0 +1,47 @@ +module Rattletrap.Type.Attribute.Explosion where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data Explosion = Explosion + { flag :: Bool + , actorId :: I32.I32 + , location :: Vector.Vector + } + deriving (Eq, Show) + +instance Json.FromJSON Explosion where + parseJSON = Json.withObject "Explosion" $ \object -> do + flag <- Json.required object "flag" + actorId <- Json.required object "actor_id" + location <- Json.required object "location" + pure Explosion { flag, actorId, location } + +instance Json.ToJSON Explosion where + toJSON x = Json.object + [ Json.pair "flag" $ flag x + , Json.pair "actor_id" $ actorId x + , Json.pair "location" $ location x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-explosion" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "actor_id" $ Schema.ref I32.schema, True) + , (Json.pair "location" $ Schema.ref Vector.schema, True) + ] + +bitPut :: Explosion -> BitPut.BitPut +bitPut explosionAttribute = + BitPut.bool (flag explosionAttribute) + <> I32.bitPut (actorId explosionAttribute) + <> Vector.bitPut (location explosionAttribute) + +bitGet :: Version.Version -> BitGet.BitGet Explosion +bitGet version = + Explosion <$> BitGet.bool <*> I32.bitGet <*> Vector.bitGet version diff --git a/src/lib/Rattletrap/Type/Attribute/ExtendedExplosion.hs b/src/lib/Rattletrap/Type/Attribute/ExtendedExplosion.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/ExtendedExplosion.hs @@ -0,0 +1,38 @@ +module Rattletrap.Type.Attribute.ExtendedExplosion where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.Explosion as Explosion +import qualified Rattletrap.Type.Attribute.FlaggedInt as FlaggedInt +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data ExtendedExplosion = ExtendedExplosion + { explosion :: Explosion.Explosion + , unknown :: FlaggedInt.FlaggedInt + } + deriving (Eq, Show) + +instance Json.FromJSON ExtendedExplosion where + parseJSON = Json.withObject "ExtendedExplosion" $ \object -> do + explosion <- Json.required object "explosion" + unknown <- Json.required object "unknown" + pure ExtendedExplosion { explosion, unknown } + +instance Json.ToJSON ExtendedExplosion where + toJSON x = Json.object + [Json.pair "explosion" $ explosion x, Json.pair "unknown" $ unknown x] + +schema :: Schema.Schema +schema = Schema.named "attribute-extended-explosion" $ Schema.object + [ (Json.pair "explosion" $ Schema.ref Explosion.schema, True) + , (Json.pair "unknown" $ Schema.ref FlaggedInt.schema, True) + ] + +bitPut :: ExtendedExplosion -> BitPut.BitPut +bitPut x = Explosion.bitPut (explosion x) <> FlaggedInt.bitPut (unknown x) + +bitGet :: Version.Version -> BitGet.BitGet ExtendedExplosion +bitGet version = + ExtendedExplosion <$> Explosion.bitGet version <*> FlaggedInt.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/FlaggedByte.hs b/src/lib/Rattletrap/Type/Attribute/FlaggedByte.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/FlaggedByte.hs @@ -0,0 +1,36 @@ +module Rattletrap.Type.Attribute.FlaggedByte where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json + +data FlaggedByte = FlaggedByte + { flag :: Bool + , byte :: U8.U8 + } + deriving (Eq, Show) + +instance Json.FromJSON FlaggedByte where + parseJSON = Json.withObject "FlaggedByte" $ \object -> do + flag <- Json.required object "flag" + byte <- Json.required object "byte" + pure FlaggedByte { flag, byte } + +instance Json.ToJSON FlaggedByte where + toJSON x = + Json.object [Json.pair "flag" $ flag x, Json.pair "byte" $ byte x] + +schema :: Schema.Schema +schema = Schema.named "attribute-flagged-byte" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "byte" $ Schema.ref U8.schema, True) + ] + +bitPut :: FlaggedByte -> BitPut.BitPut +bitPut flaggedByteAttribute = BitPut.bool (flag flaggedByteAttribute) + <> U8.bitPut (byte flaggedByteAttribute) + +bitGet :: BitGet.BitGet FlaggedByte +bitGet = FlaggedByte <$> BitGet.bool <*> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/FlaggedInt.hs b/src/lib/Rattletrap/Type/Attribute/FlaggedInt.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/FlaggedInt.hs @@ -0,0 +1,35 @@ +module Rattletrap.Type.Attribute.FlaggedInt where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Utility.Json as Json + +data FlaggedInt = FlaggedInt + { flag :: Bool + , int :: I32.I32 + } + deriving (Eq, Show) + +instance Json.FromJSON FlaggedInt where + parseJSON = Json.withObject "FlaggedInt" $ \object -> do + flag <- Json.required object "flag" + int <- Json.required object "int" + pure FlaggedInt { flag, int } + +instance Json.ToJSON FlaggedInt where + toJSON x = Json.object [Json.pair "flag" $ flag x, Json.pair "int" $ int x] + +schema :: Schema.Schema +schema = Schema.named "attribute-flagged-int" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "int" $ Schema.ref I32.schema, True) + ] + +bitPut :: FlaggedInt -> BitPut.BitPut +bitPut flaggedIntAttribute = BitPut.bool (flag flaggedIntAttribute) + <> I32.bitPut (int flaggedIntAttribute) + +bitGet :: BitGet.BitGet FlaggedInt +bitGet = FlaggedInt <$> BitGet.bool <*> I32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Float.hs b/src/lib/Rattletrap/Type/Attribute/Float.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Float.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.Float where + +import Prelude hiding (Float) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Utility.Json as Json + +newtype Float = Float + { value :: F32.F32 + } deriving (Eq, Show) + +instance Json.FromJSON Float where + parseJSON = fmap Float . Json.parseJSON + +instance Json.ToJSON Float where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-float" $ Schema.ref F32.schema + +bitPut :: Float -> BitPut.BitPut +bitPut floatAttribute = F32.bitPut (value floatAttribute) + +bitGet :: BitGet.BitGet Float +bitGet = Float <$> F32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/GameMode.hs b/src/lib/Rattletrap/Type/Attribute/GameMode.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/GameMode.hs @@ -0,0 +1,49 @@ +module Rattletrap.Type.Attribute.GameMode where + +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data GameMode = GameMode + { numBits :: Int + -- ^ This field is guaranteed to be small. In other words, it won't overflow. + -- It's stored as a regular 'Int' rather than something more precise like an + -- 'Int8' because it just gets passed to functions that expect 'Int's. + -- There's no reason to do a bunch of conversions. + , word :: Word.Word8 + } + deriving (Eq, Show) + +instance Json.FromJSON GameMode where + parseJSON = Json.withObject "GameMode" $ \object -> do + numBits <- Json.required object "num_bits" + word <- Json.required object "word" + pure GameMode { numBits, word } + +instance Json.ToJSON GameMode where + toJSON x = + Json.object [Json.pair "num_bits" $ numBits x, Json.pair "word" $ word x] + +schema :: Schema.Schema +schema = Schema.named "attribute-game-mode" $ Schema.object + [ (Json.pair "num_bits" $ Schema.ref Schema.integer, True) + , (Json.pair "word" $ Schema.ref Schema.integer, True) + ] + +bitPut :: GameMode -> BitPut.BitPut +bitPut gameModeAttribute = do + BitPut.word8 (numBits gameModeAttribute) (word gameModeAttribute) + +bitGet :: Version.Version -> BitGet.BitGet GameMode +bitGet version = + GameMode (numBits_ version) <$> BitGet.word8 (numBits_ version) + +numBits_ :: Version.Version -> Int +numBits_ version = if has8Bits version then 8 else 2 + +has8Bits :: Version.Version -> Bool +has8Bits v = + Version.major v >= 868 && Version.minor v >= 12 && Version.patch v >= 0 diff --git a/src/lib/Rattletrap/Type/Attribute/Int.hs b/src/lib/Rattletrap/Type/Attribute/Int.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Int.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.Int where + +import Prelude hiding (Int) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Utility.Json as Json + +newtype Int = Int + { value :: I32.I32 + } deriving (Eq, Show) + +instance Json.FromJSON Int where + parseJSON = fmap Int . Json.parseJSON + +instance Json.ToJSON Int where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-int" $ Schema.ref I32.schema + +bitPut :: Int -> BitPut.BitPut +bitPut intAttribute = I32.bitPut (value intAttribute) + +bitGet :: BitGet.BitGet Int +bitGet = Int <$> I32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Int64.hs b/src/lib/Rattletrap/Type/Attribute/Int64.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Int64.hs @@ -0,0 +1,26 @@ +module Rattletrap.Type.Attribute.Int64 where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I64 as I64 +import qualified Rattletrap.Utility.Json as Json + +newtype Int64 = Int64 + { value :: I64.I64 + } deriving (Eq, Show) + +instance Json.FromJSON Int64 where + parseJSON = fmap Int64 . Json.parseJSON + +instance Json.ToJSON Int64 where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-int64" $ Schema.ref I64.schema + +putInt64Attribute :: Int64 -> BitPut.BitPut +putInt64Attribute int64Attribute = I64.bitPut (value int64Attribute) + +bitGet :: BitGet.BitGet Int64 +bitGet = Int64 <$> I64.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Loadout.hs b/src/lib/Rattletrap/Type/Attribute/Loadout.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Loadout.hs @@ -0,0 +1,153 @@ +module Rattletrap.Type.Attribute.Loadout where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data Loadout = Loadout + { version :: U8.U8 + , body :: U32.U32 + , decal :: U32.U32 + , wheels :: U32.U32 + , rocketTrail :: U32.U32 + -- ^ Now known as "rocket boost". + , antenna :: U32.U32 + , topper :: U32.U32 + , unknown1 :: U32.U32 + , unknown2 :: Maybe U32.U32 + , engineAudio :: Maybe U32.U32 + , trail :: Maybe U32.U32 + , goalExplosion :: Maybe U32.U32 + , banner :: Maybe U32.U32 + , unknown3 :: Maybe U32.U32 + , unknown4 :: Maybe U32.U32 + , unknown5 :: Maybe U32.U32 + , unknown6 :: Maybe U32.U32 + } + deriving (Eq, Show) + +instance Json.FromJSON Loadout where + parseJSON = Json.withObject "Loadout" $ \object -> do + version <- Json.required object "version" + body <- Json.required object "body" + decal <- Json.required object "decal" + wheels <- Json.required object "wheels" + rocketTrail <- Json.required object "rocket_trail" + antenna <- Json.required object "antenna" + topper <- Json.required object "topper" + unknown1 <- Json.required object "unknown1" + unknown2 <- Json.optional object "unknown2" + engineAudio <- Json.optional object "engine_audio" + trail <- Json.optional object "trail" + goalExplosion <- Json.optional object "goal_explosion" + banner <- Json.optional object "banner" + unknown3 <- Json.optional object "unknown3" + unknown4 <- Json.optional object "unknown4" + unknown5 <- Json.optional object "unknown5" + unknown6 <- Json.optional object "unknown6" + pure Loadout + { version + , body + , decal + , wheels + , rocketTrail + , antenna + , topper + , unknown1 + , unknown2 + , engineAudio + , trail + , goalExplosion + , banner + , unknown3 + , unknown4 + , unknown5 + , unknown6 + } + +instance Json.ToJSON Loadout where + toJSON x = Json.object + [ Json.pair "version" $ version x + , Json.pair "body" $ body x + , Json.pair "decal" $ decal x + , Json.pair "wheels" $ wheels x + , Json.pair "rocket_trail" $ rocketTrail x + , Json.pair "antenna" $ antenna x + , Json.pair "topper" $ topper x + , Json.pair "unknown1" $ unknown1 x + , Json.pair "unknown2" $ unknown2 x + , Json.pair "engine_audio" $ engineAudio x + , Json.pair "trail" $ trail x + , Json.pair "goal_explosion" $ goalExplosion x + , Json.pair "banner" $ banner x + , Json.pair "unknown3" $ unknown3 x + , Json.pair "unknown4" $ unknown4 x + , Json.pair "unknown5" $ unknown5 x + , Json.pair "unknown6" $ unknown6 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-loadout" $ Schema.object + [ (Json.pair "version" $ Schema.ref U8.schema, True) + , (Json.pair "body" $ Schema.ref U32.schema, True) + , (Json.pair "decal" $ Schema.ref U32.schema, True) + , (Json.pair "wheels" $ Schema.ref U32.schema, True) + , (Json.pair "rocket_trail" $ Schema.ref U32.schema, True) + , (Json.pair "antenna" $ Schema.ref U32.schema, True) + , (Json.pair "topper" $ Schema.ref U32.schema, True) + , (Json.pair "unknown1" $ Schema.ref U32.schema, True) + , (Json.pair "unknown2" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "engine_audio" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "trail" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "goal_explosion" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "banner" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "unknown3" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "unknown4" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "unknown5" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "unknown6" . Schema.json $ Schema.maybe U32.schema, False) + ] + +bitPut :: Loadout -> BitPut.BitPut +bitPut loadoutAttribute = + U8.bitPut (version loadoutAttribute) + <> U32.bitPut (body loadoutAttribute) + <> U32.bitPut (decal loadoutAttribute) + <> U32.bitPut (wheels loadoutAttribute) + <> U32.bitPut (rocketTrail loadoutAttribute) + <> U32.bitPut (antenna loadoutAttribute) + <> U32.bitPut (topper loadoutAttribute) + <> U32.bitPut (unknown1 loadoutAttribute) + <> foldMap U32.bitPut (unknown2 loadoutAttribute) + <> foldMap U32.bitPut (engineAudio loadoutAttribute) + <> foldMap U32.bitPut (trail loadoutAttribute) + <> foldMap U32.bitPut (goalExplosion loadoutAttribute) + <> foldMap U32.bitPut (banner loadoutAttribute) + <> foldMap U32.bitPut (unknown3 loadoutAttribute) + <> foldMap U32.bitPut (unknown4 loadoutAttribute) + <> foldMap U32.bitPut (unknown5 loadoutAttribute) + <> foldMap U32.bitPut (unknown6 loadoutAttribute) + +bitGet :: BitGet.BitGet Loadout +bitGet = do + version_ <- U8.bitGet + Loadout version_ + <$> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 11) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 16) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 16) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 16) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 17) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 19) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 22) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 22) U32.bitGet + <*> whenMaybe (U8.toWord8 version_ >= 22) U32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/LoadoutOnline.hs b/src/lib/Rattletrap/Type/Attribute/LoadoutOnline.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/LoadoutOnline.hs @@ -0,0 +1,46 @@ +module Rattletrap.Type.Attribute.LoadoutOnline where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.Product as Product +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Map as Map + +newtype LoadoutOnline = LoadoutOnline + { value :: List.List (List.List Product.Product) + } deriving (Eq, Show) + +instance Json.FromJSON LoadoutOnline where + parseJSON = fmap LoadoutOnline . Json.parseJSON + +instance Json.ToJSON LoadoutOnline where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = + Schema.named "attribute-loadout-online" + . Schema.json + . List.schema + $ List.schema Product.schema + +bitPut :: LoadoutOnline -> BitPut.BitPut +bitPut loadoutAttribute = + let attributes = List.toList $ value loadoutAttribute + in + (U8.bitPut . U8.fromWord8 . fromIntegral $ length attributes) + <> foldMap Product.putProductAttributes attributes + +bitGet + :: Version.Version -> Map.Map U32.U32 Str.Str -> BitGet.BitGet LoadoutOnline +bitGet version objectMap = do + size <- U8.bitGet + LoadoutOnline <$> List.replicateM + (fromIntegral (U8.toWord8 size)) + (Product.decodeProductAttributesBits version objectMap) diff --git a/src/lib/Rattletrap/Type/Attribute/Loadouts.hs b/src/lib/Rattletrap/Type/Attribute/Loadouts.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Loadouts.hs @@ -0,0 +1,36 @@ +module Rattletrap.Type.Attribute.Loadouts where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.Loadout as Loadout +import qualified Rattletrap.Utility.Json as Json + +data Loadouts = Loadouts + { blue :: Loadout.Loadout + , orange :: Loadout.Loadout + } + deriving (Eq, Show) + +instance Json.FromJSON Loadouts where + parseJSON = Json.withObject "Loadouts" $ \object -> do + blue <- Json.required object "blue" + orange <- Json.required object "orange" + pure Loadouts { blue, orange } + +instance Json.ToJSON Loadouts where + toJSON x = + Json.object [Json.pair "blue" $ blue x, Json.pair "orange" $ orange x] + +schema :: Schema.Schema +schema = Schema.named "attribute-loadouts" $ Schema.object + [ (Json.pair "blue" $ Schema.ref Loadout.schema, True) + , (Json.pair "orange" $ Schema.ref Loadout.schema, True) + ] + +bitPut :: Loadouts -> BitPut.BitPut +bitPut loadoutsAttribute = Loadout.bitPut (blue loadoutsAttribute) + <> Loadout.bitPut (orange loadoutsAttribute) + +bitGet :: BitGet.BitGet Loadouts +bitGet = Loadouts <$> Loadout.bitGet <*> Loadout.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/LoadoutsOnline.hs b/src/lib/Rattletrap/Type/Attribute/LoadoutsOnline.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/LoadoutsOnline.hs @@ -0,0 +1,60 @@ +module Rattletrap.Type.Attribute.LoadoutsOnline where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.LoadoutOnline as LoadoutOnline +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Map as Map + +data LoadoutsOnline = LoadoutsOnline + { blue :: LoadoutOnline.LoadoutOnline + , orange :: LoadoutOnline.LoadoutOnline + , unknown1 :: Bool + , unknown2 :: Bool + } + deriving (Eq, Show) + +instance Json.FromJSON LoadoutsOnline where + parseJSON = Json.withObject "LoadoutsOnline" $ \object -> do + blue <- Json.required object "blue" + orange <- Json.required object "orange" + unknown1 <- Json.required object "unknown1" + unknown2 <- Json.required object "unknown2" + pure LoadoutsOnline { blue, orange, unknown1, unknown2 } + +instance Json.ToJSON LoadoutsOnline where + toJSON x = Json.object + [ Json.pair "blue" $ blue x + , Json.pair "orange" $ orange x + , Json.pair "unknown1" $ unknown1 x + , Json.pair "unknown2" $ unknown2 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-loadouts-online" $ Schema.object + [ (Json.pair "blue" $ Schema.ref LoadoutOnline.schema, True) + , (Json.pair "orange" $ Schema.ref LoadoutOnline.schema, True) + , (Json.pair "unknown1" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown2" $ Schema.ref Schema.boolean, True) + ] + +bitPut :: LoadoutsOnline -> BitPut.BitPut +bitPut loadoutsOnlineAttribute = + LoadoutOnline.bitPut (blue loadoutsOnlineAttribute) + <> LoadoutOnline.bitPut (orange loadoutsOnlineAttribute) + <> BitPut.bool (unknown1 loadoutsOnlineAttribute) + <> BitPut.bool (unknown2 loadoutsOnlineAttribute) + +bitGet + :: Version.Version -> Map.Map U32.U32 Str.Str -> BitGet.BitGet LoadoutsOnline +bitGet version objectMap = + LoadoutsOnline + <$> LoadoutOnline.bitGet version objectMap + <*> LoadoutOnline.bitGet version objectMap + <*> BitGet.bool + <*> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/Location.hs b/src/lib/Rattletrap/Type/Attribute/Location.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Location.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.Location where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +newtype Location = Location + { value :: Vector.Vector + } deriving (Eq, Show) + +instance Json.FromJSON Location where + parseJSON = fmap Location . Json.parseJSON + +instance Json.ToJSON Location where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-location" $ Schema.ref Vector.schema + +bitPut :: Location -> BitPut.BitPut +bitPut locationAttribute = Vector.bitPut (value locationAttribute) + +bitGet :: Version.Version -> BitGet.BitGet Location +bitGet version = Location <$> Vector.bitGet version diff --git a/src/lib/Rattletrap/Type/Attribute/MusicStinger.hs b/src/lib/Rattletrap/Type/Attribute/MusicStinger.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/MusicStinger.hs @@ -0,0 +1,45 @@ +module Rattletrap.Type.Attribute.MusicStinger where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json + +data MusicStinger = MusicStinger + { flag :: Bool + , cue :: U32.U32 + , trigger :: U8.U8 + } + deriving (Eq, Show) + +instance Json.FromJSON MusicStinger where + parseJSON = Json.withObject "MusicStinger" $ \object -> do + flag <- Json.required object "flag" + cue <- Json.required object "cue" + trigger <- Json.required object "trigger" + pure MusicStinger { flag, cue, trigger } + +instance Json.ToJSON MusicStinger where + toJSON x = Json.object + [ Json.pair "flag" $ flag x + , Json.pair "cue" $ cue x + , Json.pair "trigger" $ trigger x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-music-stinger" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "cue" $ Schema.ref U32.schema, True) + , (Json.pair "trigger" $ Schema.ref U8.schema, True) + ] + +bitPut :: MusicStinger -> BitPut.BitPut +bitPut musicStingerAttribute = + BitPut.bool (flag musicStingerAttribute) + <> U32.bitPut (cue musicStingerAttribute) + <> U8.bitPut (trigger musicStingerAttribute) + +bitGet :: BitGet.BitGet MusicStinger +bitGet = MusicStinger <$> BitGet.bool <*> U32.bitGet <*> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/PartyLeader.hs b/src/lib/Rattletrap/Type/Attribute/PartyLeader.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/PartyLeader.hs @@ -0,0 +1,50 @@ +module Rattletrap.Type.Attribute.PartyLeader where + +import Prelude hiding (id) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.RemoteId as RemoteId +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data PartyLeader = PartyLeader + { systemId :: U8.U8 + , id :: Maybe (RemoteId.RemoteId, U8.U8) + } + deriving (Eq, Show) + +instance Json.FromJSON PartyLeader where + parseJSON = Json.withObject "PartyLeader" $ \object -> do + systemId <- Json.required object "system_id" + id <- Json.optional object "id" + pure PartyLeader { systemId, id } + +instance Json.ToJSON PartyLeader where + toJSON x = + Json.object [Json.pair "system_id" $ systemId x, Json.pair "id" $ id x] + +schema :: Schema.Schema +schema = Schema.named "attribute-party-leader" $ Schema.object + [ (Json.pair "system_id" $ Schema.ref U8.schema, True) + , ( Json.pair "id" $ Schema.oneOf + [ Schema.tuple [Schema.ref RemoteId.schema, Schema.ref U8.schema] + , Schema.ref Schema.null + ] + , False + ) + ] + +bitPut :: PartyLeader -> BitPut.BitPut +bitPut x = U8.bitPut (systemId x) <> foldMap + (\(y, z) -> RemoteId.bitPut y <> U8.bitPut z) + (Rattletrap.Type.Attribute.PartyLeader.id x) + +bitGet :: Version.Version -> BitGet.BitGet PartyLeader +bitGet version = do + systemId_ <- U8.bitGet + PartyLeader systemId_ <$> whenMaybe + (systemId_ /= U8.fromWord8 0) + ((,) <$> RemoteId.bitGet version systemId_ <*> U8.bitGet) diff --git a/src/lib/Rattletrap/Type/Attribute/Pickup.hs b/src/lib/Rattletrap/Type/Attribute/Pickup.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Pickup.hs @@ -0,0 +1,45 @@ +module Rattletrap.Type.Attribute.Pickup where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data Pickup = Pickup + { instigatorId :: Maybe U32.U32 + , pickedUp :: Bool + } + deriving (Eq, Show) + +instance Json.FromJSON Pickup where + parseJSON = Json.withObject "Pickup" $ \object -> do + instigatorId <- Json.optional object "instigator_id" + pickedUp <- Json.required object "picked_up" + pure Pickup { instigatorId, pickedUp } + +instance Json.ToJSON Pickup where + toJSON x = Json.object + [ Json.pair "instigator_id" $ instigatorId x + , Json.pair "picked_up" $ pickedUp x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-pickup" $ Schema.object + [ (Json.pair "instigator_id" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "picked_up" $ Schema.ref Schema.boolean, True) + ] + +bitPut :: Pickup -> BitPut.BitPut +bitPut x = + maybe + (BitPut.bool False) + (\y -> BitPut.bool True <> U32.bitPut y) + (instigatorId x) + <> BitPut.bool (pickedUp x) + +bitGet :: BitGet.BitGet Pickup +bitGet = do + instigator <- BitGet.bool + Pickup <$> whenMaybe instigator U32.bitGet <*> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/PickupNew.hs b/src/lib/Rattletrap/Type/Attribute/PickupNew.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/PickupNew.hs @@ -0,0 +1,46 @@ +module Rattletrap.Type.Attribute.PickupNew where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data PickupNew = PickupNew + { instigatorId :: Maybe U32.U32 + , pickedUp :: U8.U8 + } + deriving (Eq, Show) + +instance Json.FromJSON PickupNew where + parseJSON = Json.withObject "PickupNew" $ \object -> do + instigatorId <- Json.optional object "instigator_id" + pickedUp <- Json.required object "picked_up" + pure PickupNew { instigatorId, pickedUp } + +instance Json.ToJSON PickupNew where + toJSON x = Json.object + [ Json.pair "instigator_id" $ instigatorId x + , Json.pair "picked_up" $ pickedUp x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-pickup-new" $ Schema.object + [ (Json.pair "instigator_id" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "picked_up" $ Schema.ref U8.schema, True) + ] + +bitPut :: PickupNew -> BitPut.BitPut +bitPut x = + maybe + (BitPut.bool False) + (\y -> BitPut.bool True <> U32.bitPut y) + (instigatorId x) + <> U8.bitPut (pickedUp x) + +bitGet :: BitGet.BitGet PickupNew +bitGet = do + instigator <- BitGet.bool + PickupNew <$> whenMaybe instigator U32.bitGet <*> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/PlayerHistoryKey.hs b/src/lib/Rattletrap/Type/Attribute/PlayerHistoryKey.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/PlayerHistoryKey.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.PlayerHistoryKey where + +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype PlayerHistoryKey = PlayerHistoryKey + { unknown :: Word.Word16 + } deriving (Eq, Show) + +instance Json.FromJSON PlayerHistoryKey where + parseJSON = fmap PlayerHistoryKey . Json.parseJSON + +instance Json.ToJSON PlayerHistoryKey where + toJSON = Json.toJSON . unknown + +schema :: Schema.Schema +schema = + Schema.named "attribute-player-history-key" $ Schema.ref Schema.number + +bitPut :: PlayerHistoryKey -> BitPut.BitPut +bitPut = BitPut.bits 14 . unknown + +bitGet :: BitGet.BitGet PlayerHistoryKey +bitGet = PlayerHistoryKey <$> BitGet.bits 14 diff --git a/src/lib/Rattletrap/Type/Attribute/PrivateMatchSettings.hs b/src/lib/Rattletrap/Type/Attribute/PrivateMatchSettings.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/PrivateMatchSettings.hs @@ -0,0 +1,74 @@ +module Rattletrap.Type.Attribute.PrivateMatchSettings where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json + +data PrivateMatchSettings = PrivateMatchSettings + { mutators :: Str.Str + , joinableBy :: U32.U32 + , maxPlayers :: U32.U32 + , gameName :: Str.Str + , password :: Str.Str + , flag :: Bool + } + deriving (Eq, Show) + +instance Json.FromJSON PrivateMatchSettings where + parseJSON = Json.withObject "PrivateMatchSettings" $ \object -> do + mutators <- Json.required object "mutators" + joinableBy <- Json.required object "joinable_by" + maxPlayers <- Json.required object "max_players" + gameName <- Json.required object "game_name" + password <- Json.required object "password" + flag <- Json.required object "flag" + pure PrivateMatchSettings + { mutators + , joinableBy + , maxPlayers + , gameName + , password + , flag + } + +instance Json.ToJSON PrivateMatchSettings where + toJSON x = Json.object + [ Json.pair "mutators" $ mutators x + , Json.pair "joinable_by" $ joinableBy x + , Json.pair "max_players" $ maxPlayers x + , Json.pair "game_name" $ gameName x + , Json.pair "password" $ password x + , Json.pair "flag" $ flag x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-private-match-settings" $ Schema.object + [ (Json.pair "mutators" $ Schema.ref Str.schema, True) + , (Json.pair "joinable_by" $ Schema.ref U32.schema, True) + , (Json.pair "max_players" $ Schema.ref U32.schema, True) + , (Json.pair "game_name" $ Schema.ref Str.schema, True) + , (Json.pair "password" $ Schema.ref Str.schema, True) + , (Json.pair "flag" $ Schema.ref Schema.boolean, True) + ] + +bitPut :: PrivateMatchSettings -> BitPut.BitPut +bitPut privateMatchSettingsAttribute = + Str.bitPut (mutators privateMatchSettingsAttribute) + <> U32.bitPut (joinableBy privateMatchSettingsAttribute) + <> U32.bitPut (maxPlayers privateMatchSettingsAttribute) + <> Str.bitPut (gameName privateMatchSettingsAttribute) + <> Str.bitPut (password privateMatchSettingsAttribute) + <> BitPut.bool (flag privateMatchSettingsAttribute) + +bitGet :: BitGet.BitGet PrivateMatchSettings +bitGet = + PrivateMatchSettings + <$> Str.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> Str.bitGet + <*> Str.bitGet + <*> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/Product.hs b/src/lib/Rattletrap/Type/Attribute/Product.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Product.hs @@ -0,0 +1,74 @@ +module Rattletrap.Type.Attribute.Product where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.ProductValue as ProductValue +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Map as Map + +data Product = Product + { unknown :: Bool + , objectId :: U32.U32 + , objectName :: Maybe Str.Str + -- ^ read-only + , value :: ProductValue.ProductValue + } + deriving (Eq, Show) + +instance Json.FromJSON Product where + parseJSON = Json.withObject "Product" $ \object -> do + unknown <- Json.required object "unknown" + objectId <- Json.required object "object_id" + objectName <- Json.optional object "object_name" + value <- Json.required object "value" + pure Product { unknown, objectId, objectName, value } + +instance Json.ToJSON Product where + toJSON x = Json.object + [ Json.pair "unknown" $ unknown x + , Json.pair "object_id" $ objectId x + , Json.pair "object_name" $ objectName x + , Json.pair "value" $ value x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-product" $ Schema.object + [ (Json.pair "unknown" $ Schema.ref Schema.boolean, True) + , (Json.pair "object_id" $ Schema.ref U32.schema, True) + , (Json.pair "object_name" . Schema.json $ Schema.maybe Str.schema, False) + , (Json.pair "value" $ Schema.ref ProductValue.schema, True) + ] + +putProductAttributes :: List.List Product -> BitPut.BitPut +putProductAttributes attributes = + let v = List.toList attributes + in (U8.bitPut . U8.fromWord8 . fromIntegral $ length v) <> foldMap bitPut v + +bitPut :: Product -> BitPut.BitPut +bitPut attribute = + BitPut.bool (unknown attribute) + <> U32.bitPut (objectId attribute) + <> ProductValue.bitPut (value attribute) + +decodeProductAttributesBits + :: Version.Version + -> Map.Map U32.U32 Str.Str + -> BitGet.BitGet (List.List Product) +decodeProductAttributesBits version objectMap = do + size <- U8.bitGet + List.replicateM (fromIntegral $ U8.toWord8 size) $ bitGet version objectMap + +bitGet :: Version.Version -> Map.Map U32.U32 Str.Str -> BitGet.BitGet Product +bitGet version objectMap = do + flag <- BitGet.bool + objectId_ <- U32.bitGet + let maybeObjectName = Map.lookup objectId_ objectMap + value_ <- ProductValue.bitGet version objectId_ maybeObjectName + pure (Product flag objectId_ maybeObjectName value_) diff --git a/src/lib/Rattletrap/Type/Attribute/ProductValue.hs b/src/lib/Rattletrap/Type/Attribute/ProductValue.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/ProductValue.hs @@ -0,0 +1,121 @@ +module Rattletrap.Type.Attribute.ProductValue where + +import qualified Data.Foldable as Foldable +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data ProductValue + = PaintedOld CompressedWord.CompressedWord + | PaintedNew Word.Word32 + | TeamEditionOld CompressedWord.CompressedWord + | TeamEditionNew Word.Word32 + | SpecialEdition Word.Word32 + | UserColorOld (Maybe Word.Word32) + | UserColorNew U32.U32 + | TitleId Str.Str + deriving (Eq, Show) + +instance Json.FromJSON ProductValue where + parseJSON = Json.withObject "ProductValue" $ \object -> Foldable.asum + [ PaintedOld <$> Json.required object "painted_old" + , PaintedNew <$> Json.required object "painted_new" + , TeamEditionOld <$> Json.required object "team_edition_old" + , TeamEditionNew <$> Json.required object "team_edition_new" + , SpecialEdition <$> Json.required object "special_edition" + , UserColorOld <$> Json.required object "user_color_old" + , UserColorNew <$> Json.required object "user_color_new" + , TitleId <$> Json.required object "title_id" + ] + +instance Json.ToJSON ProductValue where + toJSON x = case x of + PaintedOld y -> Json.object [Json.pair "painted_old" y] + PaintedNew y -> Json.object [Json.pair "painted_new" y] + TeamEditionOld y -> Json.object [Json.pair "team_edition_old" y] + TeamEditionNew y -> Json.object [Json.pair "team_edition_new" y] + SpecialEdition y -> Json.object [Json.pair "special_edition" y] + UserColorOld y -> Json.object [Json.pair "user_color_old" y] + UserColorNew y -> Json.object [Json.pair "user_color_new" y] + TitleId y -> Json.object [Json.pair "title_id" y] + +schema :: Schema.Schema +schema = Schema.named "attribute-product-value" . Schema.oneOf $ fmap + (\(k, v) -> Schema.object [(Json.pair k v, True)]) + [ ("painted_old", Schema.ref CompressedWord.schema) + , ("painted_new", Schema.ref Schema.integer) + , ("team_edition_old", Schema.ref CompressedWord.schema) + , ("team_edition_new", Schema.ref Schema.integer) + , ("special_edition", Schema.ref Schema.integer) + , ("user_color_old", Schema.json $ Schema.maybe Schema.integer) + , ("user_color_new", Schema.ref U32.schema) + , ("title_id", Schema.ref Str.schema) + ] + +bitPut :: ProductValue -> BitPut.BitPut +bitPut val = case val of + PaintedOld x -> CompressedWord.bitPut x + PaintedNew x -> BitPut.bits 31 x + TeamEditionOld x -> CompressedWord.bitPut x + TeamEditionNew x -> BitPut.bits 31 x + SpecialEdition x -> BitPut.bits 31 x + UserColorOld x -> case x of + Nothing -> BitPut.bool False + Just y -> BitPut.bool True <> BitPut.bits 31 y + UserColorNew x -> U32.bitPut x + TitleId x -> Str.bitPut x + +bitGet + :: Version.Version -> U32.U32 -> Maybe Str.Str -> BitGet.BitGet ProductValue +bitGet version objectId maybeObjectName = + case Str.toString <$> maybeObjectName of + Just "TAGame.ProductAttribute_Painted_TA" -> decodePainted version + Just "TAGame.ProductAttribute_SpecialEdition_TA" -> decodeSpecialEdition + Just "TAGame.ProductAttribute_TeamEdition_TA" -> decodeTeamEdition version + Just "TAGame.ProductAttribute_TitleID_TA" -> decodeTitle + Just "TAGame.ProductAttribute_UserColor_TA" -> decodeColor version + Just objectName -> fail + ("[RT05] unknown object name " + <> show objectName + <> " for ID " + <> show objectId + ) + Nothing -> fail ("[RT06] missing object name for ID " <> show objectId) + +decodeSpecialEdition :: BitGet.BitGet ProductValue +decodeSpecialEdition = SpecialEdition <$> BitGet.bits 31 + +decodePainted :: Version.Version -> BitGet.BitGet ProductValue +decodePainted version = if hasNewPainted version + then PaintedNew <$> BitGet.bits 31 + else PaintedOld <$> CompressedWord.bitGet 13 + +decodeTeamEdition :: Version.Version -> BitGet.BitGet ProductValue +decodeTeamEdition version = if hasNewPainted version + then TeamEditionNew <$> BitGet.bits 31 + else TeamEditionOld <$> CompressedWord.bitGet 13 + +decodeColor :: Version.Version -> BitGet.BitGet ProductValue +decodeColor version = if hasNewColor version + then UserColorNew <$> U32.bitGet + else do + hasValue <- BitGet.bool + UserColorOld <$> whenMaybe hasValue (BitGet.bits 31) + +hasNewPainted :: Version.Version -> Bool +hasNewPainted v = + Version.major v >= 868 && Version.minor v >= 18 && Version.patch v >= 0 + +hasNewColor :: Version.Version -> Bool +hasNewColor v = + Version.major v >= 868 && Version.minor v >= 23 && Version.patch v >= 8 + +decodeTitle :: BitGet.BitGet ProductValue +decodeTitle = TitleId <$> Str.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/QWord.hs b/src/lib/Rattletrap/Type/Attribute/QWord.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/QWord.hs @@ -0,0 +1,26 @@ +module Rattletrap.Type.Attribute.QWord where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U64 as U64 +import qualified Rattletrap.Utility.Json as Json + +newtype QWord = QWord + { value :: U64.U64 + } deriving (Eq, Show) + +instance Json.FromJSON QWord where + parseJSON = fmap QWord . Json.parseJSON + +instance Json.ToJSON QWord where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-q-word" $ Schema.ref U64.schema + +bitPut :: QWord -> BitPut.BitPut +bitPut qWordAttribute = U64.bitPut (value qWordAttribute) + +bitGet :: BitGet.BitGet QWord +bitGet = QWord <$> U64.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Reservation.hs b/src/lib/Rattletrap/Type/Attribute/Reservation.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Reservation.hs @@ -0,0 +1,76 @@ +module Rattletrap.Type.Attribute.Reservation where + +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.UniqueId as UniqueId +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data Reservation = Reservation + { number :: CompressedWord.CompressedWord + , uniqueId :: UniqueId.UniqueId + , name :: Maybe Str.Str + , unknown1 :: Bool + , unknown2 :: Bool + , unknown3 :: Maybe Word.Word8 + } + deriving (Eq, Show) + +instance Json.FromJSON Reservation where + parseJSON = Json.withObject "Reservation" $ \object -> do + number <- Json.required object "number" + uniqueId <- Json.required object "unique_id" + name <- Json.optional object "name" + unknown1 <- Json.required object "unknown1" + unknown2 <- Json.required object "unknown2" + unknown3 <- Json.optional object "unknown3" + pure Reservation { number, uniqueId, name, unknown1, unknown2, unknown3 } + +instance Json.ToJSON Reservation where + toJSON x = Json.object + [ Json.pair "number" $ number x + , Json.pair "unique_id" $ uniqueId x + , Json.pair "name" $ name x + , Json.pair "unknown1" $ unknown1 x + , Json.pair "unknown2" $ unknown2 x + , Json.pair "unknown3" $ unknown3 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-reservation" $ Schema.object + [ (Json.pair "number" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "unique_id" $ Schema.ref UniqueId.schema, True) + , (Json.pair "name" . Schema.json $ Schema.maybe Str.schema, False) + , (Json.pair "unknown1" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown2" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown3" . Schema.json $ Schema.maybe Schema.integer, False) + ] + +bitPut :: Reservation -> BitPut.BitPut +bitPut reservationAttribute = + CompressedWord.bitPut (number reservationAttribute) + <> UniqueId.bitPut (uniqueId reservationAttribute) + <> foldMap Str.bitPut (name reservationAttribute) + <> BitPut.bool (unknown1 reservationAttribute) + <> BitPut.bool (unknown2 reservationAttribute) + <> foldMap (BitPut.word8 6) (unknown3 reservationAttribute) + +bitGet :: Version.Version -> BitGet.BitGet Reservation +bitGet version = do + number_ <- CompressedWord.bitGet 7 + uniqueId_ <- UniqueId.bitGet version + Reservation number_ uniqueId_ + <$> whenMaybe (UniqueId.systemId uniqueId_ /= U8.fromWord8 0) Str.bitGet + <*> BitGet.bool + <*> BitGet.bool + <*> whenMaybe (hasUnknown3 version) (BitGet.word8 6) + +hasUnknown3 :: Version.Version -> Bool +hasUnknown3 v = + Version.major v >= 868 && Version.minor v >= 12 && Version.patch v >= 0 diff --git a/src/lib/Rattletrap/Type/Attribute/RigidBodyState.hs b/src/lib/Rattletrap/Type/Attribute/RigidBodyState.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/RigidBodyState.hs @@ -0,0 +1,73 @@ +module Rattletrap.Type.Attribute.RigidBodyState where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Rotation as Rotation +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +data RigidBodyState = RigidBodyState + { sleeping :: Bool + , location :: Vector.Vector + , rotation :: Rotation.Rotation + , linearVelocity :: Maybe Vector.Vector + , angularVelocity :: Maybe Vector.Vector + } + deriving (Eq, Show) + +instance Json.FromJSON RigidBodyState where + parseJSON = Json.withObject "RigidBodyState" $ \object -> do + sleeping <- Json.required object "sleeping" + location <- Json.required object "location" + rotation <- Json.required object "rotation" + linearVelocity <- Json.optional object "linear_velocity" + angularVelocity <- Json.optional object "angular_velocity" + pure RigidBodyState + { sleeping + , location + , rotation + , linearVelocity + , angularVelocity + } + +instance Json.ToJSON RigidBodyState where + toJSON x = Json.object + [ Json.pair "sleeping" $ sleeping x + , Json.pair "location" $ location x + , Json.pair "rotation" $ rotation x + , Json.pair "linear_velocity" $ linearVelocity x + , Json.pair "angular_velocity" $ angularVelocity x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-rigid-body-state" $ Schema.object + [ (Json.pair "sleeping" $ Schema.ref Schema.boolean, True) + , (Json.pair "location" $ Schema.ref Vector.schema, True) + , (Json.pair "rotation" $ Schema.ref Rotation.schema, True) + , ( Json.pair "linear_velocity" . Schema.json $ Schema.maybe Vector.schema + , False + ) + , ( Json.pair "angular_velocity" . Schema.json $ Schema.maybe Vector.schema + , False + ) + ] + +bitPut :: RigidBodyState -> BitPut.BitPut +bitPut rigidBodyStateAttribute = + BitPut.bool (sleeping rigidBodyStateAttribute) + <> Vector.bitPut (location rigidBodyStateAttribute) + <> Rotation.bitPut (rotation rigidBodyStateAttribute) + <> foldMap Vector.bitPut (linearVelocity rigidBodyStateAttribute) + <> foldMap Vector.bitPut (angularVelocity rigidBodyStateAttribute) + +bitGet :: Version.Version -> BitGet.BitGet RigidBodyState +bitGet version = do + sleeping_ <- BitGet.bool + RigidBodyState sleeping_ + <$> Vector.bitGet version + <*> Rotation.bitGet version + <*> whenMaybe (not sleeping_) (Vector.bitGet version) + <*> whenMaybe (not sleeping_) (Vector.bitGet version) diff --git a/src/lib/Rattletrap/Type/Attribute/StatEvent.hs b/src/lib/Rattletrap/Type/Attribute/StatEvent.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/StatEvent.hs @@ -0,0 +1,36 @@ +module Rattletrap.Type.Attribute.StatEvent where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Utility.Json as Json + +data StatEvent = StatEvent + { unknown :: Bool + , objectId :: I32.I32 + } + deriving (Eq, Show) + +instance Json.FromJSON StatEvent where + parseJSON = Json.withObject "StatEvent" $ \object -> do + unknown <- Json.required object "unknown" + objectId <- Json.required object "object_id" + pure StatEvent { unknown, objectId } + +instance Json.ToJSON StatEvent where + toJSON x = Json.object + [Json.pair "unknown" $ unknown x, Json.pair "object_id" $ objectId x] + +schema :: Schema.Schema +schema = Schema.named "attribute-stat-event" $ Schema.object + [ (Json.pair "unknown" $ Schema.ref Schema.boolean, True) + , (Json.pair "object_id" $ Schema.ref I32.schema, True) + ] + +bitPut :: StatEvent -> BitPut.BitPut +bitPut statEventAttribute = BitPut.bool (unknown statEventAttribute) + <> I32.bitPut (objectId statEventAttribute) + +bitGet :: BitGet.BitGet StatEvent +bitGet = StatEvent <$> BitGet.bool <*> I32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/String.hs b/src/lib/Rattletrap/Type/Attribute/String.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/String.hs @@ -0,0 +1,27 @@ +module Rattletrap.Type.Attribute.String where + +import Prelude hiding (String) +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Utility.Json as Json + +newtype String = String + { value :: Str.Str + } deriving (Eq, Show) + +instance Json.FromJSON String where + parseJSON = fmap String . Json.parseJSON + +instance Json.ToJSON String where + toJSON = Json.toJSON . value + +schema :: Schema.Schema +schema = Schema.named "attribute-string" $ Schema.ref Str.schema + +bitPut :: String -> BitPut.BitPut +bitPut stringAttribute = Str.bitPut (value stringAttribute) + +bitGet :: BitGet.BitGet String +bitGet = String <$> Str.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/TeamPaint.hs b/src/lib/Rattletrap/Type/Attribute/TeamPaint.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/TeamPaint.hs @@ -0,0 +1,67 @@ +module Rattletrap.Type.Attribute.TeamPaint where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json + +data TeamPaint = TeamPaint + { team :: U8.U8 + , primaryColor :: U8.U8 + , accentColor :: U8.U8 + , primaryFinish :: U32.U32 + , accentFinish :: U32.U32 + } + deriving (Eq, Show) + +instance Json.FromJSON TeamPaint where + parseJSON = Json.withObject "TeamPaint" $ \object -> do + team <- Json.required object "team" + primaryColor <- Json.required object "primary_color" + accentColor <- Json.required object "accent_color" + primaryFinish <- Json.required object "primary_finish" + accentFinish <- Json.required object "accent_finish" + pure TeamPaint + { team + , primaryColor + , accentColor + , primaryFinish + , accentFinish + } + +instance Json.ToJSON TeamPaint where + toJSON x = Json.object + [ Json.pair "team" $ team x + , Json.pair "primary_color" $ primaryColor x + , Json.pair "accent_color" $ accentColor x + , Json.pair "primary_finish" $ primaryFinish x + , Json.pair "accent_finish" $ accentFinish x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-team-paint" $ Schema.object + [ (Json.pair "team" $ Schema.ref U8.schema, True) + , (Json.pair "primary_color" $ Schema.ref U8.schema, True) + , (Json.pair "accent_color" $ Schema.ref U8.schema, True) + , (Json.pair "primary_finish" $ Schema.ref U32.schema, True) + , (Json.pair "accent_finish" $ Schema.ref U32.schema, True) + ] + +bitPut :: TeamPaint -> BitPut.BitPut +bitPut teamPaintAttribute = + U8.bitPut (team teamPaintAttribute) + <> U8.bitPut (primaryColor teamPaintAttribute) + <> U8.bitPut (accentColor teamPaintAttribute) + <> U32.bitPut (primaryFinish teamPaintAttribute) + <> U32.bitPut (accentFinish teamPaintAttribute) + +bitGet :: BitGet.BitGet TeamPaint +bitGet = + TeamPaint + <$> U8.bitGet + <*> U8.bitGet + <*> U8.bitGet + <*> U32.bitGet + <*> U32.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/Title.hs b/src/lib/Rattletrap/Type/Attribute/Title.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/Title.hs @@ -0,0 +1,87 @@ +module Rattletrap.Type.Attribute.Title where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json + +data Title = Title + { unknown1 :: Bool + , unknown2 :: Bool + , unknown3 :: U32.U32 + , unknown4 :: U32.U32 + , unknown5 :: U32.U32 + , unknown6 :: U32.U32 + , unknown7 :: U32.U32 + , unknown8 :: Bool + } + deriving (Eq, Show) + +instance Json.FromJSON Title where + parseJSON = Json.withObject "Title" $ \object -> do + unknown1 <- Json.required object "unknown1" + unknown2 <- Json.required object "unknown2" + unknown3 <- Json.required object "unknown3" + unknown4 <- Json.required object "unknown4" + unknown5 <- Json.required object "unknown5" + unknown6 <- Json.required object "unknown6" + unknown7 <- Json.required object "unknown7" + unknown8 <- Json.required object "unknown8" + pure Title + { unknown1 + , unknown2 + , unknown3 + , unknown4 + , unknown5 + , unknown6 + , unknown7 + , unknown8 + } + +instance Json.ToJSON Title where + toJSON x = Json.object + [ Json.pair "unknown1" $ unknown1 x + , Json.pair "unknown2" $ unknown2 x + , Json.pair "unknown3" $ unknown3 x + , Json.pair "unknown4" $ unknown4 x + , Json.pair "unknown5" $ unknown5 x + , Json.pair "unknown6" $ unknown6 x + , Json.pair "unknown7" $ unknown7 x + , Json.pair "unknown8" $ unknown8 x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-title" $ Schema.object + [ (Json.pair "unknown1" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown2" $ Schema.ref Schema.boolean, True) + , (Json.pair "unknown3" $ Schema.ref U32.schema, True) + , (Json.pair "unknown4" $ Schema.ref U32.schema, True) + , (Json.pair "unknown5" $ Schema.ref U32.schema, True) + , (Json.pair "unknown6" $ Schema.ref U32.schema, True) + , (Json.pair "unknown7" $ Schema.ref U32.schema, True) + , (Json.pair "unknown8" $ Schema.ref Schema.boolean, True) + ] + +bitPut :: Title -> BitPut.BitPut +bitPut titleAttribute = + BitPut.bool (unknown1 titleAttribute) + <> BitPut.bool (unknown2 titleAttribute) + <> U32.bitPut (unknown3 titleAttribute) + <> U32.bitPut (unknown4 titleAttribute) + <> U32.bitPut (unknown5 titleAttribute) + <> U32.bitPut (unknown6 titleAttribute) + <> U32.bitPut (unknown7 titleAttribute) + <> BitPut.bool (unknown8 titleAttribute) + +bitGet :: BitGet.BitGet Title +bitGet = + Title + <$> BitGet.bool + <*> BitGet.bool + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> U32.bitGet + <*> BitGet.bool diff --git a/src/lib/Rattletrap/Type/Attribute/UniqueId.hs b/src/lib/Rattletrap/Type/Attribute/UniqueId.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/UniqueId.hs @@ -0,0 +1,48 @@ +module Rattletrap.Type.Attribute.UniqueId where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.RemoteId as RemoteId +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data UniqueId = UniqueId + { systemId :: U8.U8 + , remoteId :: RemoteId.RemoteId + , localId :: U8.U8 + } + deriving (Eq, Show) + +instance Json.FromJSON UniqueId where + parseJSON = Json.withObject "UniqueId" $ \object -> do + systemId <- Json.required object "system_id" + remoteId <- Json.required object "remote_id" + localId <- Json.required object "local_id" + pure UniqueId { systemId, remoteId, localId } + +instance Json.ToJSON UniqueId where + toJSON x = Json.object + [ Json.pair "system_id" $ systemId x + , Json.pair "remote_id" $ remoteId x + , Json.pair "local_id" $ localId x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-unique-id" $ Schema.object + [ (Json.pair "system_id" $ Schema.ref U8.schema, True) + , (Json.pair "remote_id" $ Schema.ref RemoteId.schema, True) + , (Json.pair "local_id" $ Schema.ref U8.schema, True) + ] + +bitPut :: UniqueId -> BitPut.BitPut +bitPut uniqueIdAttribute = + U8.bitPut (systemId uniqueIdAttribute) + <> RemoteId.bitPut (remoteId uniqueIdAttribute) + <> U8.bitPut (localId uniqueIdAttribute) + +bitGet :: Version.Version -> BitGet.BitGet UniqueId +bitGet version = do + systemId_ <- U8.bitGet + UniqueId systemId_ <$> RemoteId.bitGet version systemId_ <*> U8.bitGet diff --git a/src/lib/Rattletrap/Type/Attribute/WeldedInfo.hs b/src/lib/Rattletrap/Type/Attribute/WeldedInfo.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Attribute/WeldedInfo.hs @@ -0,0 +1,64 @@ +module Rattletrap.Type.Attribute.WeldedInfo where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.Int8Vector as Int8Vector +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +data WeldedInfo = WeldedInfo + { active :: Bool + , actorId :: I32.I32 + , offset :: Vector.Vector + , mass :: F32.F32 + , rotation :: Int8Vector.Int8Vector + } + deriving (Eq, Show) + +instance Json.FromJSON WeldedInfo where + parseJSON = Json.withObject "WeldedInfo" $ \object -> do + active <- Json.required object "active" + actorId <- Json.required object "actor_id" + offset <- Json.required object "offset" + mass <- Json.required object "mass" + rotation <- Json.required object "rotation" + pure WeldedInfo { active, actorId, offset, mass, rotation } + +instance Json.ToJSON WeldedInfo where + toJSON x = Json.object + [ Json.pair "active" $ active x + , Json.pair "actor_id" $ actorId x + , Json.pair "offset" $ offset x + , Json.pair "mass" $ mass x + , Json.pair "rotation" $ rotation x + ] + +schema :: Schema.Schema +schema = Schema.named "attribute-welded-info" $ Schema.object + [ (Json.pair "active" $ Schema.ref Schema.boolean, True) + , (Json.pair "actor_id" $ Schema.ref I32.schema, True) + , (Json.pair "offset" $ Schema.ref Vector.schema, True) + , (Json.pair "mass" $ Schema.ref F32.schema, True) + , (Json.pair "rotation" $ Schema.ref Int8Vector.schema, True) + ] + +bitPut :: WeldedInfo -> BitPut.BitPut +bitPut weldedInfoAttribute = + BitPut.bool (active weldedInfoAttribute) + <> I32.bitPut (actorId weldedInfoAttribute) + <> Vector.bitPut (offset weldedInfoAttribute) + <> F32.bitPut (mass weldedInfoAttribute) + <> Int8Vector.bitPut (rotation weldedInfoAttribute) + +bitGet :: Version.Version -> BitGet.BitGet WeldedInfo +bitGet version = + WeldedInfo + <$> BitGet.bool + <*> I32.bitGet + <*> Vector.bitGet version + <*> F32.bitGet + <*> Int8Vector.bitGet diff --git a/src/lib/Rattletrap/Type/AttributeMapping.hs b/src/lib/Rattletrap/Type/AttributeMapping.hs --- a/src/lib/Rattletrap/Type/AttributeMapping.hs +++ b/src/lib/Rattletrap/Type/AttributeMapping.hs @@ -1,16 +1,35 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.AttributeMapping - ( AttributeMapping(..) - ) -where +module Rattletrap.Type.AttributeMapping where -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data AttributeMapping = AttributeMapping - { attributeMappingObjectId :: Word32le - , attributeMappingStreamId :: Word32le - } deriving (Eq, Ord, Show) + { objectId :: U32.U32 + , streamId :: U32.U32 + } + deriving (Eq, Show) -$(deriveJson ''AttributeMapping) +instance Json.FromJSON AttributeMapping where + parseJSON = Json.withObject "AttributeMapping" $ \object -> do + objectId <- Json.required object "object_id" + streamId <- Json.required object "stream_id" + pure AttributeMapping { objectId, streamId } + +instance Json.ToJSON AttributeMapping where + toJSON x = Json.object + [Json.pair "object_id" $ objectId x, Json.pair "stream_id" $ streamId x] + +schema :: Schema.Schema +schema = Schema.named "attributeMapping" $ Schema.object + [ (Json.pair "object_id" $ Schema.ref U32.schema, True) + , (Json.pair "stream_id" $ Schema.ref U32.schema, True) + ] + +bytePut :: AttributeMapping -> BytePut.BytePut +bytePut x = U32.bytePut (objectId x) <> U32.bytePut (streamId x) + +byteGet :: ByteGet.ByteGet AttributeMapping +byteGet = AttributeMapping <$> U32.byteGet <*> U32.byteGet diff --git a/src/lib/Rattletrap/Type/AttributeType.hs b/src/lib/Rattletrap/Type/AttributeType.hs --- a/src/lib/Rattletrap/Type/AttributeType.hs +++ b/src/lib/Rattletrap/Type/AttributeType.hs @@ -1,50 +1,41 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.AttributeType - ( AttributeType(..) - ) -where - -import Rattletrap.Type.Common +module Rattletrap.Type.AttributeType where data AttributeType - = AttributeTypeAppliedDamage - | AttributeTypeBoolean - | AttributeTypeByte - | AttributeTypeCamSettings - | AttributeTypeClubColors - | AttributeTypeCustomDemolish - | AttributeTypeDamageState - | AttributeTypeDemolish - | AttributeTypeEnum - | AttributeTypeExplosion - | AttributeTypeExtendedExplosion - | AttributeTypeFlaggedInt - | AttributeTypeFlaggedByte - | AttributeTypeFloat - | AttributeTypeGameMode - | AttributeTypeInt - | AttributeTypeInt64 - | AttributeTypeLoadout - | AttributeTypeLoadoutOnline - | AttributeTypeLoadouts - | AttributeTypeLoadoutsOnline - | AttributeTypeLocation - | AttributeTypeMusicStinger - | AttributeTypePartyLeader - | AttributeTypePickup - | AttributeTypePickupNew - | AttributeTypePlayerHistoryKey - | AttributeTypePrivateMatchSettings - | AttributeTypeQWord - | AttributeTypeReservation - | AttributeTypeRigidBodyState - | AttributeTypeStatEvent - | AttributeTypeString - | AttributeTypeTeamPaint - | AttributeTypeTitle - | AttributeTypeUniqueId - | AttributeTypeWeldedInfo - deriving (Eq, Ord, Show) - -$(deriveJson ''AttributeType) + = AppliedDamage + | Boolean + | Byte + | CamSettings + | ClubColors + | CustomDemolish + | DamageState + | Demolish + | Enum + | Explosion + | ExtendedExplosion + | FlaggedInt + | FlaggedByte + | Float + | GameMode + | Int + | Int64 + | Loadout + | LoadoutOnline + | Loadouts + | LoadoutsOnline + | Location + | MusicStinger + | PartyLeader + | Pickup + | PickupNew + | PlayerHistoryKey + | PrivateMatchSettings + | QWord + | Reservation + | RigidBodyState + | StatEvent + | String + | TeamPaint + | Title + | UniqueId + | WeldedInfo + deriving (Eq, Show) diff --git a/src/lib/Rattletrap/Type/AttributeValue.hs b/src/lib/Rattletrap/Type/AttributeValue.hs --- a/src/lib/Rattletrap/Type/AttributeValue.hs +++ b/src/lib/Rattletrap/Type/AttributeValue.hs @@ -1,87 +1,312 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.AttributeValue where -module Rattletrap.Type.AttributeValue - ( AttributeValue(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Data as Data +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute.AppliedDamage as AppliedDamage +import qualified Rattletrap.Type.Attribute.Boolean as Boolean +import qualified Rattletrap.Type.Attribute.Byte as Byte +import qualified Rattletrap.Type.Attribute.CamSettings as CamSettings +import qualified Rattletrap.Type.Attribute.ClubColors as ClubColors +import qualified Rattletrap.Type.Attribute.CustomDemolish as CustomDemolish +import qualified Rattletrap.Type.Attribute.DamageState as DamageState +import qualified Rattletrap.Type.Attribute.Demolish as Demolish +import qualified Rattletrap.Type.Attribute.Enum as Enum +import qualified Rattletrap.Type.Attribute.Explosion as Explosion +import qualified Rattletrap.Type.Attribute.ExtendedExplosion as ExtendedExplosion +import qualified Rattletrap.Type.Attribute.FlaggedByte as FlaggedByte +import qualified Rattletrap.Type.Attribute.FlaggedInt as FlaggedInt +import qualified Rattletrap.Type.Attribute.Float as Float +import qualified Rattletrap.Type.Attribute.GameMode as GameMode +import qualified Rattletrap.Type.Attribute.Int as Int +import qualified Rattletrap.Type.Attribute.Int64 as Int64 +import qualified Rattletrap.Type.Attribute.Loadout as Loadout +import qualified Rattletrap.Type.Attribute.LoadoutOnline as LoadoutOnline +import qualified Rattletrap.Type.Attribute.Loadouts as Loadouts +import qualified Rattletrap.Type.Attribute.LoadoutsOnline as LoadoutsOnline +import qualified Rattletrap.Type.Attribute.Location as Location +import qualified Rattletrap.Type.Attribute.MusicStinger as MusicStinger +import qualified Rattletrap.Type.Attribute.PartyLeader as PartyLeader +import qualified Rattletrap.Type.Attribute.Pickup as Pickup +import qualified Rattletrap.Type.Attribute.PickupNew as PickupNew +import qualified Rattletrap.Type.Attribute.PlayerHistoryKey as PlayerHistoryKey +import qualified Rattletrap.Type.Attribute.PrivateMatchSettings as PrivateMatchSettings +import qualified Rattletrap.Type.Attribute.QWord as QWord +import qualified Rattletrap.Type.Attribute.Reservation as Reservation +import qualified Rattletrap.Type.Attribute.RigidBodyState as RigidBodyState +import qualified Rattletrap.Type.Attribute.StatEvent as StatEvent +import qualified Rattletrap.Type.Attribute.String as String +import qualified Rattletrap.Type.Attribute.TeamPaint as TeamPaint +import qualified Rattletrap.Type.Attribute.Title as Title +import qualified Rattletrap.Type.Attribute.UniqueId as UniqueId +import qualified Rattletrap.Type.Attribute.WeldedInfo as WeldedInfo +import qualified Rattletrap.Type.AttributeType as AttributeType +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.AppliedDamageAttribute -import Rattletrap.Type.BooleanAttribute -import Rattletrap.Type.ByteAttribute -import Rattletrap.Type.CamSettingsAttribute -import Rattletrap.Type.ClubColorsAttribute -import Rattletrap.Type.Common -import Rattletrap.Type.CustomDemolishAttribute -import Rattletrap.Type.DamageStateAttribute -import Rattletrap.Type.DemolishAttribute -import Rattletrap.Type.EnumAttribute -import Rattletrap.Type.ExplosionAttribute -import Rattletrap.Type.ExtendedExplosionAttribute -import Rattletrap.Type.FlaggedIntAttribute -import Rattletrap.Type.FlaggedByteAttribute -import Rattletrap.Type.FloatAttribute -import Rattletrap.Type.GameModeAttribute -import Rattletrap.Type.Int64Attribute -import Rattletrap.Type.IntAttribute -import Rattletrap.Type.LoadoutAttribute -import Rattletrap.Type.LoadoutOnlineAttribute -import Rattletrap.Type.LoadoutsAttribute -import Rattletrap.Type.LoadoutsOnlineAttribute -import Rattletrap.Type.LocationAttribute -import Rattletrap.Type.MusicStingerAttribute -import Rattletrap.Type.PartyLeaderAttribute -import Rattletrap.Type.PickupAttribute -import Rattletrap.Type.PickupAttributeNew -import Rattletrap.Type.PlayerHistoryKeyAttribute -import Rattletrap.Type.PrivateMatchSettingsAttribute -import Rattletrap.Type.QWordAttribute -import Rattletrap.Type.ReservationAttribute -import Rattletrap.Type.RigidBodyStateAttribute -import Rattletrap.Type.StatEventAttribute -import Rattletrap.Type.StringAttribute -import Rattletrap.Type.TeamPaintAttribute -import Rattletrap.Type.TitleAttribute -import Rattletrap.Type.UniqueIdAttribute -import Rattletrap.Type.WeldedInfoAttribute +import qualified Data.Foldable as Foldable +import qualified Data.Map as Map data AttributeValue - = AttributeValueAppliedDamage AppliedDamageAttribute - | AttributeValueBoolean BooleanAttribute - | AttributeValueByte ByteAttribute - | AttributeValueCamSettings CamSettingsAttribute - | AttributeValueClubColors ClubColorsAttribute - | AttributeValueCustomDemolish CustomDemolishAttribute - | AttributeValueDamageState DamageStateAttribute - | AttributeValueDemolish DemolishAttribute - | AttributeValueEnum EnumAttribute - | AttributeValueExplosion ExplosionAttribute - | AttributeValueExtendedExplosion ExtendedExplosionAttribute - | AttributeValueFlaggedInt FlaggedIntAttribute - | AttributeValueFlaggedByte FlaggedByteAttribute - | AttributeValueFloat FloatAttribute - | AttributeValueGameMode GameModeAttribute - | AttributeValueInt IntAttribute - | AttributeValueInt64 Int64Attribute - | AttributeValueLoadout LoadoutAttribute - | AttributeValueLoadoutOnline LoadoutOnlineAttribute - | AttributeValueLoadouts LoadoutsAttribute - | AttributeValueLoadoutsOnline LoadoutsOnlineAttribute - | AttributeValueLocation LocationAttribute - | AttributeValueMusicStinger MusicStingerAttribute - | AttributeValuePartyLeader PartyLeaderAttribute - | AttributeValuePickup PickupAttribute - | AttributeValuePickupNew PickupAttributeNew - | AttributeValuePlayerHistoryKey PlayerHistoryKeyAttribute - | AttributeValuePrivateMatchSettings PrivateMatchSettingsAttribute - | AttributeValueQWord QWordAttribute - | AttributeValueReservation ReservationAttribute - | AttributeValueRigidBodyState RigidBodyStateAttribute - | AttributeValueStatEvent StatEventAttribute - | AttributeValueString StringAttribute - | AttributeValueTeamPaint TeamPaintAttribute - | AttributeValueTitle TitleAttribute - | AttributeValueUniqueId UniqueIdAttribute - | AttributeValueWeldedInfo WeldedInfoAttribute - deriving (Eq, Ord, Show) + = AppliedDamage AppliedDamage.AppliedDamage + | Boolean Boolean.Boolean + | Byte Byte.Byte + | CamSettings CamSettings.CamSettings + | ClubColors ClubColors.ClubColors + | CustomDemolish CustomDemolish.CustomDemolish + | DamageState DamageState.DamageState + | Demolish Demolish.Demolish + | Enum Enum.Enum + | Explosion Explosion.Explosion + | ExtendedExplosion ExtendedExplosion.ExtendedExplosion + | FlaggedInt FlaggedInt.FlaggedInt + | FlaggedByte FlaggedByte.FlaggedByte + | Float Float.Float + | GameMode GameMode.GameMode + | Int Int.Int + | Int64 Int64.Int64 + | Loadout Loadout.Loadout + | LoadoutOnline LoadoutOnline.LoadoutOnline + | Loadouts Loadouts.Loadouts + | LoadoutsOnline LoadoutsOnline.LoadoutsOnline + | Location Location.Location + | MusicStinger MusicStinger.MusicStinger + | PartyLeader PartyLeader.PartyLeader + | Pickup Pickup.Pickup + | PickupNew PickupNew.PickupNew + | PlayerHistoryKey PlayerHistoryKey.PlayerHistoryKey + | PrivateMatchSettings PrivateMatchSettings.PrivateMatchSettings + | QWord QWord.QWord + | Reservation Reservation.Reservation + | RigidBodyState RigidBodyState.RigidBodyState + | StatEvent StatEvent.StatEvent + | String String.String + | TeamPaint TeamPaint.TeamPaint + | Title Title.Title + | UniqueId UniqueId.UniqueId + | WeldedInfo WeldedInfo.WeldedInfo + deriving (Eq, Show) -$(deriveJson ''AttributeValue) +instance Json.FromJSON AttributeValue where + parseJSON = Json.withObject "AttributeValue" $ \object -> Foldable.asum + [ AppliedDamage <$> Json.required object "applied_damage" + , Boolean <$> Json.required object "boolean" + , Byte <$> Json.required object "byte" + , CamSettings <$> Json.required object "cam_settings" + , ClubColors <$> Json.required object "club_colors" + , CustomDemolish <$> Json.required object "custom_demolish" + , DamageState <$> Json.required object "damage_state" + , Demolish <$> Json.required object "demolish" + , Enum <$> Json.required object "enum" + , Explosion <$> Json.required object "explosion" + , ExtendedExplosion <$> Json.required object "extended_explosion" + , FlaggedByte <$> Json.required object "flagged_byte" + , FlaggedInt <$> Json.required object "flagged_int" + , Float <$> Json.required object "float" + , GameMode <$> Json.required object "game_mode" + , Int <$> Json.required object "int" + , Int64 <$> Json.required object "int64" + , Loadout <$> Json.required object "loadout" + , LoadoutOnline <$> Json.required object "loadout_online" + , Loadouts <$> Json.required object "loadouts" + , LoadoutsOnline <$> Json.required object "loadouts_online" + , Location <$> Json.required object "location" + , MusicStinger <$> Json.required object "music_stinger" + , PartyLeader <$> Json.required object "party_leader" + , Pickup <$> Json.required object "pickup" + , PickupNew <$> Json.required object "pickup_new" + , PlayerHistoryKey <$> Json.required object "player_history_key" + , PrivateMatchSettings <$> Json.required object "private_match_settings" + , QWord <$> Json.required object "q_word" + , Reservation <$> Json.required object "reservation" + , RigidBodyState <$> Json.required object "rigid_body_state" + , StatEvent <$> Json.required object "stat_event" + , String <$> Json.required object "string" + , TeamPaint <$> Json.required object "team_paint" + , Title <$> Json.required object "title" + , UniqueId <$> Json.required object "unique_id" + , WeldedInfo <$> Json.required object "welded_info" + ] + +instance Json.ToJSON AttributeValue where + toJSON x = case x of + AppliedDamage y -> Json.object [Json.pair "applied_damage" y] + Boolean y -> Json.object [Json.pair "boolean" y] + Byte y -> Json.object [Json.pair "byte" y] + CamSettings y -> Json.object [Json.pair "cam_settings" y] + ClubColors y -> Json.object [Json.pair "club_colors" y] + CustomDemolish y -> Json.object [Json.pair "custom_demolish" y] + DamageState y -> Json.object [Json.pair "damage_state" y] + Demolish y -> Json.object [Json.pair "demolish" y] + Enum y -> Json.object [Json.pair "enum" y] + Explosion y -> Json.object [Json.pair "explosion" y] + ExtendedExplosion y -> Json.object [Json.pair "extended_explosion" y] + FlaggedByte y -> Json.object [Json.pair "flagged_byte" y] + FlaggedInt y -> Json.object [Json.pair "flagged_int" y] + Float y -> Json.object [Json.pair "float" y] + GameMode y -> Json.object [Json.pair "game_mode" y] + Int y -> Json.object [Json.pair "int" y] + Int64 y -> Json.object [Json.pair "int64" y] + Loadout y -> Json.object [Json.pair "loadout" y] + LoadoutOnline y -> Json.object [Json.pair "loadout_online" y] + Loadouts y -> Json.object [Json.pair "loadouts" y] + LoadoutsOnline y -> Json.object [Json.pair "loadouts_online" y] + Location y -> Json.object [Json.pair "location" y] + MusicStinger y -> Json.object [Json.pair "music_stinger" y] + PartyLeader y -> Json.object [Json.pair "party_leader" y] + Pickup y -> Json.object [Json.pair "pickup" y] + PickupNew y -> Json.object [Json.pair "pickup_new" y] + PlayerHistoryKey y -> Json.object [Json.pair "player_history_key" y] + PrivateMatchSettings y -> + Json.object [Json.pair "private_match_settings" y] + QWord y -> Json.object [Json.pair "q_word" y] + Reservation y -> Json.object [Json.pair "reservation" y] + RigidBodyState y -> Json.object [Json.pair "rigid_body_state" y] + StatEvent y -> Json.object [Json.pair "stat_event" y] + String y -> Json.object [Json.pair "string" y] + TeamPaint y -> Json.object [Json.pair "team_paint" y] + Title y -> Json.object [Json.pair "title" y] + UniqueId y -> Json.object [Json.pair "unique_id" y] + WeldedInfo y -> Json.object [Json.pair "welded_info" y] + +schema :: Schema.Schema +schema = Schema.named "attribute-value" . Schema.oneOf $ fmap + (\(k, v) -> Schema.object [(Json.pair k $ Schema.ref v, True)]) + [ ("applied_damage", AppliedDamage.schema) + , ("boolean", Boolean.schema) + , ("byte", Byte.schema) + , ("cam_settings", CamSettings.schema) + , ("club_colors", ClubColors.schema) + , ("custom_demolish", CustomDemolish.schema) + , ("damage_state", DamageState.schema) + , ("demolish", Demolish.schema) + , ("enum", Enum.schema) + , ("explosion", Explosion.schema) + , ("extended_explosion", ExtendedExplosion.schema) + , ("flagged_byte", FlaggedByte.schema) + , ("flagged_int", FlaggedInt.schema) + , ("float", Float.schema) + , ("game_mode", GameMode.schema) + , ("int", Int.schema) + , ("int64", Int64.schema) + , ("loadout_online", LoadoutOnline.schema) + , ("loadout", Loadout.schema) + , ("loadouts_online", LoadoutsOnline.schema) + , ("loadouts", Loadouts.schema) + , ("location", Location.schema) + , ("music_stinger", MusicStinger.schema) + , ("party_leader", PartyLeader.schema) + , ("pickup_new", PickupNew.schema) + , ("pickup", Pickup.schema) + , ("player_history_key", PlayerHistoryKey.schema) + , ("private_match_settings", PrivateMatchSettings.schema) + , ("q_word", QWord.schema) + , ("reservation", Reservation.schema) + , ("rigid_body_state", RigidBodyState.schema) + , ("stat_event", StatEvent.schema) + , ("string", String.schema) + , ("team_paint", TeamPaint.schema) + , ("title", Title.schema) + , ("unique_id", UniqueId.schema) + , ("welded_info", WeldedInfo.schema) + ] + +bitPut :: AttributeValue -> BitPut.BitPut +bitPut value = case value of + AppliedDamage x -> AppliedDamage.bitPut x + Boolean x -> Boolean.bitPut x + Byte x -> Byte.bitPut x + CamSettings x -> CamSettings.bitPut x + ClubColors x -> ClubColors.bitPut x + CustomDemolish x -> CustomDemolish.bitPut x + DamageState x -> DamageState.bitPut x + Demolish x -> Demolish.bitPut x + Enum x -> Enum.bitPut x + Explosion x -> Explosion.bitPut x + ExtendedExplosion x -> ExtendedExplosion.bitPut x + FlaggedInt x -> FlaggedInt.bitPut x + FlaggedByte x -> FlaggedByte.bitPut x + Float x -> Float.bitPut x + GameMode x -> GameMode.bitPut x + Int x -> Int.bitPut x + Int64 x -> Int64.putInt64Attribute x + Loadout x -> Loadout.bitPut x + LoadoutOnline x -> LoadoutOnline.bitPut x + Loadouts x -> Loadouts.bitPut x + LoadoutsOnline x -> LoadoutsOnline.bitPut x + Location x -> Location.bitPut x + MusicStinger x -> MusicStinger.bitPut x + PartyLeader x -> PartyLeader.bitPut x + Pickup x -> Pickup.bitPut x + PickupNew x -> PickupNew.bitPut x + PlayerHistoryKey x -> PlayerHistoryKey.bitPut x + PrivateMatchSettings x -> PrivateMatchSettings.bitPut x + QWord x -> QWord.bitPut x + Reservation x -> Reservation.bitPut x + RigidBodyState x -> RigidBodyState.bitPut x + StatEvent x -> StatEvent.bitPut x + String x -> String.bitPut x + TeamPaint x -> TeamPaint.bitPut x + Title x -> Title.bitPut x + UniqueId x -> UniqueId.bitPut x + WeldedInfo x -> WeldedInfo.bitPut x + +bitGet + :: Version.Version + -> Map.Map U32.U32 Str.Str + -> Str.Str + -> BitGet.BitGet AttributeValue +bitGet version objectMap name = do + constructor <- maybe + (fail ("[RT04] don't know how to get attribute value " <> show name)) + pure + (Map.lookup (Str.toText name) Data.attributeTypes) + case constructor of + AttributeType.AppliedDamage -> + AppliedDamage <$> AppliedDamage.bitGet version + AttributeType.Boolean -> Boolean <$> Boolean.bitGet + AttributeType.Byte -> Byte <$> Byte.bitGet + AttributeType.CamSettings -> CamSettings <$> CamSettings.bitGet version + AttributeType.ClubColors -> ClubColors <$> ClubColors.bitGet + AttributeType.CustomDemolish -> + CustomDemolish <$> CustomDemolish.bitGet version + AttributeType.DamageState -> DamageState <$> DamageState.bitGet version + AttributeType.Demolish -> Demolish <$> Demolish.bitGet version + AttributeType.Enum -> Enum <$> Enum.bitGet + AttributeType.Explosion -> Explosion <$> Explosion.bitGet version + AttributeType.ExtendedExplosion -> + ExtendedExplosion <$> ExtendedExplosion.bitGet version + AttributeType.FlaggedInt -> FlaggedInt <$> FlaggedInt.bitGet + AttributeType.FlaggedByte -> FlaggedByte <$> FlaggedByte.bitGet + AttributeType.Float -> Float <$> Float.bitGet + AttributeType.GameMode -> GameMode <$> GameMode.bitGet version + AttributeType.Int -> Int <$> Int.bitGet + AttributeType.Int64 -> Int64 <$> Int64.bitGet + AttributeType.Loadout -> Loadout <$> Loadout.bitGet + AttributeType.LoadoutOnline -> + LoadoutOnline <$> LoadoutOnline.bitGet version objectMap + AttributeType.Loadouts -> Loadouts <$> Loadouts.bitGet + AttributeType.LoadoutsOnline -> + LoadoutsOnline <$> LoadoutsOnline.bitGet version objectMap + AttributeType.Location -> Location <$> Location.bitGet version + AttributeType.MusicStinger -> MusicStinger <$> MusicStinger.bitGet + AttributeType.PartyLeader -> PartyLeader <$> PartyLeader.bitGet version + AttributeType.Pickup -> Pickup <$> Pickup.bitGet + AttributeType.PickupNew -> PickupNew <$> PickupNew.bitGet + AttributeType.PlayerHistoryKey -> + PlayerHistoryKey <$> PlayerHistoryKey.bitGet + AttributeType.PrivateMatchSettings -> + PrivateMatchSettings <$> PrivateMatchSettings.bitGet + AttributeType.QWord -> QWord <$> QWord.bitGet + AttributeType.Reservation -> Reservation <$> Reservation.bitGet version + AttributeType.RigidBodyState -> + RigidBodyState <$> RigidBodyState.bitGet version + AttributeType.StatEvent -> StatEvent <$> StatEvent.bitGet + AttributeType.String -> String <$> String.bitGet + AttributeType.TeamPaint -> TeamPaint <$> TeamPaint.bitGet + AttributeType.Title -> Title <$> Title.bitGet + AttributeType.UniqueId -> UniqueId <$> UniqueId.bitGet version + AttributeType.WeldedInfo -> WeldedInfo <$> WeldedInfo.bitGet version diff --git a/src/lib/Rattletrap/Type/BooleanAttribute.hs b/src/lib/Rattletrap/Type/BooleanAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/BooleanAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.BooleanAttribute - ( BooleanAttribute(..) - ) -where - -import Rattletrap.Type.Common - -newtype BooleanAttribute = BooleanAttribute - { booleanAttributeValue :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''BooleanAttribute) diff --git a/src/lib/Rattletrap/Type/ByteAttribute.hs b/src/lib/Rattletrap/Type/ByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ByteAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ByteAttribute - ( ByteAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word8le - -newtype ByteAttribute = ByteAttribute - { byteAttributeValue :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''ByteAttribute) diff --git a/src/lib/Rattletrap/Type/Cache.hs b/src/lib/Rattletrap/Type/Cache.hs --- a/src/lib/Rattletrap/Type/Cache.hs +++ b/src/lib/Rattletrap/Type/Cache.hs @@ -1,20 +1,59 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Cache - ( Cache(..) - ) -where +module Rattletrap.Type.Cache where -import Rattletrap.Type.AttributeMapping -import Rattletrap.Type.Common -import Rattletrap.Type.List -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.AttributeMapping as AttributeMapping +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data Cache = Cache - { cacheClassId :: Word32le - , cacheParentCacheId :: Word32le - , cacheCacheId :: Word32le - , cacheAttributeMappings :: List AttributeMapping - } deriving (Eq, Ord, Show) + { classId :: U32.U32 + , parentCacheId :: U32.U32 + , cacheId :: U32.U32 + , attributeMappings :: List.List AttributeMapping.AttributeMapping + } + deriving (Eq, Show) -$(deriveJson ''Cache) +instance Json.FromJSON Cache where + parseJSON = Json.withObject "Cache" $ \object -> do + classId <- Json.required object "class_id" + parentCacheId <- Json.required object "parent_cache_id" + cacheId <- Json.required object "cache_id" + attributeMappings <- Json.required object "attribute_mappings" + pure Cache { classId, parentCacheId, cacheId, attributeMappings } + +instance Json.ToJSON Cache where + toJSON x = Json.object + [ Json.pair "class_id" $ classId x + , Json.pair "parent_cache_id" $ parentCacheId x + , Json.pair "cache_id" $ cacheId x + , Json.pair "attribute_mappings" $ attributeMappings x + ] + +schema :: Schema.Schema +schema = Schema.named "cache" $ Schema.object + [ (Json.pair "class_id" $ Schema.ref U32.schema, True) + , (Json.pair "parent_cache_id" $ Schema.ref U32.schema, True) + , (Json.pair "cache_id" $ Schema.ref U32.schema, True) + , ( Json.pair "attribute_mappings" . Schema.json $ List.schema + AttributeMapping.schema + , True + ) + ] + +bytePut :: Cache -> BytePut.BytePut +bytePut x = + U32.bytePut (classId x) + <> U32.bytePut (parentCacheId x) + <> U32.bytePut (cacheId x) + <> List.bytePut AttributeMapping.bytePut (attributeMappings x) + +byteGet :: ByteGet.ByteGet Cache +byteGet = + Cache + <$> U32.byteGet + <*> U32.byteGet + <*> U32.byteGet + <*> List.byteGet AttributeMapping.byteGet diff --git a/src/lib/Rattletrap/Type/CamSettingsAttribute.hs b/src/lib/Rattletrap/Type/CamSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/CamSettingsAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.CamSettingsAttribute - ( CamSettingsAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Float32le - -data CamSettingsAttribute = CamSettingsAttribute - { camSettingsAttributeFov :: Float32le - , camSettingsAttributeHeight :: Float32le - , camSettingsAttributeAngle :: Float32le - , camSettingsAttributeDistance :: Float32le - , camSettingsAttributeStiffness :: Float32le - , camSettingsAttributeSwivelSpeed :: Float32le - , camSettingsAttributeTransitionSpeed :: Maybe Float32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''CamSettingsAttribute) diff --git a/src/lib/Rattletrap/Type/ClassAttributeMap.hs b/src/lib/Rattletrap/Type/ClassAttributeMap.hs --- a/src/lib/Rattletrap/Type/ClassAttributeMap.hs +++ b/src/lib/Rattletrap/Type/ClassAttributeMap.hs @@ -8,19 +8,17 @@ , getClassName , getName , getObjectName - , makeClassAttributeMap - ) -where + , make + ) where -import Rattletrap.Data -import Rattletrap.Type.AttributeMapping -import Rattletrap.Type.Cache -import Rattletrap.Type.ClassMapping -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.List -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Rattletrap.Data as Data +import qualified Rattletrap.Type.AttributeMapping as AttributeMapping +import qualified Rattletrap.Type.Cache as Cache +import qualified Rattletrap.Type.ClassMapping as ClassMapping +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 import qualified Data.IntMap as IntMap import qualified Data.List as List @@ -34,19 +32,20 @@ -- attributes in the replay. The class hierarchy is not fixed; it is encoded -- in the 'Rattletrap.Content.Content'. Similarly, the attributes that belong -- to each class are not fixed either. Converting the raw data into a usable --- structure is tedious; see 'makeClassAttributeMap'. +-- structure is tedious; see 'make'. data ClassAttributeMap = ClassAttributeMap - { classAttributeMapObjectMap :: Map Word32le Str + { objectMap :: Map.Map U32.U32 Str.Str -- ^ A map from object IDs to their names. - , classAttributeMapObjectClassMap :: Map Word32le Word32le + , objectClassMap :: Map.Map U32.U32 U32.U32 -- ^ A map from object IDs to their class IDs. - , classAttributeMapValue :: Map Word32le (Map Word32le Word32le) + , value :: Map.Map U32.U32 (Map.Map U32.U32 U32.U32) -- ^ A map from class IDs to a map from attribute stream IDs to attribute -- IDs. - , classAttributeMapNameMap :: IntMap.IntMap Str - } deriving (Eq, Ord, Show) + , nameMap :: IntMap.IntMap Str.Str + } + deriving (Eq, Show) -type Bimap l r = (Map l r, Map r l) +type Bimap l r = (Map.Map l r, Map.Map r l) bimap :: (Ord l, Ord r) => [(l, r)] -> Bimap l r bimap xs = (Map.fromList xs, Map.fromList (fmap Tuple.swap xs)) @@ -59,26 +58,26 @@ -- | Makes a 'ClassAttributeMap' given the necessary fields from the -- 'Rattletrap.Content.Content'. -makeClassAttributeMap - :: List Str - -- ^ From 'Rattletrap.Content.contentObjects'. - -> List ClassMapping - -- ^ From 'Rattletrap.Content.contentClassMappings'. - -> List Cache - -- ^ From 'Rattletrap.Content.contentCaches'. - -> List Str - -- ^ From 'Rattletrap.Content.contentNames'. +make + :: List.List Str.Str + -- ^ From 'Rattletrap.Content.objects'. + -> List.List ClassMapping.ClassMapping + -- ^ From 'Rattletrap.Content.classMappings'. + -> List.List Cache.Cache + -- ^ From 'Rattletrap.Content.caches'. + -> List.List Str.Str + -- ^ From 'Rattletrap.Content.names'. -> ClassAttributeMap -makeClassAttributeMap objects classMappings caches names = +make objects classMappings caches names = let - objectMap = makeObjectMap objects + objectMap_ = makeObjectMap objects classMap = makeClassMap classMappings - objectClassMap = makeObjectClassMap objectMap classMap + objectClassMap_ = makeObjectClassMap objectMap_ classMap classCache = makeClassCache classMap caches attributeMap = makeAttributeMap caches classIds = fmap (\(_, classId, _, _) -> classId) classCache parentMap = makeParentMap classCache - value = Map.fromList + value_ = Map.fromList (fmap (\classId -> let @@ -97,21 +96,24 @@ ) classIds ) - nameMap = makeNameMap names - in ClassAttributeMap objectMap objectClassMap value nameMap + nameMap_ = makeNameMap names + in ClassAttributeMap objectMap_ objectClassMap_ value_ nameMap_ -makeNameMap :: List Str -> IntMap.IntMap Str -makeNameMap names = IntMap.fromDistinctAscList (zip [0 ..] (listValue names)) +makeNameMap :: List.List Str.Str -> IntMap.IntMap Str.Str +makeNameMap names = + IntMap.fromDistinctAscList (zip [0 ..] (List.toList names)) -getName :: IntMap.IntMap Str -> Word32le -> Maybe Str -getName nameMap nameIndex = - IntMap.lookup (fromIntegral (word32leValue nameIndex)) nameMap +getName :: IntMap.IntMap Str.Str -> U32.U32 -> Maybe Str.Str +getName nameMap_ nameIndex = + IntMap.lookup (fromIntegral (U32.toWord32 nameIndex)) nameMap_ makeObjectClassMap - :: Map Word32le Str -> Bimap Word32le Str -> Map Word32le Word32le -makeObjectClassMap objectMap classMap = do - let objectIds = Map.keys objectMap - let classIds = fmap (getClassId objectMap classMap) objectIds + :: Map.Map U32.U32 Str.Str + -> Bimap U32.U32 Str.Str + -> Map.Map U32.U32 U32.U32 +makeObjectClassMap objectMap_ classMap = do + let objectIds = Map.keys objectMap_ + let classIds = fmap (getClassId objectMap_ classMap) objectIds let rawPairs = zip objectIds classIds let pairs = Maybe.mapMaybe @@ -123,58 +125,62 @@ Map.fromList pairs getClassId - :: Map Word32le Str -> Bimap Word32le Str -> Word32le -> Maybe Word32le -getClassId objectMap classMap objectId = do - objectName <- getObjectName objectMap objectId + :: Map.Map U32.U32 Str.Str + -> Bimap U32.U32 Str.Str + -> U32.U32 + -> Maybe U32.U32 +getClassId objectMap_ classMap objectId = do + objectName <- getObjectName objectMap_ objectId className <- getClassName objectName lookupR className classMap makeClassCache - :: Bimap Word32le Str - -> List Cache - -> [(Maybe Str, Word32le, Word32le, Word32le)] + :: Bimap U32.U32 Str.Str + -> List.List Cache.Cache + -> [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] makeClassCache classMap caches = fmap (\cache -> - let classId = cacheClassId cache + let classId = Cache.classId cache in ( lookupL classId classMap , classId - , cacheCacheId cache - , cacheParentCacheId cache + , Cache.cacheId cache + , Cache.parentCacheId cache ) ) - (listValue caches) + (List.toList caches) -makeClassMap :: List ClassMapping -> Bimap Word32le Str +makeClassMap :: List.List ClassMapping.ClassMapping -> Bimap U32.U32 Str.Str makeClassMap classMappings = bimap (fmap (\classMapping -> - (classMappingStreamId classMapping, classMappingName classMapping) + (ClassMapping.streamId classMapping, ClassMapping.name classMapping) ) - (listValue classMappings) + (List.toList classMappings) ) -makeAttributeMap :: List Cache -> Map Word32le (Map Word32le Word32le) +makeAttributeMap + :: List.List Cache.Cache -> Map.Map U32.U32 (Map.Map U32.U32 U32.U32) makeAttributeMap caches = Map.fromList (fmap (\cache -> - ( cacheClassId cache + ( Cache.classId cache , Map.fromList (fmap (\attributeMapping -> - ( attributeMappingStreamId attributeMapping - , attributeMappingObjectId attributeMapping + ( AttributeMapping.streamId attributeMapping + , AttributeMapping.objectId attributeMapping ) ) - (listValue (cacheAttributeMappings cache)) + (List.toList (Cache.attributeMappings cache)) ) ) ) - (listValue caches) + (List.toList caches) ) makeShallowParentMap - :: [(Maybe Str, Word32le, Word32le, Word32le)] -> Map Word32le Word32le + :: [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Map.Map U32.U32 U32.U32 makeShallowParentMap classCache = Map.fromList (Maybe.mapMaybe (\xs -> case xs of @@ -187,7 +193,7 @@ ) makeParentMap - :: [(Maybe Str, Word32le, Word32le, Word32le)] -> Map Word32le [Word32le] + :: [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Map.Map U32.U32 [U32.U32] makeParentMap classCache = let shallowParentMap = makeShallowParentMap classCache in @@ -195,7 +201,7 @@ (\classId _ -> getParentClasses shallowParentMap classId) shallowParentMap -getParentClasses :: Map Word32le Word32le -> Word32le -> [Word32le] +getParentClasses :: Map.Map U32.U32 U32.U32 -> U32.U32 -> [U32.U32] getParentClasses shallowParentMap classId = case Map.lookup classId shallowParentMap of Nothing -> [] @@ -203,30 +209,32 @@ parentClassId : getParentClasses shallowParentMap parentClassId getParentClass - :: Maybe Str - -> Word32le - -> [(Maybe Str, Word32le, Word32le, Word32le)] - -> Maybe Word32le + :: Maybe Str.Str + -> U32.U32 + -> [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] + -> Maybe U32.U32 getParentClass maybeClassName parentCacheId xs = case maybeClassName of Nothing -> getParentClassById parentCacheId xs Just className -> getParentClassByName className parentCacheId xs getParentClassById - :: Word32le -> [(Maybe Str, Word32le, Word32le, Word32le)] -> Maybe Word32le + :: U32.U32 -> [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Maybe U32.U32 getParentClassById parentCacheId xs = case dropWhile (\(_, _, cacheId, _) -> cacheId /= parentCacheId) xs of - [] -> if parentCacheId == Word32le 0 + [] -> if parentCacheId == U32.fromWord32 0 then Nothing - else getParentClassById (Word32le (word32leValue parentCacheId - 1)) xs + else getParentClassById + (U32.fromWord32 (U32.toWord32 parentCacheId - 1)) + xs (_, parentClassId, _, _) : _ -> Just parentClassId getParentClassByName - :: Str - -> Word32le - -> [(Maybe Str, Word32le, Word32le, Word32le)] - -> Maybe Word32le + :: Str.Str + -> U32.U32 + -> [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] + -> Maybe U32.U32 getParentClassByName className parentCacheId xs = - case Map.lookup className parentClasses of + case Map.lookup (Str.toText className) Data.parentClasses of Nothing -> getParentClassById parentCacheId xs Just parentClassName -> Maybe.maybe (getParentClassById parentCacheId xs) @@ -238,7 +246,7 @@ (\(_, _, cacheId, _) -> cacheId <= parentCacheId) (filter (\(maybeClassName, _, _, _) -> - maybeClassName == Just parentClassName + fmap Str.toText maybeClassName == Just parentClassName ) xs ) @@ -246,79 +254,73 @@ ) ) -parentClasses :: Map Str Str -parentClasses = - Map.map toStr (Map.mapKeys toStr (Map.fromList rawParentClasses)) - -makeObjectMap :: List Str -> Map Word32le Str +makeObjectMap :: List.List Str.Str -> Map.Map U32.U32 Str.Str makeObjectMap objects = - Map.fromAscList (zip (fmap Word32le [0 ..]) (listValue objects)) + Map.fromAscList (zip (fmap U32.fromWord32 [0 ..]) (List.toList objects)) -getObjectName :: Map Word32le Str -> Word32le -> Maybe Str -getObjectName objectMap objectId = Map.lookup objectId objectMap +getObjectName :: Map.Map U32.U32 Str.Str -> U32.U32 -> Maybe Str.Str +getObjectName objectMap_ objectId = Map.lookup objectId objectMap_ -getClassName :: Str -> Maybe Str +getClassName :: Str.Str -> Maybe Str.Str getClassName rawObjectName = - Map.lookup (normalizeObjectName rawObjectName) objectClasses + Str.fromText + <$> Map.lookup + (Str.toText $ normalizeObjectName rawObjectName) + Data.objectClasses -normalizeObjectName :: Str -> Str +normalizeObjectName :: Str.Str -> Str.Str normalizeObjectName objectName = let - name = strValue objectName + name = Str.toText 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 Str crowdActor + then Str.fromText crowdActor else if Text.isInfixOf crowdManager name - then Str crowdManager + then Str.fromText crowdManager else if Text.isInfixOf boostPickup name - then Str boostPickup + then Str.fromText boostPickup else if Text.isInfixOf mapScoreboard name - then Str mapScoreboard + then Str.fromText mapScoreboard else if Text.isInfixOf breakout name - then Str breakout + then Str.fromText breakout else objectName -objectClasses :: Map Str Str -objectClasses = - Map.map toStr (Map.mapKeys toStr (Map.fromList rawObjectClasses)) - -classHasLocation :: Str -> Bool -classHasLocation className = Set.member className classesWithLocation - -classesWithLocation :: Set.Set Str -classesWithLocation = Set.fromList (fmap toStr rawClassesWithLocation) - -classHasRotation :: Str -> Bool -classHasRotation className = Set.member className classesWithRotation +classHasLocation :: Str.Str -> Bool +classHasLocation className = + Set.member (Str.toText className) Data.classesWithLocation -classesWithRotation :: Set.Set Str -classesWithRotation = Set.fromList (fmap toStr rawClassesWithRotation) +classHasRotation :: Str.Str -> Bool +classHasRotation className = + Set.member (Str.toText className) Data.classesWithRotation -getAttributeIdLimit :: Map Word32le Word32le -> Maybe Word +getAttributeIdLimit :: Map.Map U32.U32 U32.U32 -> Maybe Word getAttributeIdLimit attributeMap = do ((streamId, _), _) <- Map.maxViewWithKey attributeMap - pure (fromIntegral (word32leValue streamId)) + pure (fromIntegral (U32.toWord32 streamId)) getAttributeName - :: ClassAttributeMap -> Map Word32le Word32le -> CompressedWord -> Maybe Str + :: ClassAttributeMap + -> Map.Map U32.U32 U32.U32 + -> CompressedWord.CompressedWord + -> Maybe Str.Str getAttributeName classAttributeMap attributeMap streamId = do - let key = Word32le (fromIntegral (compressedWordValue streamId)) + let key = U32.fromWord32 (fromIntegral (CompressedWord.value streamId)) attributeId <- Map.lookup key attributeMap - let objectMap = classAttributeMapObjectMap classAttributeMap - Map.lookup attributeId objectMap + let objectMap_ = objectMap classAttributeMap + Map.lookup attributeId objectMap_ getAttributeMap :: ClassAttributeMap - -> Map CompressedWord Word32le - -> CompressedWord - -> Maybe (Map Word32le Word32le) + -> Map.Map CompressedWord.CompressedWord U32.U32 + -> CompressedWord.CompressedWord + -> Maybe (Map.Map U32.U32 U32.U32) getAttributeMap classAttributeMap actorMap actorId = do objectId <- Map.lookup actorId actorMap - let objectClassMap = classAttributeMapObjectClassMap classAttributeMap - classId <- Map.lookup objectId objectClassMap - let value = classAttributeMapValue classAttributeMap - Map.lookup classId value + let objectClassMap_ = objectClassMap classAttributeMap + classId <- Map.lookup objectId objectClassMap_ + let value_ = value classAttributeMap + Map.lookup classId value_ diff --git a/src/lib/Rattletrap/Type/ClassMapping.hs b/src/lib/Rattletrap/Type/ClassMapping.hs --- a/src/lib/Rattletrap/Type/ClassMapping.hs +++ b/src/lib/Rattletrap/Type/ClassMapping.hs @@ -1,17 +1,36 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ClassMapping - ( ClassMapping(..) - ) -where +module Rattletrap.Type.ClassMapping where -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data ClassMapping = ClassMapping - { classMappingName :: Str - , classMappingStreamId :: Word32le - } deriving (Eq, Ord, Show) + { name :: Str.Str + , streamId :: U32.U32 + } + deriving (Eq, Show) -$(deriveJson ''ClassMapping) +instance Json.FromJSON ClassMapping where + parseJSON = Json.withObject "ClassMapping" $ \object -> do + name <- Json.required object "name" + streamId <- Json.required object "stream_id" + pure ClassMapping { name, streamId } + +instance Json.ToJSON ClassMapping where + toJSON x = + Json.object [Json.pair "name" $ name x, Json.pair "stream_id" $ streamId x] + +schema :: Schema.Schema +schema = Schema.named "classMapping" $ Schema.object + [ (Json.pair "name" $ Schema.ref Str.schema, True) + , (Json.pair "stream_id" $ Schema.ref U32.schema, True) + ] + +bytePut :: ClassMapping -> BytePut.BytePut +bytePut x = Str.bytePut (name x) <> U32.bytePut (streamId x) + +byteGet :: ByteGet.ByteGet ClassMapping +byteGet = ClassMapping <$> Str.byteGet <*> U32.byteGet diff --git a/src/lib/Rattletrap/Type/ClubColorsAttribute.hs b/src/lib/Rattletrap/Type/ClubColorsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ClubColorsAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ClubColorsAttribute - ( ClubColorsAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word8le - -data ClubColorsAttribute = ClubColorsAttribute - { clubColorsAttributeBlueFlag :: Bool - , clubColorsAttributeBlueColor :: Word8le - , clubColorsAttributeOrangeFlag :: Bool - , clubColorsAttributeOrangeColor :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''ClubColorsAttribute) diff --git a/src/lib/Rattletrap/Type/Common.hs b/src/lib/Rattletrap/Type/Common.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Common.hs +++ /dev/null @@ -1,56 +0,0 @@ -module Rattletrap.Type.Common - ( Int.Int8 - , Int.Int32 - , Int.Int64 - , Map.Map - , Text.Text - , Word.Word8 - , Word.Word16 - , Word.Word32 - , Word.Word64 - , deriveJson - ) -where - -import qualified Data.Aeson as Json -import qualified Data.Aeson.TH as Json -import qualified Data.Char as Char -import qualified Data.Int as Int -import qualified Data.Map as Map -import qualified Data.Maybe as Maybe -import qualified Data.Text as Text -import qualified Data.Word as Word -import qualified Language.Haskell.TH as TH - -deriveJson :: TH.Name -> TH.Q [TH.Dec] -deriveJson name = Json.deriveJSON (jsonOptions (TH.nameBase name)) name - -jsonOptions :: String -> Json.Options -jsonOptions prefix = Json.defaultOptions - { Json.constructorTagModifier = toSnakeCase . partialDropPrefix prefix - , Json.fieldLabelModifier = toSnakeCase - . partialDropPrefix (lowerFirst prefix) - , Json.omitNothingFields = True - , Json.sumEncoding = Json.ObjectWithSingleField - , Json.unwrapUnaryRecords = True - } - -lowerFirst :: String -> String -lowerFirst string = case string of - "" -> string - first : rest -> Char.toLower first : rest - -toSnakeCase :: String -> String -toSnakeCase = Json.camelTo2 '_' - -partialDropPrefix :: (Eq a, Show a) => [a] -> [a] -> [a] -partialDropPrefix prefix list = Maybe.fromMaybe - (error (unwords [show prefix, "is not a prefix of", show list])) - (dropPrefix prefix list) - -dropPrefix :: Eq a => [a] -> [a] -> Maybe [a] -dropPrefix prefix list = case prefix of - [] -> Just list - ph : pt -> case list of - [] -> Nothing - lh : lt -> if ph == lh then dropPrefix pt lt else Nothing diff --git a/src/lib/Rattletrap/Type/CompressedWord.hs b/src/lib/Rattletrap/Type/CompressedWord.hs --- a/src/lib/Rattletrap/Type/CompressedWord.hs +++ b/src/lib/Rattletrap/Type/CompressedWord.hs @@ -1,17 +1,86 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.CompressedWord where -module Rattletrap.Type.CompressedWord - ( CompressedWord(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common +import qualified Data.Bits as Bits -- | Although there's no guarantee that these values will not overflow, it's -- exceptionally unlikely. Most 'CompressedWord's are very small. data CompressedWord = CompressedWord - { compressedWordLimit :: Word - , compressedWordValue :: Word - } deriving (Eq, Ord, Show) + { limit :: Word + , value :: Word + } + deriving (Eq, Ord, Show) -$(deriveJson ''CompressedWord) +instance Json.FromJSON CompressedWord where + parseJSON = Json.withObject "CompressedWord" $ \object -> do + limit <- Json.required object "limit" + value <- Json.required object "value" + pure CompressedWord { limit, value } + +instance Json.ToJSON CompressedWord where + toJSON x = + Json.object [Json.pair "limit" $ limit x, Json.pair "value" $ value x] + +schema :: Schema.Schema +schema = Schema.named "compressedWord" $ Schema.object + [ (Json.pair "limit" $ Json.object [Json.pair "type" "integer"], True) + , (Json.pair "value" $ Json.object [Json.pair "type" "integer"], True) + ] + +bitPut :: CompressedWord -> BitPut.BitPut +bitPut compressedWord = + let + limit_ = limit compressedWord + value_ = value compressedWord + maxBits = getMaxBits limit_ + in putCompressedWordStep limit_ value_ maxBits 0 0 + +putCompressedWordStep :: Word -> Word -> Int -> Int -> Word -> BitPut.BitPut +putCompressedWordStep limit_ value_ maxBits position soFar = + if position < maxBits + then do + let x = Bits.shiftL 1 position :: Word + if maxBits > 1 && position == maxBits - 1 && soFar + x > limit_ + then mempty + else + let + bit = Bits.testBit value_ position + delta = if bit then x else 0 + in BitPut.bool bit <> putCompressedWordStep + limit_ + value_ + maxBits + (position + 1) + (soFar + delta) + else mempty + +getMaxBits :: Word -> Int +getMaxBits x = + let + n :: Int + n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) + in if x < 1024 && x == 2 ^ n then n + 1 else n + +bitGet :: Word -> BitGet.BitGet CompressedWord +bitGet limit_ = CompressedWord limit_ <$> step limit_ (getMaxBits_ limit_) 0 0 + +getMaxBits_ :: Word -> Word +getMaxBits_ x = do + let + n :: Word + n = max 1 (ceiling (logBase (2 :: Double) (fromIntegral (max 1 x)))) + if x < 1024 && x == 2 ^ n then n + 1 else n + +step :: Word -> Word -> Word -> Word -> BitGet.BitGet Word +step limit_ maxBits position value_ = do + let x = Bits.shiftL 1 (fromIntegral position) :: Word + if position < maxBits && value_ + x <= limit_ + then do + bit <- BitGet.bool + let newValue = if bit then value_ + x else value_ + step limit_ maxBits (position + 1) newValue + else pure value_ diff --git a/src/lib/Rattletrap/Type/CompressedWordVector.hs b/src/lib/Rattletrap/Type/CompressedWordVector.hs --- a/src/lib/Rattletrap/Type/CompressedWordVector.hs +++ b/src/lib/Rattletrap/Type/CompressedWordVector.hs @@ -1,17 +1,48 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.CompressedWordVector - ( CompressedWordVector(..) - ) -where +module Rattletrap.Type.CompressedWordVector where -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Utility.Json as Json data CompressedWordVector = CompressedWordVector - { compressedWordVectorX :: CompressedWord - , compressedWordVectorY :: CompressedWord - , compressedWordVectorZ :: CompressedWord - } deriving (Eq, Ord, Show) + { x :: CompressedWord.CompressedWord + , y :: CompressedWord.CompressedWord + , z :: CompressedWord.CompressedWord + } + deriving (Eq, Show) -$(deriveJson ''CompressedWordVector) +instance Json.FromJSON CompressedWordVector where + parseJSON = Json.withObject "CompressedWordVector" $ \object -> do + x <- Json.required object "x" + y <- Json.required object "y" + z <- Json.required object "z" + pure CompressedWordVector { x, y, z } + +instance Json.ToJSON CompressedWordVector where + toJSON a = + Json.object [Json.pair "x" $ x a, Json.pair "y" $ y a, Json.pair "z" $ z a] + +schema :: Schema.Schema +schema = Schema.named "compressed-word-vector" $ Schema.object + [ (Json.pair "x" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "y" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "z" $ Schema.ref CompressedWord.schema, True) + ] + +bitPut :: CompressedWordVector -> BitPut.BitPut +bitPut compressedWordVector = + CompressedWord.bitPut (x compressedWordVector) + <> CompressedWord.bitPut (y compressedWordVector) + <> CompressedWord.bitPut (z compressedWordVector) + +bitGet :: BitGet.BitGet CompressedWordVector +bitGet = + CompressedWordVector + <$> CompressedWord.bitGet limit + <*> CompressedWord.bitGet limit + <*> CompressedWord.bitGet limit + +limit :: Word +limit = 65536 diff --git a/src/lib/Rattletrap/Type/Content.hs b/src/lib/Rattletrap/Type/Content.hs --- a/src/lib/Rattletrap/Type/Content.hs +++ b/src/lib/Rattletrap/Type/Content.hs @@ -1,71 +1,230 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.Content where -module Rattletrap.Type.Content - ( Content(..) - , defaultContent - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Cache as Cache +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.ClassMapping as ClassMapping +import qualified Rattletrap.Type.Frame as Frame +import qualified Rattletrap.Type.KeyFrame as KeyFrame +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Mark as Mark +import qualified Rattletrap.Type.Message as Message +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import Rattletrap.Utility.Bytes +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Cache -import Rattletrap.Type.ClassMapping -import Rattletrap.Type.Common -import Rattletrap.Type.Frame -import Rattletrap.Type.KeyFrame -import Rattletrap.Type.List -import Rattletrap.Type.Mark -import Rattletrap.Type.Message -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Control.Monad.Trans.State as State +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Word as Word +type Content = ContentWith (List.List Frame.Frame) + -- | Contains low-level game data about a 'Rattletrap.Replay.Replay'. -data Content = Content - { contentLevels :: List Str +data ContentWith frames = Content + { levels :: List.List Str.Str -- ^ This typically only has one element, like @stadium_oob_audio_map@. - , contentKeyFrames :: List KeyFrame + , keyFrames :: List.List KeyFrame.KeyFrame -- ^ A list of which frames are key frames. Although they aren't necessary -- for replay, key frames are frames that replicate every actor. They -- typically happen once every 10 seconds. - , contentStreamSize :: Word32le + , streamSize :: U32.U32 -- ^ The size of the stream in bytes. This is only really necessary because -- the stream has some arbitrary amount of padding at the end. - , contentFrames :: [Frame] + , frames :: frames -- ^ The actual game data. This is where all the interesting information is. - , contentMessages :: List Message + , messages :: List.List Message.Message -- ^ Debugging messages. In newer replays, this is always empty. - , contentMarks :: List Mark + , marks :: List.List Mark.Mark -- ^ Tick marks shown on the scrubber when watching a replay. - , contentPackages :: List Str + , packages :: List.List Str.Str -- ^ A list of @.upk@ files to load, like -- @..\\..\\TAGame\\CookedPCConsole\\Stadium_P.upk@. - , contentObjects :: List Str + , objects :: List.List Str.Str -- ^ Objects in the stream. Used for the -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'. - , contentNames :: List Str + , names :: List.List Str.Str -- ^ It's not clear what these are used for. This list is usually not empty, -- but appears unused otherwise. - , contentClassMappings :: List ClassMapping + , classMappings :: List.List ClassMapping.ClassMapping -- ^ A mapping between classes and their ID in the stream. Used for the -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'. - , contentCaches :: List Cache + , caches :: List.List Cache.Cache -- ^ A list of classes along with their parent classes and attributes. Used -- for the 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'. - , contentUnknown :: [Word8] - } deriving (Eq, Ord, Show) + , unknown :: [Word.Word8] + } + deriving (Eq, Show) -$(deriveJson ''Content) +instance Json.FromJSON frames => Json.FromJSON (ContentWith frames) where + parseJSON = Json.withObject "Content" $ \object -> do + levels <- Json.required object "levels" + keyFrames <- Json.required object "key_frames" + streamSize <- Json.required object "stream_size" + frames <- Json.required object "frames" + messages <- Json.required object "messages" + marks <- Json.required object "marks" + packages <- Json.required object "packages" + objects <- Json.required object "objects" + names <- Json.required object "names" + classMappings <- Json.required object "class_mappings" + caches <- Json.required object "caches" + unknown <- Json.required object "unknown" + pure Content + { levels + , keyFrames + , streamSize + , frames + , messages + , marks + , packages + , objects + , names + , classMappings + , caches + , unknown + } -defaultContent :: Content -defaultContent = Content - { contentLevels = List [] - , contentKeyFrames = List [] - , contentStreamSize = Word32le 0 - , contentFrames = [] - , contentMessages = List [] - , contentMarks = List [] - , contentPackages = List [] - , contentObjects = List [] - , contentNames = List [] - , contentClassMappings = List [] - , contentCaches = List [] - , contentUnknown = [] +instance Json.ToJSON frames => Json.ToJSON (ContentWith frames) where + toJSON x = Json.object + [ Json.pair "levels" $ levels x + , Json.pair "key_frames" $ keyFrames x + , Json.pair "stream_size" $ streamSize x + , Json.pair "frames" $ frames x + , Json.pair "messages" $ messages x + , Json.pair "marks" $ marks x + , Json.pair "packages" $ packages x + , Json.pair "objects" $ objects x + , Json.pair "names" $ names x + , Json.pair "class_mappings" $ classMappings x + , Json.pair "caches" $ caches x + , Json.pair "unknown" $ unknown x + ] + +schema :: Schema.Schema -> Schema.Schema +schema s = Schema.named "content" $ Schema.object + [ (Json.pair "levels" . Schema.json $ List.schema Str.schema, True) + , (Json.pair "key_frames" . Schema.json $ List.schema KeyFrame.schema, True) + , (Json.pair "stream_size" $ Schema.ref U32.schema, True) + , (Json.pair "frames" $ Schema.json s, True) + , (Json.pair "messages" . Schema.json $ List.schema Message.schema, True) + , (Json.pair "marks" . Schema.json $ List.schema Mark.schema, True) + , (Json.pair "packages" . Schema.json $ List.schema Str.schema, True) + , (Json.pair "objects" . Schema.json $ List.schema Str.schema, True) + , (Json.pair "names" . Schema.json $ List.schema Str.schema, True) + , ( Json.pair "class_mappings" . Schema.json $ List.schema + ClassMapping.schema + , True + ) + , (Json.pair "caches" . Schema.json $ List.schema Cache.schema, True) + , (Json.pair "unknown" . Schema.json $ Schema.array U8.schema, True) + ] + +empty :: Content +empty = Content + { levels = List.empty + , keyFrames = List.empty + , streamSize = U32.fromWord32 0 + , frames = List.empty + , messages = List.empty + , marks = List.empty + , packages = List.empty + , objects = List.empty + , names = List.empty + , classMappings = List.empty + , caches = List.empty + , unknown = [] } + +bytePut :: Content -> BytePut.BytePut +bytePut x = + List.bytePut Str.bytePut (levels x) + <> List.bytePut KeyFrame.bytePut (keyFrames x) + <> putFrames x + <> List.bytePut Message.bytePut (messages x) + <> List.bytePut Mark.bytePut (marks x) + <> List.bytePut Str.bytePut (packages x) + <> List.bytePut Str.bytePut (objects x) + <> List.bytePut Str.bytePut (names x) + <> List.bytePut ClassMapping.bytePut (classMappings x) + <> List.bytePut Cache.bytePut (caches x) + <> foldMap BytePut.word8 (unknown x) + +putFrames :: Content -> BytePut.BytePut +putFrames x = + let + stream = + BytePut.toByteString . BitPut.toBytePut . Frame.putFrames $ frames x + -- This is a little strange. When parsing a binary replay, the stream size + -- is given before the stream itself. When generating the JSON, the stream + -- size is included. That allows a bit-for-bit identical binary replay to + -- be generated from the JSON. However if you modify the JSON before + -- converting it back into binary, the stream size might be different. + -- + -- If it was possible to know how much padding the stream required without + -- carrying it along as extra data on the side, this logic could go away. + -- Unforunately that isn't currently known. See this issue for details: + -- . + expectedStreamSize = streamSize x + actualStreamSize = U32.fromWord32 . fromIntegral $ Bytes.length stream + streamSize_ = U32.fromWord32 + $ max (U32.toWord32 expectedStreamSize) (U32.toWord32 actualStreamSize) + in U32.bytePut streamSize_ <> BytePut.byteString + (reverseBytes (padBytes (U32.toWord32 streamSize_) stream)) + +byteGet + :: Version.Version + -- ^ Version numbers, usually from 'Rattletrap.Header.getVersion'. + -> Int + -- ^ The number of frames in the stream, usually from + -- 'Rattletrap.Header.getNumFrames'. + -> Word + -- ^ The maximum number of channels in the stream, usually from + -- 'Rattletrap.Header.getMaxChannels'. + -> ByteGet.ByteGet Content +byteGet version numFrames maxChannels = do + (levels_, keyFrames_, streamSize_) <- + (,,) + <$> List.byteGet Str.byteGet + <*> List.byteGet KeyFrame.byteGet + <*> U32.byteGet + (stream, messages_, marks_, packages_, objects_, names_, classMappings_, caches_) <- + (,,,,,,,) + <$> ByteGet.byteString (fromIntegral (U32.toWord32 streamSize_)) + <*> List.byteGet Message.byteGet + <*> List.byteGet Mark.byteGet + <*> List.byteGet Str.byteGet + <*> List.byteGet Str.byteGet + <*> List.byteGet Str.byteGet + <*> List.byteGet ClassMapping.byteGet + <*> List.byteGet Cache.byteGet + let + classAttributeMap = + ClassAttributeMap.make objects_ classMappings_ caches_ names_ + bitGet = State.evalStateT + (Frame.decodeFramesBits version numFrames maxChannels classAttributeMap) + mempty + frames_ <- + either fail pure . ByteGet.run (BitGet.toByteGet bitGet) $ reverseBytes + stream + Content + levels_ + keyFrames_ + streamSize_ + frames_ + messages_ + marks_ + packages_ + objects_ + names_ + classMappings_ + caches_ + . LazyBytes.unpack + <$> ByteGet.remaining diff --git a/src/lib/Rattletrap/Type/CustomDemolishAttribute.hs b/src/lib/Rattletrap/Type/CustomDemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/CustomDemolishAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.CustomDemolishAttribute - ( CustomDemolishAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.DemolishAttribute -import Rattletrap.Type.Int32le - -data CustomDemolishAttribute = CustomDemolishAttribute - { customDemolishAttributeFlag :: Bool - , customDemolishAttributeId :: Int32le - , customDemolishAttributeDemolish :: DemolishAttribute - } deriving (Eq, Ord, Show) - -$(deriveJson ''CustomDemolishAttribute) diff --git a/src/lib/Rattletrap/Type/DamageStateAttribute.hs b/src/lib/Rattletrap/Type/DamageStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/DamageStateAttribute.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.DamageStateAttribute - ( DamageStateAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le -import Rattletrap.Type.Vector -import Rattletrap.Type.Word8le - -data DamageStateAttribute = DamageStateAttribute - { damageStateAttributeUnknown1 :: Word8le - , damageStateAttributeUnknown2 :: Bool - , damageStateAttributeUnknown3 :: Int32le - , damageStateAttributeUnknown4 :: Vector - , damageStateAttributeUnknown5 :: Bool - , damageStateAttributeUnknown6 :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''DamageStateAttribute) diff --git a/src/lib/Rattletrap/Type/DemolishAttribute.hs b/src/lib/Rattletrap/Type/DemolishAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/DemolishAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.DemolishAttribute - ( DemolishAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Vector -import Rattletrap.Type.Word32le - -data DemolishAttribute = DemolishAttribute - { demolishAttributeAttackerFlag :: Bool - , demolishAttributeAttackerActorId :: Word32le - , demolishAttributeVictimFlag :: Bool - , demolishAttributeVictimActorId :: Word32le - , demolishAttributeAttackerVelocity :: Vector - , demolishAttributeVictimVelocity :: Vector - } deriving (Eq, Ord, Show) - -$(deriveJson ''DemolishAttribute) diff --git a/src/lib/Rattletrap/Type/DestroyedReplication.hs b/src/lib/Rattletrap/Type/DestroyedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/DestroyedReplication.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.DestroyedReplication - ( DestroyedReplication(..) - ) -where - -import Rattletrap.Type.Common - --- | Destroyed replications don't actually contain any extra information. All --- you need to know is the actor's ID, which is given by the --- 'Rattletrap.Replication.Replication'. -data DestroyedReplication = DestroyedReplication - deriving (Eq, Ord, Show) - -$(deriveJson ''DestroyedReplication) diff --git a/src/lib/Rattletrap/Type/Dictionary.hs b/src/lib/Rattletrap/Type/Dictionary.hs --- a/src/lib/Rattletrap/Type/Dictionary.hs +++ b/src/lib/Rattletrap/Type/Dictionary.hs @@ -1,69 +1,93 @@ -module Rattletrap.Type.Dictionary - ( Dictionary(..) - , dictionaryLookup - ) -where +module Rattletrap.Type.Dictionary where -import Rattletrap.Type.Common -import Rattletrap.Type.Str +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Utility.Json as Json -import qualified Control.Monad as Monad -import qualified Data.Aeson as Json -import qualified Data.Aeson.Types as Json +import qualified Data.Bifunctor as Bifunctor import qualified Data.Map as Map import qualified Data.Text as Text -data Dictionary a - = DictionaryElement Str a (Dictionary a) - | DictionaryEnd Str - deriving (Eq, Ord, Show) +data Dictionary a = Dictionary + { elements :: List.List (Str.Str, a) + , lastKey :: Str.Str + } + deriving (Eq, Show) instance Json.FromJSON a => Json.FromJSON (Dictionary a) where - parseJSON = Json.withObject - "Dictionary" - (\o -> do - keys <- get o "keys" - lastKey <- get o "last_key" - value <- get o "value" - Monad.foldM - (\d k -> case Map.lookup k value of - Nothing -> fail (unwords ["missing key", show k]) - Just v -> pure (DictionaryElement (Str k) v d) - ) - (DictionaryEnd lastKey) - (reverse keys) - ) + parseJSON = Json.withObject "Dictionary" $ \o -> do + keys <- Json.required o "keys" + lastKey_ <- Json.required o "last_key" + value <- Json.required o "value" + let + build + :: MonadFail m + => Map.Map Text.Text a + -> Int + -> [(Int, (Str.Str, a))] + -> [Text.Text] + -> m (List.List (Str.Str, a)) + build m i xs ks = case ks of + [] -> pure . List.fromList . reverse $ fmap snd xs + k : t -> case Map.lookup k m of + Nothing -> fail $ "missing required key " <> show k + Just v -> build m (i + 1) ((i, (Str.fromText k, v)) : xs) t + elements_ <- build value 0 [] keys + pure Dictionary { elements = elements_, lastKey = lastKey_ } instance Json.ToJSON a => Json.ToJSON (Dictionary a) where - toJSON d = Json.object - [ pair "keys" (dictionaryKeys d) - , pair "last_key" (dictionaryLastKey d) - , pair "value" (dictionaryValue d) + toJSON x = Json.object + [ Json.pair "keys" . fmap fst . List.toList $ elements x + , Json.pair "last_key" $ lastKey x + , Json.pair "value" + . Map.fromList + . fmap (Bifunctor.first Str.toText) + . List.toList + $ elements x ] -dictionaryKeys :: Dictionary a -> [Str] -dictionaryKeys = fmap fst . toList - -dictionaryLastKey :: Dictionary a -> Str -dictionaryLastKey x = case x of - DictionaryElement _ _ y -> dictionaryLastKey y - DictionaryEnd y -> y +schema :: Schema.Schema -> Schema.Schema +schema s = + Schema.named ("dictionary-" <> Text.unpack (Schema.name s)) $ Schema.object + [ (Json.pair "keys" . Schema.json $ Schema.array Str.schema, True) + , (Json.pair "last_key" $ Schema.ref Str.schema, True) + , ( Json.pair "value" $ Json.object + [ Json.pair "type" "object" + , Json.pair "additionalProperties" $ Schema.ref s + ] + , True + ) + ] -dictionaryLookup :: Str -> Dictionary a -> Maybe a -dictionaryLookup k x = case x of - DictionaryElement j v y -> if k == j then Just v else dictionaryLookup k y - DictionaryEnd _ -> Nothing +lookup :: Str.Str -> Dictionary a -> Maybe a +lookup k = Prelude.lookup k . List.toList . elements -dictionaryValue :: Dictionary a -> Map Text a -dictionaryValue = Map.mapKeys strValue . Map.fromList . toList +bytePut :: (a -> BytePut.BytePut) -> Dictionary a -> BytePut.BytePut +bytePut f x = + foldMap (\(k, v) -> Str.bytePut k <> f v) (List.toList $ elements x) + <> Str.bytePut (lastKey x) -get :: Json.FromJSON a => Json.Object -> String -> Json.Parser a -get o k = o Json..: Text.pack k +byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (Dictionary a) +byteGet = byteGetWith 0 [] -pair :: Json.ToJSON a => String -> a -> (Text, Json.Value) -pair k v = (Text.pack k, Json.toJSON v) +byteGetWith + :: Int + -> [(Int, (Str.Str, a))] + -> ByteGet.ByteGet a + -> ByteGet.ByteGet (Dictionary a) +byteGetWith i xs f = do + k <- Str.byteGet + if isNone k + then pure Dictionary + { elements = List.fromList . reverse $ fmap snd xs + , lastKey = k + } + else do + v <- f + byteGetWith (i + 1) ((i, (k, v)) : xs) f -toList :: Dictionary a -> [(Str, a)] -toList x = case x of - DictionaryElement k v y -> (k, v) : toList y - DictionaryEnd _ -> [] +isNone :: Str.Str -> Bool +isNone = (== Text.pack "None") . Text.filter (/= '\x00') . Str.toText diff --git a/src/lib/Rattletrap/Type/EnumAttribute.hs b/src/lib/Rattletrap/Type/EnumAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/EnumAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.EnumAttribute - ( EnumAttribute(..) - ) -where - -import Rattletrap.Type.Common - -newtype EnumAttribute = EnumAttribute - { enumAttributeValue :: Word16 - } deriving (Eq, Ord, Show) - -$(deriveJson ''EnumAttribute) diff --git a/src/lib/Rattletrap/Type/ExplosionAttribute.hs b/src/lib/Rattletrap/Type/ExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ExplosionAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ExplosionAttribute - ( ExplosionAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le -import Rattletrap.Type.Vector - -data ExplosionAttribute = ExplosionAttribute - { explosionAttributeFlag :: Bool - , explosionAttributeActorId :: Int32le - , explosionAttributeLocation :: Vector - } deriving (Eq, Ord, Show) - -$(deriveJson ''ExplosionAttribute) diff --git a/src/lib/Rattletrap/Type/ExtendedExplosionAttribute.hs b/src/lib/Rattletrap/Type/ExtendedExplosionAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ExtendedExplosionAttribute.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ExtendedExplosionAttribute - ( ExtendedExplosionAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.ExplosionAttribute -import Rattletrap.Type.FlaggedIntAttribute - -data ExtendedExplosionAttribute = ExtendedExplosionAttribute - { extendedExplosionAttributeExplosion :: ExplosionAttribute - , extendedExplosionAttributeUnknown :: FlaggedIntAttribute - } deriving (Eq, Ord, Show) - -$(deriveJson ''ExtendedExplosionAttribute) diff --git a/src/lib/Rattletrap/Type/F32.hs b/src/lib/Rattletrap/Type/F32.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/F32.hs @@ -0,0 +1,39 @@ +module Rattletrap.Type.F32 where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype F32 + = F32 Float + deriving (Eq, Show) + +instance Json.FromJSON F32 where + parseJSON = fmap fromFloat . Json.parseJSON + +instance Json.ToJSON F32 where + toJSON = Json.toJSON . toFloat + +schema :: Schema.Schema +schema = Schema.named "f32" $ Json.object [Json.pair "type" "number"] + +fromFloat :: Float -> F32 +fromFloat = F32 + +toFloat :: F32 -> Float +toFloat (F32 x) = x + +bytePut :: F32 -> BytePut.BytePut +bytePut = BytePut.float . toFloat + +bitPut :: F32 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet F32 +byteGet = fromFloat <$> ByteGet.float + +bitGet :: BitGet.BitGet F32 +bitGet = BitGet.fromByteGet byteGet 4 diff --git a/src/lib/Rattletrap/Type/FlaggedByteAttribute.hs b/src/lib/Rattletrap/Type/FlaggedByteAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/FlaggedByteAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.FlaggedByteAttribute - ( FlaggedByteAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word8le - -data FlaggedByteAttribute = FlaggedByteAttribute - { flaggedByteAttributeFlag :: Bool - , flaggedByteAttributeByte :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''FlaggedByteAttribute) diff --git a/src/lib/Rattletrap/Type/FlaggedIntAttribute.hs b/src/lib/Rattletrap/Type/FlaggedIntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/FlaggedIntAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.FlaggedIntAttribute - ( FlaggedIntAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le - -data FlaggedIntAttribute = FlaggedIntAttribute - { flaggedIntAttributeFlag :: Bool - , flaggedIntAttributeInt :: Int32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''FlaggedIntAttribute) diff --git a/src/lib/Rattletrap/Type/Float32le.hs b/src/lib/Rattletrap/Type/Float32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Float32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Float32le - ( Float32le(..) - ) -where - -import Rattletrap.Type.Common - -newtype Float32le = Float32le - { float32leValue :: Float - } deriving (Eq, Ord, Show) - -$(deriveJson ''Float32le) diff --git a/src/lib/Rattletrap/Type/FloatAttribute.hs b/src/lib/Rattletrap/Type/FloatAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/FloatAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.FloatAttribute - ( FloatAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Float32le - -newtype FloatAttribute = FloatAttribute - { floatAttributeValue :: Float32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''FloatAttribute) diff --git a/src/lib/Rattletrap/Type/Frame.hs b/src/lib/Rattletrap/Type/Frame.hs --- a/src/lib/Rattletrap/Type/Frame.hs +++ b/src/lib/Rattletrap/Type/Frame.hs @@ -1,21 +1,85 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.Frame where -module Rattletrap.Type.Frame - ( Frame(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Replication as Replication +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common -import Rattletrap.Type.Float32le -import Rattletrap.Type.Replication +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.State as State +import qualified Data.Map as Map data Frame = Frame - { frameTime :: Float32le + { time :: F32.F32 -- ^ Time in seconds since the beginning of the match. - , frameDelta :: Float32le + , delta :: F32.F32 -- ^ Time in seconds since the last frame. Usually about 0.03 since there -- are 30 frames per second. - , frameReplications :: [Replication] - } deriving (Eq, Ord, Show) + , replications :: List.List Replication.Replication + } + deriving (Eq, Show) -$(deriveJson ''Frame) +instance Json.FromJSON Frame where + parseJSON = Json.withObject "Frame" $ \object -> do + time <- Json.required object "time" + delta <- Json.required object "delta" + replications <- Json.required object "replications" + pure Frame { time, delta, replications } + +instance Json.ToJSON Frame where + toJSON x = Json.object + [ Json.pair "time" $ time x + , Json.pair "delta" $ delta x + , Json.pair "replications" $ replications x + ] + +schema :: Schema.Schema +schema = Schema.named "frame" $ Schema.object + [ (Json.pair "time" $ Schema.ref F32.schema, True) + , (Json.pair "delta" $ Schema.ref F32.schema, True) + , ( Json.pair "replications" . Schema.json $ List.schema Replication.schema + , True + ) + ] + +putFrames :: List.List Frame -> BitPut.BitPut +putFrames = foldMap bitPut . List.toList + +bitPut :: Frame -> BitPut.BitPut +bitPut frame = + F32.bitPut (time frame) + <> F32.bitPut (delta frame) + <> Replication.putReplications (replications frame) + +decodeFramesBits + :: Version.Version + -> Int + -> Word + -> ClassAttributeMap.ClassAttributeMap + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + (List.List Frame) +decodeFramesBits version count limit classes = + List.replicateM count $ bitGet version limit classes + +bitGet + :: Version.Version + -> Word + -> ClassAttributeMap.ClassAttributeMap + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + Frame +bitGet version limit classes = + Frame + <$> Trans.lift F32.bitGet + <*> Trans.lift F32.bitGet + <*> Replication.decodeReplicationsBits version limit classes diff --git a/src/lib/Rattletrap/Type/GameModeAttribute.hs b/src/lib/Rattletrap/Type/GameModeAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/GameModeAttribute.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.GameModeAttribute - ( GameModeAttribute(..) - ) -where - -import Rattletrap.Type.Common - -data GameModeAttribute = GameModeAttribute - { gameModeAttributeNumBits :: Int - -- ^ This field is guaranteed to be small. In other words, it won't overflow. - -- It's stored as a regular 'Int' rather than something more precise like an - -- 'Int8' because it just gets passed to functions that expect 'Int's. - -- There's no reason to do a bunch of conversions. - , gameModeAttributeWord :: Word8 - } deriving (Eq, Ord, Show) - -$(deriveJson ''GameModeAttribute) diff --git a/src/lib/Rattletrap/Type/Header.hs b/src/lib/Rattletrap/Type/Header.hs --- a/src/lib/Rattletrap/Type/Header.hs +++ b/src/lib/Rattletrap/Type/Header.hs @@ -1,27 +1,26 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Header - ( Header(..) - ) -where +module Rattletrap.Type.Header where -import Rattletrap.Type.Common -import Rattletrap.Type.Dictionary -import Rattletrap.Type.Property -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Dictionary as Dictionary +import qualified Rattletrap.Type.Property as Property +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad -- | Contains high-level metadata about a 'Rattletrap.Replay.Replay'. data Header = Header - { headerEngineVersion :: Word32le + { engineVersion :: U32.U32 -- ^ The "major" ("engine") version number. - , headerLicenseeVersion :: Word32le + , licenseeVersion :: U32.U32 -- ^ The "minor" ("licensee") version number. - , headerPatchVersion :: Maybe Word32le + , patchVersion :: Maybe U32.U32 -- ^ The "patch" ("net") version number. - , headerLabel :: Str + , label :: Str.Str -- ^ Always @TAGame.Replay_Soccar_TA@. - , headerProperties :: Dictionary Property + , properties :: Dictionary.Dictionary Property.Property -- ^ These properties determine how a replay will look in the list of -- replays in-game. One element is required for the replay to show up: -- @@ -56,6 +55,58 @@ -- players per team. This value is not validated, so you can put absurd -- values like 99. To get an "unfair" team size like 1v4, you must set the -- bUnfairBots 'Rattletrap.PropertyValue.BoolProperty' to @True@. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''Header) +instance Json.FromJSON Header where + parseJSON = Json.withObject "Header" $ \object -> do + engineVersion <- Json.required object "engine_version" + licenseeVersion <- Json.required object "licensee_version" + patchVersion <- Json.optional object "patch_version" + label <- Json.required object "label" + properties <- Json.required object "properties" + pure Header + { engineVersion + , licenseeVersion + , patchVersion + , label + , properties + } + +instance Json.ToJSON Header where + toJSON x = Json.object + [ Json.pair "engine_version" $ engineVersion x + , Json.pair "licensee_version" $ licenseeVersion x + , Json.pair "patch_version" $ patchVersion x + , Json.pair "label" $ label x + , Json.pair "properties" $ properties x + ] + +schema :: Schema.Schema +schema = Schema.named "header" $ Schema.object + [ (Json.pair "engine_version" $ Schema.ref U32.schema, True) + , (Json.pair "licensee_version" $ Schema.ref U32.schema, True) + , (Json.pair "patch_version" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "label" $ Schema.ref Str.schema, True) + , ( Json.pair "properties" . Schema.json $ Dictionary.schema Property.schema + , True + ) + ] + +bytePut :: Header -> BytePut.BytePut +bytePut x = + U32.bytePut (engineVersion x) + <> U32.bytePut (licenseeVersion x) + <> foldMap U32.bytePut (patchVersion x) + <> Str.bytePut (label x) + <> Dictionary.bytePut Property.bytePut (properties x) + +byteGet :: ByteGet.ByteGet Header +byteGet = do + (major, minor) <- (,) <$> U32.byteGet <*> U32.byteGet + Header major minor + <$> whenMaybe + (U32.toWord32 major >= 868 && U32.toWord32 minor >= 18) + U32.byteGet + <*> Str.byteGet + <*> Dictionary.byteGet Property.byteGet diff --git a/src/lib/Rattletrap/Type/I32.hs b/src/lib/Rattletrap/Type/I32.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/I32.hs @@ -0,0 +1,44 @@ +module Rattletrap.Type.I32 where + +import qualified Data.Int as Int +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype I32 + = I32 Int.Int32 + deriving (Eq, Show) + +instance Json.FromJSON I32 where + parseJSON = fmap fromInt32 . Json.parseJSON + +instance Json.ToJSON I32 where + toJSON = Json.toJSON . toInt32 + +schema :: Schema.Schema +schema = Schema.named "i32" $ Json.object + [ Json.pair "type" "integer" + , Json.pair "minimum" (minBound :: Int.Int32) + , Json.pair "maximum" (maxBound :: Int.Int32) + ] + +fromInt32 :: Int.Int32 -> I32 +fromInt32 = I32 + +toInt32 :: I32 -> Int.Int32 +toInt32 (I32 x) = x + +bytePut :: I32 -> BytePut.BytePut +bytePut = BytePut.int32 . toInt32 + +bitPut :: I32 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet I32 +byteGet = fromInt32 <$> ByteGet.int32 + +bitGet :: BitGet.BitGet I32 +bitGet = BitGet.fromByteGet byteGet 4 diff --git a/src/lib/Rattletrap/Type/I64.hs b/src/lib/Rattletrap/Type/I64.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/I64.hs @@ -0,0 +1,48 @@ +module Rattletrap.Type.I64 where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Int as Int +import qualified Data.Text as Text +import qualified Text.Read as Read + +newtype I64 + = I64 Int.Int64 + deriving (Eq, Show) + +instance Json.FromJSON I64 where + parseJSON = + Json.withText "I64" + $ either fail (pure . fromInt64) + . Read.readEither + . Text.unpack + +instance Json.ToJSON I64 where + toJSON = Json.toJSON . show . toInt64 + +schema :: Schema.Schema +schema = Schema.named "i64" + $ Json.object [Json.pair "type" "string", Json.pair "pattern" "^-?[0-9]+$"] + +fromInt64 :: Int.Int64 -> I64 +fromInt64 = I64 + +toInt64 :: I64 -> Int.Int64 +toInt64 (I64 x) = x + +bytePut :: I64 -> BytePut.BytePut +bytePut = BytePut.int64 . toInt64 + +bitPut :: I64 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet I64 +byteGet = fromInt64 <$> ByteGet.int64 + +bitGet :: BitGet.BitGet I64 +bitGet = BitGet.fromByteGet byteGet 8 diff --git a/src/lib/Rattletrap/Type/I8.hs b/src/lib/Rattletrap/Type/I8.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/I8.hs @@ -0,0 +1,44 @@ +module Rattletrap.Type.I8 where + +import qualified Data.Int as Int +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype I8 + = I8 Int.Int8 + deriving (Eq, Show) + +instance Json.FromJSON I8 where + parseJSON = fmap fromInt8 . Json.parseJSON + +instance Json.ToJSON I8 where + toJSON = Json.toJSON . toInt8 + +schema :: Schema.Schema +schema = Schema.named "i8" $ Json.object + [ Json.pair "type" "integer" + , Json.pair "minimum" (minBound :: Int.Int8) + , Json.pair "maximum" (maxBound :: Int.Int8) + ] + +fromInt8 :: Int.Int8 -> I8 +fromInt8 = I8 + +toInt8 :: I8 -> Int.Int8 +toInt8 (I8 x) = x + +bytePut :: I8 -> BytePut.BytePut +bytePut = BytePut.int8 . toInt8 + +bitPut :: I8 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet I8 +byteGet = fromInt8 <$> ByteGet.int8 + +bitGet :: BitGet.BitGet I8 +bitGet = BitGet.fromByteGet byteGet 1 diff --git a/src/lib/Rattletrap/Type/Initialization.hs b/src/lib/Rattletrap/Type/Initialization.hs --- a/src/lib/Rattletrap/Type/Initialization.hs +++ b/src/lib/Rattletrap/Type/Initialization.hs @@ -1,21 +1,49 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Initialization - ( Initialization(..) - ) -where +module Rattletrap.Type.Initialization where -import Rattletrap.Type.Common -import Rattletrap.Type.Int8Vector -import Rattletrap.Type.Vector +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Int8Vector as Int8Vector +import qualified Rattletrap.Type.Vector as Vector +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad data Initialization = Initialization - { initializationLocation :: Maybe Vector + { location :: Maybe Vector.Vector -- ^ Not every class has an initial location. See - -- 'Rattletrap.Data.rawClassesWithLocation'. - , initializationRotation :: Maybe Int8Vector + -- 'Rattletrap.Data.classesWithLocation'. + , rotation :: Maybe Int8Vector.Int8Vector -- ^ Only classes with location can have rotation, but not every one does. - -- See 'Rattletrap.Data.rawClassesWithRotation'. - } deriving (Eq, Ord, Show) + -- See 'Rattletrap.Data.classesWithRotation'. + } + deriving (Eq, Show) -$(deriveJson ''Initialization) +instance Json.FromJSON Initialization where + parseJSON = Json.withObject "Initialization" $ \object -> do + location <- Json.optional object "location" + rotation <- Json.optional object "rotation" + pure Initialization { location, rotation } + +instance Json.ToJSON Initialization where + toJSON x = Json.object + [Json.pair "location" $ location x, Json.pair "rotation" $ rotation x] + +schema :: Schema.Schema +schema = Schema.named "initialization" $ Schema.object + [ (Json.pair "location" . Schema.json $ Schema.maybe Vector.schema, False) + , ( Json.pair "rotation" . Schema.json $ Schema.maybe Int8Vector.schema + , False + ) + ] + +bitPut :: Initialization -> BitPut.BitPut +bitPut initialization = + foldMap Vector.bitPut (location initialization) + <> foldMap Int8Vector.bitPut (rotation initialization) + +bitGet :: Version.Version -> Bool -> Bool -> BitGet.BitGet Initialization +bitGet version hasLocation hasRotation = + Initialization + <$> whenMaybe hasLocation (Vector.bitGet version) + <*> whenMaybe hasRotation Int8Vector.bitGet diff --git a/src/lib/Rattletrap/Type/Int32le.hs b/src/lib/Rattletrap/Type/Int32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Int32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Int32le - ( Int32le(..) - ) -where - -import Rattletrap.Type.Common - -newtype Int32le = Int32le - { int32leValue :: Int32 - } deriving (Eq, Ord, Show) - -$(deriveJson ''Int32le) diff --git a/src/lib/Rattletrap/Type/Int64Attribute.hs b/src/lib/Rattletrap/Type/Int64Attribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Int64Attribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Int64Attribute - ( Int64Attribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int64le - -newtype Int64Attribute = Int64Attribute - { int64AttributeValue :: Int64le - } deriving (Eq, Ord, Show) - -$(deriveJson ''Int64Attribute) diff --git a/src/lib/Rattletrap/Type/Int64le.hs b/src/lib/Rattletrap/Type/Int64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Int64le.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Rattletrap.Type.Int64le - ( Int64le(..) - ) -where - -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as Aeson -import qualified Data.Int as Int -import qualified Data.Scientific as Scientific -import qualified Data.Text as Text -import qualified Text.Read as Read - -newtype Int64le = Int64le - { int64leValue :: Int.Int64 - } deriving (Eq, Ord, Show) - -instance Aeson.FromJSON Int64le where - parseJSON value = case value of - Aeson.String text -> case Read.readEither $ Text.unpack text of - Left _ -> Aeson.typeMismatch "Int64le" value - Right int64 -> pure $ Int64le int64 - Aeson.Number number -> case Scientific.toBoundedInteger number of - Nothing -> Aeson.typeMismatch "Int64le" value - Just int64 -> pure $ Int64le int64 - _ -> Aeson.typeMismatch "Int64le" value - -instance Aeson.ToJSON Int64le where - toJSON = Aeson.toJSON . show . int64leValue diff --git a/src/lib/Rattletrap/Type/Int8Vector.hs b/src/lib/Rattletrap/Type/Int8Vector.hs --- a/src/lib/Rattletrap/Type/Int8Vector.hs +++ b/src/lib/Rattletrap/Type/Int8Vector.hs @@ -1,17 +1,53 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Int8Vector - ( Int8Vector(..) - ) -where +module Rattletrap.Type.Int8Vector where -import Rattletrap.Type.Common -import Rattletrap.Type.Int8le +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I8 as I8 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad data Int8Vector = Int8Vector - { int8VectorX :: Maybe Int8le - , int8VectorY :: Maybe Int8le - , int8VectorZ :: Maybe Int8le - } deriving (Eq, Ord, Show) + { x :: Maybe I8.I8 + , y :: Maybe I8.I8 + , z :: Maybe I8.I8 + } + deriving (Eq, Show) -$(deriveJson ''Int8Vector) +instance Json.FromJSON Int8Vector where + parseJSON = Json.withObject "Int8Vector" $ \object -> do + x <- Json.optional object "x" + y <- Json.optional object "y" + z <- Json.optional object "z" + pure Int8Vector { x, y, z } + +instance Json.ToJSON Int8Vector where + toJSON a = + Json.object [Json.pair "x" $ x a, Json.pair "y" $ y a, Json.pair "z" $ z a] + +schema :: Schema.Schema +schema = Schema.named "int8Vector" $ Schema.object + [ (Json.pair "x" . Schema.json $ Schema.maybe I8.schema, False) + , (Json.pair "y" . Schema.json $ Schema.maybe I8.schema, False) + , (Json.pair "z" . Schema.json $ Schema.maybe I8.schema, False) + ] + +bitPut :: Int8Vector -> BitPut.BitPut +bitPut int8Vector = + putInt8VectorField (x int8Vector) + <> putInt8VectorField (y int8Vector) + <> putInt8VectorField (z int8Vector) + +putInt8VectorField :: Maybe I8.I8 -> BitPut.BitPut +putInt8VectorField maybeField = case maybeField of + Nothing -> BitPut.bool False + Just field -> BitPut.bool True <> I8.bitPut field + +bitGet :: BitGet.BitGet Int8Vector +bitGet = + Int8Vector <$> decodeFieldBits <*> decodeFieldBits <*> decodeFieldBits + +decodeFieldBits :: BitGet.BitGet (Maybe I8.I8) +decodeFieldBits = do + hasField <- BitGet.bool + whenMaybe hasField I8.bitGet diff --git a/src/lib/Rattletrap/Type/Int8le.hs b/src/lib/Rattletrap/Type/Int8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Int8le.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Int8le - ( Int8le(..) - ) -where - -import Rattletrap.Type.Common - -newtype Int8le = Int8le - { int8leValue :: Int8 - } deriving (Eq, Ord, Show) - -$(deriveJson ''Int8le) diff --git a/src/lib/Rattletrap/Type/IntAttribute.hs b/src/lib/Rattletrap/Type/IntAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/IntAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.IntAttribute - ( IntAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le - -newtype IntAttribute = IntAttribute - { intAttributeValue :: Int32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''IntAttribute) diff --git a/src/lib/Rattletrap/Type/KeyFrame.hs b/src/lib/Rattletrap/Type/KeyFrame.hs --- a/src/lib/Rattletrap/Type/KeyFrame.hs +++ b/src/lib/Rattletrap/Type/KeyFrame.hs @@ -1,21 +1,46 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.KeyFrame - ( KeyFrame(..) - ) -where +module Rattletrap.Type.KeyFrame where -import Rattletrap.Type.Common -import Rattletrap.Type.Float32le -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data KeyFrame = KeyFrame - { keyFrameTime :: Float32le + { time :: F32.F32 -- ^ When this key frame occurs, in seconds. - , keyFrameFrame :: Word32le + , frame :: U32.U32 -- ^ The frame number of this key frame, starting from 0. - , keyFramePosition :: Word32le + , position :: U32.U32 -- ^ The bit position of this key frame in the stream. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''KeyFrame) +instance Json.FromJSON KeyFrame where + parseJSON = Json.withObject "KeyFrame" $ \object -> do + time <- Json.required object "time" + frame <- Json.required object "frame" + position <- Json.required object "position" + pure KeyFrame { time, frame, position } + +instance Json.ToJSON KeyFrame where + toJSON x = Json.object + [ Json.pair "time" $ time x + , Json.pair "frame" $ frame x + , Json.pair "position" $ position x + ] + +schema :: Schema.Schema +schema = Schema.named "keyFrame" $ Schema.object + [ (Json.pair "time" $ Schema.ref F32.schema, True) + , (Json.pair "frame" $ Schema.ref U32.schema, True) + , (Json.pair "position" $ Schema.ref U32.schema, True) + ] + +bytePut :: KeyFrame -> BytePut.BytePut +bytePut x = + F32.bytePut (time x) <> U32.bytePut (frame x) <> U32.bytePut (position x) + +byteGet :: ByteGet.ByteGet KeyFrame +byteGet = KeyFrame <$> F32.byteGet <*> U32.byteGet <*> U32.byteGet diff --git a/src/lib/Rattletrap/Type/List.hs b/src/lib/Rattletrap/Type/List.hs --- a/src/lib/Rattletrap/Type/List.hs +++ b/src/lib/Rattletrap/Type/List.hs @@ -1,14 +1,54 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.List where -module Rattletrap.Type.List - ( List(..) - ) -where +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common +import qualified Control.Monad as Monad -newtype List a = List - { listValue :: [a] - } deriving (Eq, Ord, Show) +newtype List a + = List [a] + deriving (Eq, Show) -$(deriveJson ''List) +instance Json.FromJSON a => Json.FromJSON (List a) where + parseJSON = fmap fromList . Json.parseJSON + +instance Json.ToJSON a => Json.ToJSON (List a) where + toJSON = Json.toJSON . toList + +schema :: Schema.Schema -> Schema.Schema +schema = Schema.array + +fromList :: [a] -> List a +fromList = List + +empty :: List a +empty = fromList [] + +toList :: List a -> [a] +toList (List x) = x + +bytePut :: (a -> BytePut.BytePut) -> List a -> BytePut.BytePut +bytePut f x = + let v = toList x + in (U32.bytePut . U32.fromWord32 . fromIntegral $ length v) <> foldMap f v + +byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (List a) +byteGet f = do + size <- U32.byteGet + replicateM (fromIntegral $ U32.toWord32 size) f + +replicateM :: Monad m => Int -> m a -> m (List a) +replicateM n = fmap fromList . Monad.replicateM n + +untilM :: Monad m => m (Maybe a) -> m (List a) +untilM f = untilMWith f 0 [] + +untilMWith :: Monad m => m (Maybe a) -> Int -> [(Int, a)] -> m (List a) +untilMWith f i xs = do + m <- f + case m of + Nothing -> pure . fromList . reverse $ fmap snd xs + Just x -> untilMWith f (i + 1) ((i, x) : xs) diff --git a/src/lib/Rattletrap/Type/LoadoutAttribute.hs b/src/lib/Rattletrap/Type/LoadoutAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/LoadoutAttribute.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.LoadoutAttribute - ( LoadoutAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le -import Rattletrap.Type.Word8le - -data LoadoutAttribute = LoadoutAttribute - { loadoutAttributeVersion :: Word8le - , loadoutAttributeBody :: Word32le - , loadoutAttributeDecal :: Word32le - , loadoutAttributeWheels :: Word32le - , loadoutAttributeRocketTrail :: Word32le - -- ^ Now known as "rocket boost". - , loadoutAttributeAntenna :: Word32le - , loadoutAttributeTopper :: Word32le - , loadoutAttributeUnknown1 :: Word32le - , loadoutAttributeUnknown2 :: Maybe Word32le - , loadoutAttributeEngineAudio :: Maybe Word32le - , loadoutAttributeTrail :: Maybe Word32le - , loadoutAttributeGoalExplosion :: Maybe Word32le - , loadoutAttributeBanner :: Maybe Word32le - , loadoutAttributeUnknown3 :: Maybe Word32le - , loadoutAttributeUnknown4 :: Maybe Word32le - , loadoutAttributeUnknown5 :: Maybe Word32le - , loadoutAttributeUnknown6 :: Maybe Word32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''LoadoutAttribute) diff --git a/src/lib/Rattletrap/Type/LoadoutOnlineAttribute.hs b/src/lib/Rattletrap/Type/LoadoutOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/LoadoutOnlineAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.LoadoutOnlineAttribute - ( LoadoutOnlineAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.ProductAttribute - -newtype LoadoutOnlineAttribute = LoadoutOnlineAttribute - { loadoutAttributeValue :: [[ProductAttribute]] - } deriving (Eq, Ord, Show) - -$(deriveJson ''LoadoutOnlineAttribute) diff --git a/src/lib/Rattletrap/Type/LoadoutsAttribute.hs b/src/lib/Rattletrap/Type/LoadoutsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/LoadoutsAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.LoadoutsAttribute - ( LoadoutsAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.LoadoutAttribute - -data LoadoutsAttribute = LoadoutsAttribute - { loadoutsAttributeBlue :: LoadoutAttribute - , loadoutsAttributeOrange :: LoadoutAttribute - } deriving (Eq, Ord, Show) - -$(deriveJson ''LoadoutsAttribute) diff --git a/src/lib/Rattletrap/Type/LoadoutsOnlineAttribute.hs b/src/lib/Rattletrap/Type/LoadoutsOnlineAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/LoadoutsOnlineAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.LoadoutsOnlineAttribute - ( LoadoutsOnlineAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.LoadoutOnlineAttribute - -data LoadoutsOnlineAttribute = LoadoutsOnlineAttribute - { loadoutsOnlineAttributeBlue :: LoadoutOnlineAttribute - , loadoutsOnlineAttributeOrange :: LoadoutOnlineAttribute - , loadoutsOnlineAttributeUnknown1 :: Bool - , loadoutsOnlineAttributeUnknown2 :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''LoadoutsOnlineAttribute) diff --git a/src/lib/Rattletrap/Type/LocationAttribute.hs b/src/lib/Rattletrap/Type/LocationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/LocationAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.LocationAttribute - ( LocationAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Vector - -newtype LocationAttribute = LocationAttribute - { locationAttributeValue :: Vector - } deriving (Eq, Ord, Show) - -$(deriveJson ''LocationAttribute) diff --git a/src/lib/Rattletrap/Type/Mark.hs b/src/lib/Rattletrap/Type/Mark.hs --- a/src/lib/Rattletrap/Type/Mark.hs +++ b/src/lib/Rattletrap/Type/Mark.hs @@ -1,19 +1,38 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Mark - ( Mark(..) - ) -where +module Rattletrap.Type.Mark where -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data Mark = Mark - { markValue :: Str + { value :: Str.Str -- ^ Which type of mark this is, like @Team0Goal@. - , markFrame :: Word32le + , frame :: U32.U32 -- ^ Which frame this mark belongs to, starting from 0. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''Mark) +instance Json.FromJSON Mark where + parseJSON = Json.withObject "Mark" $ \object -> do + value <- Json.required object "value" + frame <- Json.required object "frame" + pure Mark { value, frame } + +instance Json.ToJSON Mark where + toJSON x = + Json.object [Json.pair "value" $ value x, Json.pair "frame" $ frame x] + +schema :: Schema.Schema +schema = Schema.named "mark" $ Schema.object + [ (Json.pair "value" $ Schema.ref Str.schema, True) + , (Json.pair "frame" $ Schema.ref U32.schema, True) + ] + +bytePut :: Mark -> BytePut.BytePut +bytePut x = Str.bytePut (value x) <> U32.bytePut (frame x) + +byteGet :: ByteGet.ByteGet Mark +byteGet = Mark <$> Str.byteGet <*> U32.byteGet diff --git a/src/lib/Rattletrap/Type/Message.hs b/src/lib/Rattletrap/Type/Message.hs --- a/src/lib/Rattletrap/Type/Message.hs +++ b/src/lib/Rattletrap/Type/Message.hs @@ -1,21 +1,49 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Message - ( Message(..) - ) -where +module Rattletrap.Type.Message where -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Json as Json data Message = Message - { messageFrame :: Word32le + { frame :: U32.U32 -- ^ Which frame this message belongs to, starting from 0. - , messageName :: Str + , name :: Str.Str -- ^ The primary player's name. - , messageValue :: Str + , value :: Str.Str -- ^ The content of the message. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''Message) +instance Json.FromJSON Message where + parseJSON = Json.withObject "Message" $ \object -> do + frame <- Json.required object "frame" + name <- Json.required object "name" + value <- Json.required object "value" + pure Message { frame, name, value } + +instance Json.ToJSON Message where + toJSON x = Json.object + [ Json.pair "frame" $ frame x + , Json.pair "name" $ name x + , Json.pair "value" $ value x + ] + +schema :: Schema.Schema +schema = Schema.named "message" $ Schema.object + [ (Json.pair "frame" $ Schema.ref U32.schema, True) + , (Json.pair "name" $ Schema.ref Str.schema, True) + , (Json.pair "value" $ Schema.ref Str.schema, True) + ] + +bytePut :: Message -> BytePut.BytePut +bytePut x = + do + U32.bytePut (frame x) + <> Str.bytePut (name x) + <> Str.bytePut (value x) + +byteGet :: ByteGet.ByteGet Message +byteGet = Message <$> U32.byteGet <*> Str.byteGet <*> Str.byteGet diff --git a/src/lib/Rattletrap/Type/MusicStingerAttribute.hs b/src/lib/Rattletrap/Type/MusicStingerAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/MusicStingerAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.MusicStingerAttribute - ( MusicStingerAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le -import Rattletrap.Type.Word8le - -data MusicStingerAttribute = MusicStingerAttribute - { musicStingerAttributeFlag :: Bool - , musicStingerAttributeCue :: Word32le - , musicStingerAttributeTrigger :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''MusicStingerAttribute) diff --git a/src/lib/Rattletrap/Type/PartyLeaderAttribute.hs b/src/lib/Rattletrap/Type/PartyLeaderAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/PartyLeaderAttribute.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PartyLeaderAttribute - ( PartyLeaderAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.RemoteId -import Rattletrap.Type.Word8le - -data PartyLeaderAttribute = PartyLeaderAttribute - { partyLeaderAttributeSystemId :: Word8le - , partyLeaderAttributeId :: Maybe (RemoteId, Word8le) - } deriving (Eq, Ord, Show) - -$(deriveJson ''PartyLeaderAttribute) diff --git a/src/lib/Rattletrap/Type/PickupAttribute.hs b/src/lib/Rattletrap/Type/PickupAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/PickupAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PickupAttribute - ( PickupAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le - -data PickupAttribute = PickupAttribute - { pickupAttributeInstigatorId :: Maybe Word32le - , pickupAttributePickedUp :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''PickupAttribute) diff --git a/src/lib/Rattletrap/Type/PickupAttributeNew.hs b/src/lib/Rattletrap/Type/PickupAttributeNew.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/PickupAttributeNew.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PickupAttributeNew - ( PickupAttributeNew(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word8le -import Rattletrap.Type.Word32le - -data PickupAttributeNew = PickupAttributeNew - { pickupAttributeNewInstigatorId :: Maybe Word32le - , pickupAttributeNewPickedUp :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''PickupAttributeNew) diff --git a/src/lib/Rattletrap/Type/PlayerHistoryKeyAttribute.hs b/src/lib/Rattletrap/Type/PlayerHistoryKeyAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/PlayerHistoryKeyAttribute.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PlayerHistoryKeyAttribute - ( PlayerHistoryKeyAttribute(..) - ) -where - -import Rattletrap.Type.Common - -newtype PlayerHistoryKeyAttribute = PlayerHistoryKeyAttribute - { playerHistoryKeyAttributeUnknown :: Word16 - } deriving (Eq, Ord, Show) - -$(deriveJson ''PlayerHistoryKeyAttribute) diff --git a/src/lib/Rattletrap/Type/PrivateMatchSettingsAttribute.hs b/src/lib/Rattletrap/Type/PrivateMatchSettingsAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/PrivateMatchSettingsAttribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PrivateMatchSettingsAttribute - ( PrivateMatchSettingsAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -data PrivateMatchSettingsAttribute = PrivateMatchSettingsAttribute - { privateMatchSettingsAttributeMutators :: Str - , privateMatchSettingsAttributeJoinableBy :: Word32le - , privateMatchSettingsAttributeMaxPlayers :: Word32le - , privateMatchSettingsAttributeGameName :: Str - , privateMatchSettingsAttributePassword :: Str - , privateMatchSettingsAttributeFlag :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''PrivateMatchSettingsAttribute) diff --git a/src/lib/Rattletrap/Type/ProductAttribute.hs b/src/lib/Rattletrap/Type/ProductAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ProductAttribute.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ProductAttribute - ( ProductAttribute(..) - , ProductAttributeValue(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -data ProductAttributeValue - = ProductAttributeValuePaintedOld CompressedWord - | ProductAttributeValuePaintedNew Word32 - | ProductAttributeValueTeamEditionOld CompressedWord - | ProductAttributeValueTeamEditionNew Word32 - | ProductAttributeValueSpecialEdition Word32 - | ProductAttributeValueUserColorOld (Maybe Word32) - | ProductAttributeValueUserColorNew Word32le - | ProductAttributeValueTitleId Str - deriving (Eq, Ord, Show) - -$(deriveJson ''ProductAttributeValue) - -data ProductAttribute = ProductAttribute - { productAttributeUnknown :: Bool - , productAttributeObjectId :: Word32le - , productAttributeObjectName :: Maybe Str - -- ^ read-only - , productAttributeValue :: ProductAttributeValue - } deriving (Eq, Ord, Show) - -$(deriveJson ''ProductAttribute) diff --git a/src/lib/Rattletrap/Type/Property.hs b/src/lib/Rattletrap/Type/Property.hs --- a/src/lib/Rattletrap/Type/Property.hs +++ b/src/lib/Rattletrap/Type/Property.hs @@ -1,20 +1,49 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Property - ( Property(..) - ) -where +module Rattletrap.Type.Property where -import Rattletrap.Type.Common -import Rattletrap.Type.PropertyValue -import Rattletrap.Type.Str -import Rattletrap.Type.Word64le +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.PropertyValue as PropertyValue +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U64 as U64 +import qualified Rattletrap.Utility.Json as Json data Property = Property - { propertyKind :: Str - , propertySize :: Word64le + { kind :: Str.Str + , size :: U64.U64 -- ^ Not used. - , propertyValue :: PropertyValue Property - } deriving (Eq, Ord, Show) + , value :: PropertyValue.PropertyValue Property + } + deriving (Eq, Show) -$(deriveJson ''Property) +instance Json.FromJSON Property where + parseJSON = Json.withObject "Property" $ \object -> do + kind <- Json.required object "kind" + size <- Json.required object "size" + value <- Json.required object "value" + pure Property { kind, size, value } + +instance Json.ToJSON Property where + toJSON x = Json.object + [ Json.pair "kind" $ kind x + , Json.pair "size" $ size x + , Json.pair "value" $ value x + ] + +schema :: Schema.Schema +schema = Schema.named "property" $ Schema.object + [ (Json.pair "kind" $ Schema.ref Str.schema, True) + , (Json.pair "size" $ Schema.ref U64.schema, True) + , (Json.pair "value" . Schema.ref $ PropertyValue.schema schema, True) + ] + +bytePut :: Property -> BytePut.BytePut +bytePut x = + Str.bytePut (kind x) <> U64.bytePut (size x) <> PropertyValue.bytePut + bytePut + (value x) + +byteGet :: ByteGet.ByteGet Property +byteGet = do + kind_ <- Str.byteGet + Property kind_ <$> U64.byteGet <*> PropertyValue.byteGet byteGet kind_ diff --git a/src/lib/Rattletrap/Type/PropertyValue.hs b/src/lib/Rattletrap/Type/PropertyValue.hs --- a/src/lib/Rattletrap/Type/PropertyValue.hs +++ b/src/lib/Rattletrap/Type/PropertyValue.hs @@ -1,32 +1,98 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.PropertyValue - ( PropertyValue(..) - ) -where +module Rattletrap.Type.PropertyValue where -import Rattletrap.Type.Common -import Rattletrap.Type.Dictionary -import Rattletrap.Type.Float32le -import Rattletrap.Type.Int32le -import Rattletrap.Type.List -import Rattletrap.Type.Str -import Rattletrap.Type.Word64le -import Rattletrap.Type.Word8le +import qualified Data.Foldable as Foldable +import qualified Data.Text as Text +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Dictionary as Dictionary +import qualified Rattletrap.Type.F32 as F32 +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U64 as U64 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad data PropertyValue a - = PropertyValueArray (List (Dictionary a)) + = Array (List.List (Dictionary.Dictionary a)) -- ^ Yes, a list of dictionaries. No, it doesn't make sense. These usually -- only have one element. - | PropertyValueBool Word8le - | PropertyValueByte Str (Maybe Str) + | Bool U8.U8 + | Byte Str.Str (Maybe Str.Str) -- ^ This is a strange name for essentially a key-value pair. - | PropertyValueFloat Float32le - | PropertyValueInt Int32le - | PropertyValueName Str + | Float F32.F32 + | Int I32.I32 + | Name Str.Str -- ^ It's unclear how exactly this is different than a 'StrProperty'. - | PropertyValueQWord Word64le - | PropertyValueStr Str - deriving (Eq, Ord, Show) + | QWord U64.U64 + | Str Str.Str + deriving (Eq, Show) -$(deriveJson ''PropertyValue) +instance Json.FromJSON a => Json.FromJSON (PropertyValue a) where + parseJSON = Json.withObject "PropertyValue" $ \object -> Foldable.asum + [ Array <$> Json.required object "array" + , Bool <$> Json.required object "bool" + , uncurry Byte <$> Json.required object "byte" + , Float <$> Json.required object "float" + , Int <$> Json.required object "int" + , Name <$> Json.required object "name" + , QWord <$> Json.required object "q_word" + , Str <$> Json.required object "str" + ] + +instance Json.ToJSON a => Json.ToJSON (PropertyValue a) where + toJSON x = case x of + Array y -> Json.object [Json.pair "array" y] + Bool y -> Json.object [Json.pair "bool" y] + Byte y z -> Json.object [Json.pair "byte" (y, z)] + Float y -> Json.object [Json.pair "float" y] + Int y -> Json.object [Json.pair "int" y] + Name y -> Json.object [Json.pair "name" y] + QWord y -> Json.object [Json.pair "q_word" y] + Str y -> Json.object [Json.pair "str" y] + +schema :: Schema.Schema -> Schema.Schema +schema s = + Schema.named ("property-value-" <> Text.unpack (Schema.name s)) + . Schema.oneOf + $ fmap + (\(k, v) -> Schema.object [(Json.pair k v, True)]) + [ ("array", Schema.json . List.schema $ Dictionary.schema s) + , ("bool", Schema.ref U8.schema) + , ( "byte" + , Schema.tuple + [Schema.ref Str.schema, Schema.json $ Schema.maybe Str.schema] + ) + , ("float", Schema.ref F32.schema) + , ("int", Schema.ref I32.schema) + , ("name", Schema.ref Str.schema) + , ("q_word", Schema.ref U64.schema) + , ("str", Schema.ref Str.schema) + ] + +bytePut :: (a -> BytePut.BytePut) -> PropertyValue a -> BytePut.BytePut +bytePut putProperty value = case value of + Array x -> List.bytePut (Dictionary.bytePut putProperty) x + Bool x -> U8.bytePut x + Byte k mv -> Str.bytePut k <> foldMap Str.bytePut mv + Float x -> F32.bytePut x + Int x -> I32.bytePut x + Name x -> Str.bytePut x + QWord x -> U64.bytePut x + Str x -> Str.bytePut x + +byteGet :: ByteGet.ByteGet a -> Str.Str -> ByteGet.ByteGet (PropertyValue a) +byteGet getProperty kind = case Str.toString kind of + "ArrayProperty" -> Array <$> List.byteGet (Dictionary.byteGet getProperty) + "BoolProperty" -> Bool <$> U8.byteGet + "ByteProperty" -> do + k <- Str.byteGet + Byte k <$> whenMaybe (Str.toString k /= "OnlinePlatform_Steam") Str.byteGet + "FloatProperty" -> Float <$> F32.byteGet + "IntProperty" -> Int <$> I32.byteGet + "NameProperty" -> Name <$> Str.byteGet + "QWordProperty" -> QWord <$> U64.byteGet + "StrProperty" -> Str <$> Str.byteGet + _ -> fail ("[RT07] don't know how to read property value " <> show kind) diff --git a/src/lib/Rattletrap/Type/QWordAttribute.hs b/src/lib/Rattletrap/Type/QWordAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/QWordAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.QWordAttribute - ( QWordAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word64le - -newtype QWordAttribute = QWordAttribute - { qWordAttributeValue :: Word64le - } deriving (Eq, Ord, Show) - -$(deriveJson ''QWordAttribute) diff --git a/src/lib/Rattletrap/Type/Quaternion.hs b/src/lib/Rattletrap/Type/Quaternion.hs --- a/src/lib/Rattletrap/Type/Quaternion.hs +++ b/src/lib/Rattletrap/Type/Quaternion.hs @@ -1,79 +1,94 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Quaternion - ( Quaternion(..) - , Component(..) - , toQuaternion - , compressPart - , decompressPart - , maxComponent - , maxCompressedValue - ) -where +module Rattletrap.Type.Quaternion where -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Utility.Json as Json import qualified Data.List as List import qualified Data.Maybe as Maybe +import qualified Data.Ord as Ord data Quaternion = Quaternion - { quaternionX :: Double - , quaternionY :: Double - , quaternionZ :: Double - , quaternionW :: Double - } deriving (Eq, Ord, Show) + { x :: Double + , y :: Double + , z :: Double + , w :: Double + } + deriving (Eq, Show) -$(deriveJson ''Quaternion) +instance Json.FromJSON Quaternion where + parseJSON = Json.withObject "Quaternion" $ \object -> do + x <- Json.required object "x" + y <- Json.required object "y" + z <- Json.required object "z" + w <- Json.required object "w" + pure Quaternion { x, y, z, w } +instance Json.ToJSON Quaternion where + toJSON a = Json.object + [ Json.pair "x" $ x a + , Json.pair "y" $ y a + , Json.pair "z" $ z a + , Json.pair "w" $ w a + ] + +schema :: Schema.Schema +schema = Schema.named "quaternion" $ Schema.object + [ (Json.pair "x" $ Schema.ref Schema.number, True) + , (Json.pair "y" $ Schema.ref Schema.number, True) + , (Json.pair "z" $ Schema.ref Schema.number, True) + , (Json.pair "w" $ Schema.ref Schema.number, True) + ] + data Component - = ComponentX - | ComponentY - | ComponentZ - | ComponentW - deriving (Eq, Ord, Show) + = X + | Y + | Z + | W + deriving (Eq, Show) toQuaternion :: Component -> Double -> Double -> Double -> Quaternion toQuaternion component a b c = let d = toPart a b c in case component of - ComponentX -> Quaternion d a b c - ComponentY -> Quaternion a d b c - ComponentZ -> Quaternion a b d c - ComponentW -> Quaternion a b c d + X -> Quaternion d a b c + Y -> Quaternion a d b c + Z -> Quaternion a b d c + W -> Quaternion a b c d toPart :: Double -> Double -> Double -> Double toPart a b c = sqrt (1 - (a * a) - (b * b) - (c * c)) -compressPart :: Double -> CompressedWord +compressPart :: Double -> CompressedWord.CompressedWord compressPart = - CompressedWord maxCompressedValue + CompressedWord.CompressedWord maxCompressedValue . round . (* wordToDouble maxCompressedValue) . (+ 0.5) . (/ 2.0) . (/ maxValue) -decompressPart :: CompressedWord -> Double -decompressPart x = +decompressPart :: CompressedWord.CompressedWord -> Double +decompressPart x_ = (* maxValue) . (* 2.0) . subtract 0.5 - . (/ wordToDouble (compressedWordLimit x)) + . (/ wordToDouble (CompressedWord.limit x_)) . wordToDouble - $ compressedWordValue x + $ CompressedWord.value x_ maxComponent :: Quaternion -> Component maxComponent quaternion = let - x = quaternionX quaternion - y = quaternionY quaternion - z = quaternionZ quaternion - w = quaternionW quaternion - parts = - [(x, ComponentX), (y, ComponentY), (z, ComponentZ), (w, ComponentW)] - biggestPart = maximum parts + x_ = x quaternion + y_ = y quaternion + z_ = z quaternion + w_ = w quaternion + parts = [(x_, X), (y_, Y), (z_, Z), (w_, W)] + biggestPart = maximumOn fst parts roundTrip = decompressPart . compressPart computedPart = Maybe.fromMaybe biggestPart @@ -85,6 +100,9 @@ else computedPart ) +maximumOn :: (Foldable t, Ord b) => (a -> b) -> t a -> a +maximumOn f = List.maximumBy (Ord.comparing f) + numBits :: Word numBits = 18 @@ -96,3 +114,48 @@ maxValue :: Double maxValue = 1.0 / sqrt 2.0 + +bitPut :: Quaternion -> BitPut.BitPut +bitPut q = + let c = maxComponent q + in + putComponent c <> case c of + X -> putParts (y q) (z q) (w q) + Y -> putParts (x q) (z q) (w q) + Z -> putParts (x q) (y q) (w q) + W -> putParts (x q) (y q) (z q) + +putComponent :: Component -> BitPut.BitPut +putComponent component = CompressedWord.bitPut + (CompressedWord.CompressedWord + 3 + (case component of + X -> 0 + Y -> 1 + Z -> 2 + W -> 3 + ) + ) + +putParts :: Double -> Double -> Double -> BitPut.BitPut +putParts a b c = putPart a <> putPart b <> putPart c + +putPart :: Double -> BitPut.BitPut +putPart = CompressedWord.bitPut . compressPart + +bitGet :: BitGet.BitGet Quaternion +bitGet = + toQuaternion <$> decodeComponent <*> decodePart <*> decodePart <*> decodePart + +decodeComponent :: BitGet.BitGet Component +decodeComponent = do + x_ <- CompressedWord.bitGet 3 + case CompressedWord.value x_ of + 0 -> pure X + 1 -> pure Y + 2 -> pure Z + 3 -> pure W + y_ -> fail ("[RT08] invalid component: " <> show y_) + +decodePart :: BitGet.BitGet Double +decodePart = decompressPart <$> CompressedWord.bitGet maxCompressedValue diff --git a/src/lib/Rattletrap/Type/RemoteId.hs b/src/lib/Rattletrap/Type/RemoteId.hs --- a/src/lib/Rattletrap/Type/RemoteId.hs +++ b/src/lib/Rattletrap/Type/RemoteId.hs @@ -1,23 +1,135 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.RemoteId where -module Rattletrap.Type.RemoteId - ( RemoteId(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U64 as U64 +import qualified Rattletrap.Type.U8 as U8 +import qualified Rattletrap.Type.Version as Version +import Rattletrap.Utility.Bytes +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common -import Rattletrap.Type.Str -import Rattletrap.Type.Word64le +import qualified Data.ByteString as Bytes +import qualified Data.Foldable as Foldable +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Word as Word data RemoteId - = RemoteIdPlayStation Text [Word8] - | RemoteIdPsyNet (Either Word64le (Word64le, Word64le, Word64le, Word64le)) - | RemoteIdSplitscreen Word32 + = PlayStation Text.Text [Word.Word8] + | PsyNet (Either U64.U64 (U64.U64, U64.U64, U64.U64, U64.U64)) + | Splitscreen Word.Word32 -- ^ Really only 24 bits. - | RemoteIdSteam Word64le - | RemoteIdSwitch Word64le Word64le Word64le Word64le - | RemoteIdXbox Word64le - | RemoteIdEpic Str - deriving (Eq, Ord, Show) + | Steam U64.U64 + | Switch U64.U64 U64.U64 U64.U64 U64.U64 + | Xbox U64.U64 + | Epic Str.Str + deriving (Eq, Show) -$(deriveJson ''RemoteId) +instance Json.FromJSON RemoteId where + parseJSON = Json.withObject "RemoteId" $ \object -> Foldable.asum + [ uncurry PlayStation <$> Json.required object "play_station" + , PsyNet <$> Json.required object "psy_net" + , Splitscreen <$> Json.required object "splitscreen" + , Steam <$> Json.required object "steam" + , uncurry4 Switch <$> Json.required object "switch" + , Xbox <$> Json.required object "xbox" + , Epic <$> Json.required object "epic" + ] + +uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e +uncurry4 f (a, b, c, d) = f a b c d + +instance Json.ToJSON RemoteId where + toJSON x = case x of + PlayStation y z -> Json.object [Json.pair "play_station" (y, z)] + PsyNet y -> Json.object [Json.pair "psy_net" y] + Splitscreen y -> Json.object [Json.pair "splitscreen" y] + Steam y -> Json.object [Json.pair "steam" y] + Switch y z a b -> Json.object [Json.pair "switch" (y, z, a, b)] + Xbox y -> Json.object [Json.pair "xbox" y] + Epic y -> Json.object [Json.pair "epic" y] + +schema :: Schema.Schema +schema = Schema.named "remote-id" . Schema.oneOf $ fmap + (\(k, v) -> Schema.object [(Json.pair k v, True)]) + [ ( "play_station" + , Schema.tuple + [Schema.ref Schema.string, Schema.json $ Schema.array Schema.number] + ) + , ( "psy_net" + , Schema.oneOf + [ Schema.object [(Json.pair "Left" $ Schema.ref U64.schema, True)] + , Schema.object + [ ( Json.pair "Right" . Schema.tuple . replicate 4 $ Schema.ref + U64.schema + , True + ) + ] + ] + ) + , ("splitscreen", Schema.ref Schema.integer) + , ("steam", Schema.ref U64.schema) + , ("switch", Schema.tuple . replicate 4 $ Schema.ref U64.schema) + , ("xbox", Schema.ref U64.schema) + , ("epic", Schema.ref Str.schema) + ] + +bitPut :: RemoteId -> BitPut.BitPut +bitPut remoteId = case remoteId of + PlayStation name bytes -> + let rawName = reverseBytes (padBytes (16 :: Int) (encodeLatin1 name)) + in BitPut.byteString rawName <> BitPut.byteString (Bytes.pack bytes) + PsyNet e -> case e of + Left l -> U64.bitPut l + Right (a, b, c, d) -> putWord256 a b c d + Splitscreen word24 -> BitPut.bits 24 word24 + Steam word64 -> U64.bitPut word64 + Switch a b c d -> putWord256 a b c d + Xbox word64 -> U64.bitPut word64 + Epic str -> Str.bitPut str + +putWord256 :: U64.U64 -> U64.U64 -> U64.U64 -> U64.U64 -> BitPut.BitPut +putWord256 a b c d = + U64.bitPut a <> U64.bitPut b <> U64.bitPut c <> U64.bitPut d + +bitGet :: Version.Version -> U8.U8 -> BitGet.BitGet RemoteId +bitGet version systemId = case U8.toWord8 systemId of + 0 -> Splitscreen <$> BitGet.bits 24 + 1 -> Steam <$> U64.bitGet + 2 -> PlayStation <$> decodePsName <*> decodePsBytes version + 4 -> Xbox <$> U64.bitGet + 6 -> do + (a, b, c, d) <- getWord256 + pure $ Switch a b c d + 7 -> if psyNetIsU64 version + then PsyNet . Left <$> U64.bitGet + else PsyNet . Right <$> getWord256 + 11 -> Epic <$> Str.bitGet + _ -> fail ("[RT09] unknown system id " <> show systemId) + +psyNetIsU64 :: Version.Version -> Bool +psyNetIsU64 v = + Version.major v >= 868 && Version.minor v >= 24 && Version.patch v >= 10 + +decodePsName :: BitGet.BitGet Text.Text +decodePsName = fmap + (Text.dropWhileEnd (== '\x00') . Text.decodeLatin1 . reverseBytes) + (BitGet.byteString 16) + +decodePsBytes :: Version.Version -> BitGet.BitGet [Word.Word8] +decodePsBytes version = Bytes.unpack + <$> BitGet.byteString (if playStationIsU24 version then 24 else 16) + +playStationIsU24 :: Version.Version -> Bool +playStationIsU24 v = + Version.major v >= 868 && Version.minor v >= 20 && Version.patch v >= 1 + +getWord256 :: BitGet.BitGet (U64.U64, U64.U64, U64.U64, U64.U64) +getWord256 = do + a <- U64.bitGet + b <- U64.bitGet + c <- U64.bitGet + d <- U64.bitGet + pure (a, b, c, d) diff --git a/src/lib/Rattletrap/Type/Replay.hs b/src/lib/Rattletrap/Type/Replay.hs --- a/src/lib/Rattletrap/Type/Replay.hs +++ b/src/lib/Rattletrap/Type/Replay.hs @@ -1,24 +1,124 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Replay - ( FullReplay - , Replay(..) - ) -where +module Rattletrap.Type.Replay where -import Rattletrap.Type.Common -import Rattletrap.Type.Content -import Rattletrap.Type.Header -import Rattletrap.Type.Section +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Content as Content +import qualified Rattletrap.Type.Dictionary as Dictionary +import qualified Rattletrap.Type.Header as Header +import qualified Rattletrap.Type.I32 as I32 +import qualified Rattletrap.Type.Property as Property +import qualified Rattletrap.Type.PropertyValue as PropertyValue +import qualified Rattletrap.Type.Section as Section +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import qualified Rattletrap.Version as Version -type FullReplay = Replay Content +type Replay + = ReplayWith + (Section.Section Header.Header) + (Section.Section Content.Content) -- | A Rocket League replay. -data Replay content = Replay - { replayHeader :: Section Header +data ReplayWith header content = Replay + { header :: header -- ^ This has most of the high-level metadata. - , replayContent :: Section content + , content :: content -- ^ This has most of the low-level game data. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''Replay) +instance (Json.FromJSON h, Json.FromJSON c) => Json.FromJSON (ReplayWith h c) where + parseJSON = Json.withObject "Replay" $ \object -> do + header <- Json.required object "header" + content <- Json.required object "content" + pure Replay { header, content } + +instance (Json.ToJSON h, Json.ToJSON c) => Json.ToJSON (ReplayWith h c) where + toJSON x = Json.object + [ Json.pair "$schema" schemaUrl + , Json.pair "header" $ header x + , Json.pair "content" $ content x + ] + +schema :: Schema.Schema -> Schema.Schema -> Schema.Schema +schema h c = Schema.named "replay" $ Schema.object + [ (Json.pair "header" $ Schema.ref h, True) + , (Json.pair "content" $ Schema.ref c, True) + ] + +schemaUrl :: String +schemaUrl = mconcat + [ "https://github.com/tfausak/rattletrap/releases/download/" + , Version.string + , "/rattletrap-" + , Version.string + , "-schema.json" + ] + +bytePut :: Replay -> BytePut.BytePut +bytePut x = Section.bytePut Header.bytePut (header x) + <> Section.bytePut Content.bytePut (content x) + +byteGet :: Bool -> Bool -> ByteGet.ByteGet Replay +byteGet fast skip = do + hs <- Section.byteGet skip $ ByteGet.byteString . fromIntegral . U32.toWord32 + h <- either fail pure . ByteGet.run Header.byteGet $ Section.body hs + cs <- Section.byteGet skip $ ByteGet.byteString . fromIntegral . U32.toWord32 + c <- if fast + then pure Content.empty + else either fail pure . ByteGet.run (getContent h) $ Section.body cs + pure Replay + { header = hs { Section.body = h } + , content = cs { Section.body = c } + } + +getContent :: Header.Header -> ByteGet.ByteGet Content.Content +getContent h = + Content.byteGet (getVersion h) (getNumFrames h) (getMaxChannels h) + +getVersion :: Header.Header -> Version.Version +getVersion x = Version.Version + { Version.major = fromIntegral . U32.toWord32 $ Header.engineVersion x + , Version.minor = fromIntegral . U32.toWord32 $ Header.licenseeVersion x + , Version.patch = getPatchVersion x + } + +getPatchVersion :: Header.Header -> Int +getPatchVersion header_ = case Header.patchVersion header_ of + Just version -> fromIntegral (U32.toWord32 version) + Nothing -> + case + Dictionary.lookup + (Str.fromString "MatchType") + (Header.properties header_) + of + -- This is an ugly, ugly hack to handle replays from season 2 of RLCS. + -- See `decodeSpawnedReplicationBits` and #85. + Just Property.Property { Property.value = PropertyValue.Name str } + | Str.toString str == "Lan" -> -1 + _ -> 0 + +getNumFrames :: Header.Header -> Int +getNumFrames header_ = + case + Dictionary.lookup + (Str.fromString "NumFrames") + (Header.properties header_) + of + Just (Property.Property _ _ (PropertyValue.Int numFrames)) -> + fromIntegral (I32.toInt32 numFrames) + _ -> 0 + +getMaxChannels :: Header.Header -> Word +getMaxChannels header_ = + case + Dictionary.lookup + (Str.fromString "MaxChannels") + (Header.properties header_) + of + Just (Property.Property _ _ (PropertyValue.Int numFrames)) -> + fromIntegral (I32.toInt32 numFrames) + _ -> 1023 diff --git a/src/lib/Rattletrap/Type/Replication.hs b/src/lib/Rattletrap/Type/Replication.hs --- a/src/lib/Rattletrap/Type/Replication.hs +++ b/src/lib/Rattletrap/Type/Replication.hs @@ -1,17 +1,71 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.Replication where -module Rattletrap.Type.Replication - ( Replication(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.ReplicationValue as ReplicationValue +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.ReplicationValue +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.State as State +import qualified Data.Map as Map data Replication = Replication - { replicationActorId :: CompressedWord - , replicationValue :: ReplicationValue - } deriving (Eq, Ord, Show) + { actorId :: CompressedWord.CompressedWord + , value :: ReplicationValue.ReplicationValue + } + deriving (Eq, Show) -$(deriveJson ''Replication) +instance Json.FromJSON Replication where + parseJSON = Json.withObject "Replication" $ \object -> do + actorId <- Json.required object "actor_id" + value <- Json.required object "value" + pure Replication { actorId, value } + +instance Json.ToJSON Replication where + toJSON x = + Json.object [Json.pair "actor_id" $ actorId x, Json.pair "value" $ value x] + +schema :: Schema.Schema +schema = Schema.named "replication" $ Schema.object + [ (Json.pair "actor_id" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "value" $ Schema.ref ReplicationValue.schema, True) + ] + +putReplications :: List.List Replication -> BitPut.BitPut +putReplications xs = + foldMap (\x -> BitPut.bool True <> bitPut x) (List.toList xs) + <> BitPut.bool False + +bitPut :: Replication -> BitPut.BitPut +bitPut replication = CompressedWord.bitPut (actorId replication) + <> ReplicationValue.bitPut (value replication) + +decodeReplicationsBits + :: Version.Version + -> Word + -> ClassAttributeMap.ClassAttributeMap + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + (List.List Replication) +decodeReplicationsBits version limit classes = List.untilM $ do + p <- Trans.lift BitGet.bool + if p then Just <$> bitGet version limit classes else pure Nothing + +bitGet + :: Version.Version + -> Word + -> ClassAttributeMap.ClassAttributeMap + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + Replication +bitGet version limit classes = do + actor <- Trans.lift (CompressedWord.bitGet limit) + Replication actor <$> ReplicationValue.bitGet version classes actor diff --git a/src/lib/Rattletrap/Type/Replication/Destroyed.hs b/src/lib/Rattletrap/Type/Replication/Destroyed.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Replication/Destroyed.hs @@ -0,0 +1,30 @@ +module Rattletrap.Type.Replication.Destroyed where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +-- | Destroyed replications don't actually contain any extra information. All +-- you need to know is the actor's ID, which is given by the +-- 'Rattletrap.Replication.Replication'. +data Destroyed = Destroyed + deriving (Eq, Show) + +instance Json.FromJSON Destroyed where + parseJSON json = do + () <- Json.parseJSON json + pure Destroyed + +instance Json.ToJSON Destroyed where + toJSON = const $ Json.toJSON () + +schema :: Schema.Schema +schema = + Schema.named "replication-destroyed" $ Json.object [Json.pair "type" "array"] + +bitPut :: Destroyed -> BitPut.BitPut +bitPut _ = mempty + +bitGet :: BitGet.BitGet Destroyed +bitGet = pure Destroyed diff --git a/src/lib/Rattletrap/Type/Replication/Spawned.hs b/src/lib/Rattletrap/Type/Replication/Spawned.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Replication/Spawned.hs @@ -0,0 +1,156 @@ +module Rattletrap.Type.Replication.Spawned where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Initialization as Initialization +import qualified Rattletrap.Type.Str as Str +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json +import Rattletrap.Utility.Monad + +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.State as State +import qualified Data.Map as Map + +data Spawned = Spawned + { flag :: Bool + -- ^ Unclear what this is. + , nameIndex :: Maybe U32.U32 + , name :: Maybe Str.Str + -- ^ Read-only! Changing a replication's name requires editing the + -- 'nameIndex' and maybe the class attribute map. + , objectId :: U32.U32 + , objectName :: Str.Str + -- ^ Read-only! Changing a replication's object requires editing the class + -- attribute map. + , className :: Str.Str + -- ^ Read-only! Changing a replication's class requires editing the class + -- attribute map. + , initialization :: Initialization.Initialization + } + deriving (Eq, Show) + +instance Json.FromJSON Spawned where + parseJSON = Json.withObject "Spawned" $ \object -> do + flag <- Json.required object "flag" + nameIndex <- Json.optional object "name_index" + name <- Json.optional object "name" + objectId <- Json.required object "object_id" + objectName <- Json.required object "object_name" + className <- Json.required object "class_name" + initialization <- Json.required object "initialization" + pure Spawned + { flag + , nameIndex + , name + , objectId + , objectName + , className + , initialization + } + +instance Json.ToJSON Spawned where + toJSON x = Json.object + [ Json.pair "flag" $ flag x + , Json.pair "name_index" $ nameIndex x + , Json.pair "name" $ name x + , Json.pair "object_id" $ objectId x + , Json.pair "object_name" $ objectName x + , Json.pair "class_name" $ className x + , Json.pair "initialization" $ initialization x + ] + +schema :: Schema.Schema +schema = Schema.named "replication-spawned" $ Schema.object + [ (Json.pair "flag" $ Schema.ref Schema.boolean, True) + , (Json.pair "name_index" . Schema.json $ Schema.maybe U32.schema, False) + , (Json.pair "name" . Schema.json $ Schema.maybe Str.schema, False) + , (Json.pair "object_id" $ Schema.ref U32.schema, True) + , (Json.pair "object_name" $ Schema.ref Str.schema, True) + , (Json.pair "class_name" $ Schema.ref Str.schema, True) + , (Json.pair "initialization" $ Schema.ref Initialization.schema, True) + ] + +bitPut :: Spawned -> BitPut.BitPut +bitPut spawnedReplication = + BitPut.bool (flag spawnedReplication) + <> foldMap U32.bitPut (nameIndex spawnedReplication) + <> U32.bitPut (objectId spawnedReplication) + <> Initialization.bitPut (initialization spawnedReplication) + +bitGet + :: Version.Version + -> ClassAttributeMap.ClassAttributeMap + -> CompressedWord.CompressedWord + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + Spawned +bitGet version classAttributeMap actorId = do + flag_ <- Trans.lift BitGet.bool + nameIndex_ <- whenMaybe (hasNameIndex version) (Trans.lift U32.bitGet) + name_ <- either fail pure (lookupName classAttributeMap nameIndex_) + objectId_ <- Trans.lift U32.bitGet + State.modify (Map.insert actorId objectId_) + objectName_ <- either + fail + pure + (lookupObjectName classAttributeMap objectId_) + className_ <- either fail pure (lookupClassName objectName_) + let hasLocation = ClassAttributeMap.classHasLocation className_ + let hasRotation = ClassAttributeMap.classHasRotation className_ + initialization_ <- Trans.lift + (Initialization.bitGet version hasLocation hasRotation) + pure + (Spawned + flag_ + nameIndex_ + name_ + objectId_ + objectName_ + className_ + initialization_ + ) + +hasNameIndex :: Version.Version -> Bool +hasNameIndex v = + Version.major v >= 868 && Version.minor v >= 14 && Version.patch v >= 0 + +lookupName + :: ClassAttributeMap.ClassAttributeMap + -> Maybe U32.U32 + -> Either String (Maybe Str.Str) +lookupName classAttributeMap maybeNameIndex = case maybeNameIndex of + Nothing -> Right Nothing + Just nameIndex_ -> + case + ClassAttributeMap.getName + (ClassAttributeMap.nameMap classAttributeMap) + nameIndex_ + of + Nothing -> + Left ("[RT11] could not get name for index " <> show nameIndex_) + Just name_ -> Right (Just name_) + +lookupObjectName + :: ClassAttributeMap.ClassAttributeMap -> U32.U32 -> Either String Str.Str +lookupObjectName classAttributeMap objectId_ = + case + ClassAttributeMap.getObjectName + (ClassAttributeMap.objectMap classAttributeMap) + objectId_ + of + Nothing -> + Left ("[RT12] could not get object name for id " <> show objectId_) + Just objectName_ -> Right objectName_ + +lookupClassName :: Str.Str -> Either String Str.Str +lookupClassName objectName_ = + case ClassAttributeMap.getClassName objectName_ of + Nothing -> + Left ("[RT13] could not get class name for object " <> show objectName_) + Just className_ -> Right className_ diff --git a/src/lib/Rattletrap/Type/Replication/Updated.hs b/src/lib/Rattletrap/Type/Replication/Updated.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Replication/Updated.hs @@ -0,0 +1,47 @@ +module Rattletrap.Type.Replication.Updated where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.Attribute as Attribute +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.List as List +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Map as Map + +newtype Updated = Updated + { attributes :: List.List Attribute.Attribute + } deriving (Eq, Show) + +instance Json.FromJSON Updated where + parseJSON = fmap Updated . Json.parseJSON + +instance Json.ToJSON Updated where + toJSON = Json.toJSON . attributes + +schema :: Schema.Schema +schema = Schema.named "replication-updated" . Schema.json $ List.schema + Attribute.schema + +bitPut :: Updated -> BitPut.BitPut +bitPut x = + foldMap + (\y -> BitPut.bool True <> Attribute.bitPut y) + (List.toList $ attributes x) + <> BitPut.bool False + +bitGet + :: Version.Version + -> ClassAttributeMap.ClassAttributeMap + -> Map.Map CompressedWord.CompressedWord U32.U32 + -> CompressedWord.CompressedWord + -> BitGet.BitGet Updated +bitGet version classes actors actor = fmap Updated . List.untilM $ do + p <- BitGet.bool + if p + then Just <$> Attribute.bitGet version classes actors actor + else pure Nothing diff --git a/src/lib/Rattletrap/Type/ReplicationValue.hs b/src/lib/Rattletrap/Type/ReplicationValue.hs --- a/src/lib/Rattletrap/Type/ReplicationValue.hs +++ b/src/lib/Rattletrap/Type/ReplicationValue.hs @@ -1,22 +1,74 @@ -{-# LANGUAGE TemplateHaskell #-} +module Rattletrap.Type.ReplicationValue where -module Rattletrap.Type.ReplicationValue - ( ReplicationValue(..) - ) -where +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Replication.Destroyed as Destroyed +import qualified Rattletrap.Type.Replication.Spawned as Spawned +import qualified Rattletrap.Type.Replication.Updated as Updated +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json -import Rattletrap.Type.Common -import Rattletrap.Type.DestroyedReplication -import Rattletrap.Type.SpawnedReplication -import Rattletrap.Type.UpdatedReplication +import qualified Control.Monad.Trans.Class as Trans +import qualified Control.Monad.Trans.State as State +import qualified Data.Foldable as Foldable +import qualified Data.Map as Map data ReplicationValue - = ReplicationValueSpawned SpawnedReplication + = Spawned Spawned.Spawned -- ^ Creates a new actor. - | ReplicationValueUpdated UpdatedReplication + | Updated Updated.Updated -- ^ Updates an existing actor. - | ReplicationValueDestroyed DestroyedReplication + | Destroyed Destroyed.Destroyed -- ^ Destroys an existing actor. - deriving (Eq, Ord, Show) + deriving (Eq, Show) -$(deriveJson ''ReplicationValue) +instance Json.FromJSON ReplicationValue where + parseJSON = Json.withObject "ReplicationValue" $ \object -> Foldable.asum + [ Spawned <$> Json.required object "spawned" + , Updated <$> Json.required object "updated" + , Destroyed <$> Json.required object "destroyed" + ] + +instance Json.ToJSON ReplicationValue where + toJSON x = case x of + Spawned y -> Json.object [Json.pair "spawned" y] + Updated y -> Json.object [Json.pair "updated" y] + Destroyed y -> Json.object [Json.pair "destroyed" y] + +schema :: Schema.Schema +schema = Schema.named "replicationValue" . Schema.oneOf $ fmap + (\(k, v) -> Schema.object [(Json.pair k $ Schema.ref v, True)]) + [ ("spawned", Spawned.schema) + , ("updated", Updated.schema) + , ("destroyed", Destroyed.schema) + ] + +bitPut :: ReplicationValue -> BitPut.BitPut +bitPut value = case value of + Spawned x -> BitPut.bool True <> BitPut.bool True <> Spawned.bitPut x + Updated x -> BitPut.bool True <> BitPut.bool False <> Updated.bitPut x + Destroyed x -> BitPut.bool False <> Destroyed.bitPut x + +bitGet + :: Version.Version + -> ClassAttributeMap.ClassAttributeMap + -> CompressedWord.CompressedWord + -> State.StateT + (Map.Map CompressedWord.CompressedWord U32.U32) + BitGet.BitGet + ReplicationValue +bitGet version classAttributeMap actorId = do + actorMap <- State.get + isOpen <- Trans.lift BitGet.bool + if isOpen + then do + isNew <- Trans.lift BitGet.bool + if isNew + then Spawned <$> Spawned.bitGet version classAttributeMap actorId + else Updated <$> Trans.lift + (Updated.bitGet version classAttributeMap actorMap actorId) + else Destroyed <$> Trans.lift Destroyed.bitGet diff --git a/src/lib/Rattletrap/Type/ReservationAttribute.hs b/src/lib/Rattletrap/Type/ReservationAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/ReservationAttribute.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.ReservationAttribute - ( ReservationAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord -import Rattletrap.Type.Str -import Rattletrap.Type.UniqueIdAttribute - -data ReservationAttribute = ReservationAttribute - { reservationAttributeNumber :: CompressedWord - , reservationAttributeUniqueId :: UniqueIdAttribute - , reservationAttributeName :: Maybe Str - , reservationAttributeUnknown1 :: Bool - , reservationAttributeUnknown2 :: Bool - , reservationAttributeUnknown3 :: Maybe Word8 - } deriving (Eq, Ord, Show) - -$(deriveJson ''ReservationAttribute) diff --git a/src/lib/Rattletrap/Type/RigidBodyStateAttribute.hs b/src/lib/Rattletrap/Type/RigidBodyStateAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/RigidBodyStateAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.RigidBodyStateAttribute - ( RigidBodyStateAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Rotation -import Rattletrap.Type.Vector - -data RigidBodyStateAttribute = RigidBodyStateAttribute - { rigidBodyStateAttributeSleeping :: Bool - , rigidBodyStateAttributeLocation :: Vector - , rigidBodyStateAttributeRotation :: Rotation - , rigidBodyStateAttributeLinearVelocity :: Maybe Vector - , rigidBodyStateAttributeAngularVelocity :: Maybe Vector - } deriving (Eq, Ord, Show) - -$(deriveJson ''RigidBodyStateAttribute) diff --git a/src/lib/Rattletrap/Type/Rotation.hs b/src/lib/Rattletrap/Type/Rotation.hs --- a/src/lib/Rattletrap/Type/Rotation.hs +++ b/src/lib/Rattletrap/Type/Rotation.hs @@ -1,17 +1,48 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Rotation - ( Rotation(..) - ) -where +module Rattletrap.Type.Rotation where -import Rattletrap.Type.Common -import Rattletrap.Type.Quaternion -import Rattletrap.Type.CompressedWordVector +import qualified Data.Foldable as Foldable +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.CompressedWordVector as CompressedWordVector +import qualified Rattletrap.Type.Quaternion as Quaternion +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json data Rotation - = RotationCompressedWordVector CompressedWordVector - | RotationQuaternion Quaternion - deriving (Eq, Ord, Show) + = CompressedWordVector CompressedWordVector.CompressedWordVector + | Quaternion Quaternion.Quaternion + deriving (Eq, Show) -$(deriveJson ''Rotation) +instance Json.FromJSON Rotation where + parseJSON = Json.withObject "Rotation" $ \object -> Foldable.asum + [ CompressedWordVector <$> Json.required object "compressed_word_vector" + , Quaternion <$> Json.required object "quaternion" + ] + +instance Json.ToJSON Rotation where + toJSON x = case x of + CompressedWordVector y -> + Json.object [Json.pair "compressed_word_vector" y] + Quaternion y -> Json.object [Json.pair "quaternion" y] + +schema :: Schema.Schema +schema = Schema.named "rotation" . Schema.oneOf $ fmap + (\(k, v) -> Schema.object [(Json.pair k $ Schema.ref v, True)]) + [ ("compressed_word_vector", CompressedWordVector.schema) + , ("quaternion", Quaternion.schema) + ] + +bitPut :: Rotation -> BitPut.BitPut +bitPut r = case r of + CompressedWordVector cwv -> CompressedWordVector.bitPut cwv + Quaternion q -> Quaternion.bitPut q + +bitGet :: Version.Version -> BitGet.BitGet Rotation +bitGet version = if isQuaternion version + then Quaternion <$> Quaternion.bitGet + else CompressedWordVector <$> CompressedWordVector.bitGet + +isQuaternion :: Version.Version -> Bool +isQuaternion v = + Version.major v >= 868 && Version.minor v >= 22 && Version.patch v >= 7 diff --git a/src/lib/Rattletrap/Type/Section.hs b/src/lib/Rattletrap/Type/Section.hs --- a/src/lib/Rattletrap/Type/Section.hs +++ b/src/lib/Rattletrap/Type/Section.hs @@ -1,41 +1,91 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Section - ( Section(..) - , toSection - ) -where +module Rattletrap.Type.Section where -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le -import Rattletrap.Utility.Crc +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.U32 as U32 +import qualified Rattletrap.Utility.Crc as Crc +import qualified Rattletrap.Utility.Json as Json -import qualified Data.Binary as Binary -import qualified Data.Binary.Put as Binary +import qualified Control.Monad as Monad import qualified Data.ByteString as Bytes -import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Text as Text -- | A section is a large piece of a 'Rattletrap.Replay.Replay'. It has a -- 32-bit size (in bytes), a 32-bit CRC (see "Rattletrap.Utility.Crc"), and then a -- bunch of data (the body). This interface is provided so that you don't have -- to think about the size and CRC. data Section a = Section - { sectionSize :: Word32le + { size :: U32.U32 -- ^ read only - , sectionCrc :: Word32le + , crc :: U32.U32 -- ^ read only - , sectionBody :: a + , body :: a -- ^ The actual content in the section. - } deriving (Eq, Ord, Show) + } + deriving (Eq, Show) -$(deriveJson ''Section) +instance Json.FromJSON a => Json.FromJSON (Section a) where + parseJSON = Json.withObject "Section" $ \object -> do + size <- Json.required object "size" + crc <- Json.required object "crc" + body <- Json.required object "body" + pure Section { size, crc, body } -toSection :: (a -> Binary.Put) -> a -> Section a -toSection encode body = - let bytes = LazyBytes.toStrict . Binary.runPut $ encode body +instance Json.ToJSON a => Json.ToJSON (Section a) where + toJSON x = Json.object + [ Json.pair "size" $ size x + , Json.pair "crc" $ crc x + , Json.pair "body" $ body x + ] + +schema :: Schema.Schema -> Schema.Schema +schema s = + Schema.named ("section-" <> Text.unpack (Schema.name s)) $ Schema.object + [ (Json.pair "size" $ Schema.ref U32.schema, True) + , (Json.pair "crc" $ Schema.ref U32.schema, True) + , (Json.pair "body" $ Schema.ref s, True) + ] + +create :: (a -> BytePut.BytePut) -> a -> Section a +create encode body_ = + let bytes = BytePut.toByteString $ encode body_ in Section - { sectionSize = Word32le . fromIntegral $ Bytes.length bytes - , sectionCrc = Word32le $ getCrc32 bytes - , sectionBody = body + { size = U32.fromWord32 . fromIntegral $ Bytes.length bytes + , crc = U32.fromWord32 $ Crc.compute bytes + , body = body_ } + +-- | Given a way to put the 'body', puts a section. This will also put +-- the size and CRC. +bytePut :: (a -> BytePut.BytePut) -> Section a -> BytePut.BytePut +bytePut putBody section = + let + rawBody = BytePut.toByteString . putBody $ body section + size_ = Bytes.length rawBody + crc_ = Crc.compute rawBody + in + U32.bytePut (U32.fromWord32 (fromIntegral size_)) + <> U32.bytePut (U32.fromWord32 crc_) + <> BytePut.byteString rawBody + +byteGet + :: Bool -> (U32.U32 -> ByteGet.ByteGet a) -> ByteGet.ByteGet (Section a) +byteGet skip getBody = do + size_ <- U32.byteGet + crc_ <- U32.byteGet + rawBody <- ByteGet.byteString (fromIntegral (U32.toWord32 size_)) + Monad.unless skip $ do + let actualCrc = U32.fromWord32 (Crc.compute rawBody) + Monad.when (actualCrc /= crc_) (fail (crcMessage actualCrc crc_)) + body_ <- either fail pure $ ByteGet.run (getBody size_) rawBody + pure (Section size_ crc_ body_) + +crcMessage :: U32.U32 -> U32.U32 -> String +crcMessage actual expected = unwords + [ "[RT10] actual CRC" + , show actual + , "does not match expected CRC" + , show expected + ] diff --git a/src/lib/Rattletrap/Type/SpawnedReplication.hs b/src/lib/Rattletrap/Type/SpawnedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/SpawnedReplication.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.SpawnedReplication - ( SpawnedReplication(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Initialization -import Rattletrap.Type.Str -import Rattletrap.Type.Word32le - -data SpawnedReplication = SpawnedReplication - { spawnedReplicationFlag :: Bool - -- ^ Unclear what this is. - , spawnedReplicationNameIndex :: Maybe Word32le - , spawnedReplicationName :: Maybe Str - -- ^ Read-only! Changing a replication's name requires editing the - -- 'spawnedReplicationNameIndex' and maybe the class attribute map. - , spawnedReplicationObjectId :: Word32le - , spawnedReplicationObjectName :: Str - -- ^ Read-only! Changing a replication's object requires editing the class - -- attribute map. - , spawnedReplicationClassName :: Str - -- ^ Read-only! Changing a replication's class requires editing the class - -- attribute map. - , spawnedReplicationInitialization :: Initialization - } deriving (Eq, Ord, Show) - -$(deriveJson ''SpawnedReplication) diff --git a/src/lib/Rattletrap/Type/StatEventAttribute.hs b/src/lib/Rattletrap/Type/StatEventAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/StatEventAttribute.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.StatEventAttribute - ( StatEventAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Int32le - -data StatEventAttribute = StatEventAttribute - { statEventAttributeUnknown :: Bool - , statEventAttributeObjectId :: Int32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''StatEventAttribute) diff --git a/src/lib/Rattletrap/Type/Str.hs b/src/lib/Rattletrap/Type/Str.hs --- a/src/lib/Rattletrap/Type/Str.hs +++ b/src/lib/Rattletrap/Type/Str.hs @@ -1,24 +1,103 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Str - ( Str(..) - , toStr - , fromStr - ) -where +module Rattletrap.Type.Str where -import Rattletrap.Type.Common +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.I32 as I32 +import Rattletrap.Utility.Bytes +import qualified Rattletrap.Utility.Json as Json +import qualified Data.ByteString as Bytes +import qualified Data.Char as Char +import qualified Data.Int as Int import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Text.Encoding.Error as Text +import qualified Debug.Trace as Debug -newtype Str = Str - { strValue :: Text - } deriving (Eq, Ord, Show) +newtype Str + = Str Text.Text + deriving (Eq, Ord, Show) -$(deriveJson ''Str) +instance Json.FromJSON Str where + parseJSON = fmap fromText . Json.parseJSON -toStr :: String -> Str -toStr string = Str (Text.pack string) +instance Json.ToJSON Str where + toJSON = Json.toJSON . toText -fromStr :: Str -> String -fromStr text = Text.unpack (strValue text) +schema :: Schema.Schema +schema = Schema.named "str" $ Json.object [Json.pair "type" "string"] + +fromText :: Text.Text -> Str +fromText = Str + +toText :: Str -> Text.Text +toText (Str x) = x + +fromString :: String -> Str +fromString = fromText . Text.pack + +toString :: Str -> String +toString = Text.unpack . toText + +bytePut :: Str -> BytePut.BytePut +bytePut text = + let + size = getTextSize text + encode = getTextEncoder size + in I32.bytePut size <> (BytePut.byteString . encode . addNull $ toText text) + +bitPut :: Str -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +getTextSize :: Str -> I32.I32 +getTextSize text = + let + value = toText text + scale = if Text.all Char.isLatin1 value then 1 else -1 :: Int.Int32 + rawSize = if Text.null value + then 0 + else fromIntegral (Text.length value) + 1 :: Int.Int32 + size = if value == Text.pack "\x00\x00\x00None" + then 0x05000000 + else scale * rawSize :: Int.Int32 + in I32.fromInt32 size + +getTextEncoder :: I32.I32 -> Text.Text -> Bytes.ByteString +getTextEncoder size text = + if I32.toInt32 size < 0 then Text.encodeUtf16LE text else encodeLatin1 text + +addNull :: Text.Text -> Text.Text +addNull text = if Text.null text then text else Text.snoc text '\x00' + +byteGet :: ByteGet.ByteGet Str +byteGet = do + rawSize <- I32.byteGet + bytes <- ByteGet.byteString (normalizeTextSize rawSize) + pure (fromText (dropNull (getTextDecoder rawSize bytes))) + +bitGet :: BitGet.BitGet Str +bitGet = do + rawSize <- I32.bitGet + bytes <- BitGet.byteString (normalizeTextSize rawSize) + pure (fromText (dropNull (getTextDecoder rawSize (reverseBytes bytes)))) + +normalizeTextSize :: Integral a => I32.I32 -> a +normalizeTextSize size = case I32.toInt32 size of + 0x05000000 -> 8 + x -> if x < 0 then (-2 * fromIntegral x) else fromIntegral x + +getTextDecoder :: I32.I32 -> Bytes.ByteString -> Text.Text +getTextDecoder size bytes = + let + decode = if I32.toInt32 size < 0 + then Text.decodeUtf16LEWith $ \message input -> do + Debug.traceM $ "WARNING: " <> show (Text.DecodeError message input) + Text.lenientDecode message input + else Text.decodeLatin1 + in decode bytes + +dropNull :: Text.Text -> Text.Text +dropNull = Text.dropWhileEnd (== '\x00') diff --git a/src/lib/Rattletrap/Type/StringAttribute.hs b/src/lib/Rattletrap/Type/StringAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/StringAttribute.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.StringAttribute - ( StringAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Str - -newtype StringAttribute = StringAttribute - { stringAttributeValue :: Str - } deriving (Eq, Ord, Show) - -$(deriveJson ''StringAttribute) diff --git a/src/lib/Rattletrap/Type/TeamPaintAttribute.hs b/src/lib/Rattletrap/Type/TeamPaintAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/TeamPaintAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.TeamPaintAttribute - ( TeamPaintAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le -import Rattletrap.Type.Word8le - -data TeamPaintAttribute = TeamPaintAttribute - { teamPaintAttributeTeam :: Word8le - , teamPaintAttributePrimaryColor :: Word8le - , teamPaintAttributeAccentColor :: Word8le - , teamPaintAttributePrimaryFinish :: Word32le - , teamPaintAttributeAccentFinish :: Word32le - } deriving (Eq, Ord, Show) - -$(deriveJson ''TeamPaintAttribute) diff --git a/src/lib/Rattletrap/Type/TitleAttribute.hs b/src/lib/Rattletrap/Type/TitleAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/TitleAttribute.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.TitleAttribute - ( TitleAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Word32le - -data TitleAttribute = TitleAttribute - { titleAttributeUnknown1 :: Bool - , titleAttributeUnknown2 :: Bool - , titleAttributeUnknown3 :: Word32le - , titleAttributeUnknown4 :: Word32le - , titleAttributeUnknown5 :: Word32le - , titleAttributeUnknown6 :: Word32le - , titleAttributeUnknown7 :: Word32le - , titleAttributeUnknown8 :: Bool - } deriving (Eq, Ord, Show) - -$(deriveJson ''TitleAttribute) diff --git a/src/lib/Rattletrap/Type/U32.hs b/src/lib/Rattletrap/Type/U32.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/U32.hs @@ -0,0 +1,44 @@ +module Rattletrap.Type.U32 where + +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype U32 + = U32 Word.Word32 + deriving (Eq, Ord, Show) + +instance Json.FromJSON U32 where + parseJSON = fmap fromWord32 . Json.parseJSON + +instance Json.ToJSON U32 where + toJSON = Json.toJSON . toWord32 + +schema :: Schema.Schema +schema = Schema.named "u32" $ Json.object + [ Json.pair "type" "integer" + , Json.pair "minimum" (minBound :: Word.Word32) + , Json.pair "maximum" (maxBound :: Word.Word32) + ] + +fromWord32 :: Word.Word32 -> U32 +fromWord32 = U32 + +toWord32 :: U32 -> Word.Word32 +toWord32 (U32 x) = x + +bytePut :: U32 -> BytePut.BytePut +bytePut = BytePut.word32 . toWord32 + +bitPut :: U32 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet U32 +byteGet = fromWord32 <$> ByteGet.word32 + +bitGet :: BitGet.BitGet U32 +bitGet = BitGet.fromByteGet byteGet 4 diff --git a/src/lib/Rattletrap/Type/U64.hs b/src/lib/Rattletrap/Type/U64.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/U64.hs @@ -0,0 +1,48 @@ +module Rattletrap.Type.U64 where + +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +import qualified Data.Text as Text +import qualified Data.Word as Word +import qualified Text.Read as Read + +newtype U64 + = U64 Word.Word64 + deriving (Eq, Show) + +instance Json.FromJSON U64 where + parseJSON = + Json.withText "U64" + $ either fail (pure . fromWord64) + . Read.readEither + . Text.unpack + +instance Json.ToJSON U64 where + toJSON = Json.toJSON . show . toWord64 + +schema :: Schema.Schema +schema = Schema.named "u64" + $ Json.object [Json.pair "type" "string", Json.pair "pattern" "^[0-9]+$"] + +fromWord64 :: Word.Word64 -> U64 +fromWord64 = U64 + +toWord64 :: U64 -> Word.Word64 +toWord64 (U64 x) = x + +bytePut :: U64 -> BytePut.BytePut +bytePut = BytePut.word64 . toWord64 + +bitPut :: U64 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet U64 +byteGet = fromWord64 <$> ByteGet.word64 + +bitGet :: BitGet.BitGet U64 +bitGet = BitGet.fromByteGet byteGet 8 diff --git a/src/lib/Rattletrap/Type/U8.hs b/src/lib/Rattletrap/Type/U8.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/U8.hs @@ -0,0 +1,44 @@ +module Rattletrap.Type.U8 where + +import qualified Data.Word as Word +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Utility.Json as Json + +newtype U8 + = U8 Word.Word8 + deriving (Eq, Show) + +instance Json.FromJSON U8 where + parseJSON = fmap fromWord8 . Json.parseJSON + +instance Json.ToJSON U8 where + toJSON = Json.toJSON . toWord8 + +schema :: Schema.Schema +schema = Schema.named "u8" $ Json.object + [ Json.pair "type" "integer" + , Json.pair "minimum" (minBound :: Word.Word8) + , Json.pair "maximum" (maxBound :: Word.Word8) + ] + +fromWord8 :: Word.Word8 -> U8 +fromWord8 = U8 + +toWord8 :: U8 -> Word.Word8 +toWord8 (U8 x) = x + +bytePut :: U8 -> BytePut.BytePut +bytePut = BytePut.word8 . toWord8 + +bitPut :: U8 -> BitPut.BitPut +bitPut = BitPut.fromBytePut . bytePut + +byteGet :: ByteGet.ByteGet U8 +byteGet = fromWord8 <$> ByteGet.word8 + +bitGet :: BitGet.BitGet U8 +bitGet = BitGet.fromByteGet byteGet 1 diff --git a/src/lib/Rattletrap/Type/UniqueIdAttribute.hs b/src/lib/Rattletrap/Type/UniqueIdAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/UniqueIdAttribute.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.UniqueIdAttribute - ( UniqueIdAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.RemoteId -import Rattletrap.Type.Word8le - -data UniqueIdAttribute = UniqueIdAttribute - { uniqueIdAttributeSystemId :: Word8le - , uniqueIdAttributeRemoteId :: RemoteId - , uniqueIdAttributeLocalId :: Word8le - } deriving (Eq, Ord, Show) - -$(deriveJson ''UniqueIdAttribute) diff --git a/src/lib/Rattletrap/Type/UpdatedReplication.hs b/src/lib/Rattletrap/Type/UpdatedReplication.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/UpdatedReplication.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.UpdatedReplication - ( UpdatedReplication(..) - ) -where - -import Rattletrap.Type.Attribute -import Rattletrap.Type.Common - -newtype UpdatedReplication = UpdatedReplication - { updatedReplicationAttributes :: [Attribute] - } deriving (Eq, Ord, Show) - -$(deriveJson ''UpdatedReplication) diff --git a/src/lib/Rattletrap/Type/Vector.hs b/src/lib/Rattletrap/Type/Vector.hs --- a/src/lib/Rattletrap/Type/Vector.hs +++ b/src/lib/Rattletrap/Type/Vector.hs @@ -1,26 +1,91 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Vector - ( Vector(..) - ) -where +module Rattletrap.Type.Vector where -import Rattletrap.Type.Common -import Rattletrap.Type.CompressedWord +import qualified Rattletrap.BitGet as BitGet +import qualified Rattletrap.BitPut as BitPut +import qualified Rattletrap.Schema as Schema +import qualified Rattletrap.Type.CompressedWord as CompressedWord +import qualified Rattletrap.Type.Version as Version +import qualified Rattletrap.Utility.Json as Json data Vector = Vector - { vectorSize :: CompressedWord - , vectorBias :: Word + { size :: CompressedWord.CompressedWord + , bias :: Word -- ^ This field is guaranteed to be small. In other words, it won't overflow. -- It's stored as a regular 'Word' rather than something more precise like a -- 'Word8' because it just gets passed to a functions that expect 'Word's. -- There's no reason to do a bunch of conversions. - , vectorX :: Int - -- ^ See 'vectorBias'. - , vectorY :: Int - -- ^ See 'vectorBias'. - , vectorZ :: Int - -- ^ See 'vectorBias'. - } deriving (Eq, Ord, Show) + , x :: Int + -- ^ See 'bias'. + , y :: Int + -- ^ See 'bias'. + , z :: Int + -- ^ See 'bias'. + } + deriving (Eq, Show) -$(deriveJson ''Vector) +instance Json.FromJSON Vector where + parseJSON = Json.withObject "Vector" $ \object -> do + size <- Json.required object "size" + bias <- Json.required object "bias" + x <- Json.required object "x" + y <- Json.required object "y" + z <- Json.required object "z" + pure Vector { size, bias, x, y, z } + +instance Json.ToJSON Vector where + toJSON a = Json.object + [ Json.pair "size" $ size a + , Json.pair "bias" $ bias a + , Json.pair "x" $ x a + , Json.pair "y" $ y a + , Json.pair "z" $ z a + ] + +schema :: Schema.Schema +schema = Schema.named "vector" $ Schema.object + [ (Json.pair "size" $ Schema.ref CompressedWord.schema, True) + , (Json.pair "bias" $ Schema.ref Schema.integer, True) + , (Json.pair "x" $ Schema.ref Schema.integer, True) + , (Json.pair "y" $ Schema.ref Schema.integer, True) + , (Json.pair "z" $ Schema.ref Schema.integer, True) + ] + +bitPut :: Vector -> BitPut.BitPut +bitPut vector = + let + bitSize = + round (logBase (2 :: Float) (fromIntegral (bias vector))) - 1 :: Word + dx = fromIntegral (x vector + fromIntegral (bias vector)) :: Word + dy = fromIntegral (y vector + fromIntegral (bias vector)) :: Word + dz = fromIntegral (z vector + fromIntegral (bias vector)) :: Word + limit = 2 ^ (bitSize + 2) :: Word + in + CompressedWord.bitPut (size vector) + <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dx) + <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dy) + <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dz) + +bitGet :: Version.Version -> BitGet.BitGet Vector +bitGet version = do + size_ <- CompressedWord.bitGet (if has21Bits version then 21 else 19) + let + limit = getLimit size_ + bias_ = getBias size_ + Vector size_ bias_ + <$> fmap (fromDelta bias_) (CompressedWord.bitGet limit) + <*> fmap (fromDelta bias_) (CompressedWord.bitGet limit) + <*> fmap (fromDelta bias_) (CompressedWord.bitGet limit) + +has21Bits :: Version.Version -> Bool +has21Bits v = + Version.major v >= 868 && Version.minor v >= 22 && Version.patch v >= 7 + +getLimit :: CompressedWord.CompressedWord -> Word +getLimit = (2 ^) . (+ 2) . CompressedWord.value + +getBias :: CompressedWord.CompressedWord -> Word +getBias = (2 ^) . (+ 1) . CompressedWord.value + +fromDelta :: Word -> CompressedWord.CompressedWord -> Int +fromDelta bias_ x_ = + fromIntegral (CompressedWord.value x_) - fromIntegral bias_ diff --git a/src/lib/Rattletrap/Type/Version.hs b/src/lib/Rattletrap/Type/Version.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Type/Version.hs @@ -0,0 +1,8 @@ +module Rattletrap.Type.Version where + +data Version = Version + { major :: Int + , minor :: Int + , patch :: Int + } + deriving (Eq, Show) diff --git a/src/lib/Rattletrap/Type/WeldedInfoAttribute.hs b/src/lib/Rattletrap/Type/WeldedInfoAttribute.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/WeldedInfoAttribute.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.WeldedInfoAttribute - ( WeldedInfoAttribute(..) - ) -where - -import Rattletrap.Type.Common -import Rattletrap.Type.Float32le -import Rattletrap.Type.Int32le -import Rattletrap.Type.Int8Vector -import Rattletrap.Type.Vector - -data WeldedInfoAttribute = WeldedInfoAttribute - { weldedInfoAttributeActive :: Bool - , weldedInfoAttributeActorId :: Int32le - , weldedInfoAttributeOffset :: Vector - , weldedInfoAttributeMass :: Float32le - , weldedInfoAttributeRotation :: Int8Vector - } deriving (Eq, Ord, Show) - -$(deriveJson ''WeldedInfoAttribute) diff --git a/src/lib/Rattletrap/Type/Word32le.hs b/src/lib/Rattletrap/Type/Word32le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Word32le.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Word32le - ( Word32le(..) - ) -where - -import Rattletrap.Type.Common - -newtype Word32le = Word32le - { word32leValue :: Word32 - } deriving (Eq, Ord, Show) - -$(deriveJson ''Word32le) diff --git a/src/lib/Rattletrap/Type/Word64le.hs b/src/lib/Rattletrap/Type/Word64le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Word64le.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Rattletrap.Type.Word64le - ( Word64le(..) - ) -where - -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as Aeson -import qualified Data.Scientific as Scientific -import qualified Data.Text as Text -import qualified Data.Word as Word -import qualified Text.Read as Read - -newtype Word64le = Word64le - { word64leValue :: Word.Word64 - } deriving (Eq, Ord, Show) - -instance Aeson.FromJSON Word64le where - parseJSON value = case value of - Aeson.String text -> case Read.readEither $ Text.unpack text of - Left _ -> Aeson.typeMismatch "Word64le" value - Right word64 -> pure $ Word64le word64 - Aeson.Number number -> case Scientific.toBoundedInteger number of - Nothing -> Aeson.typeMismatch "Word64le" value - Just word64 -> pure $ Word64le word64 - _ -> Aeson.typeMismatch "Word64le" value - -instance Aeson.ToJSON Word64le where - toJSON = Aeson.toJSON . show . word64leValue diff --git a/src/lib/Rattletrap/Type/Word8le.hs b/src/lib/Rattletrap/Type/Word8le.hs deleted file mode 100644 --- a/src/lib/Rattletrap/Type/Word8le.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Rattletrap.Type.Word8le - ( Word8le(..) - ) -where - -import Rattletrap.Type.Common - -newtype Word8le = Word8le - { word8leValue :: Word8 - } deriving (Eq, Ord, Show) - -$(deriveJson ''Word8le) diff --git a/src/lib/Rattletrap/Utility/Bytes.hs b/src/lib/Rattletrap/Utility/Bytes.hs --- a/src/lib/Rattletrap/Utility/Bytes.hs +++ b/src/lib/Rattletrap/Utility/Bytes.hs @@ -2,8 +2,7 @@ ( encodeLatin1 , padBytes , reverseBytes - ) -where + ) where import qualified Data.Bits as Bits import qualified Data.ByteString as Bytes diff --git a/src/lib/Rattletrap/Utility/Crc.hs b/src/lib/Rattletrap/Utility/Crc.hs --- a/src/lib/Rattletrap/Utility/Crc.hs +++ b/src/lib/Rattletrap/Utility/Crc.hs @@ -1,47 +1,295 @@ module Rattletrap.Utility.Crc - ( getCrc32 - ) -where - -import Rattletrap.Data + ( compute + ) where +import qualified Data.Array.Unboxed as Array import qualified Data.Bits as Bits import qualified Data.ByteString as Bytes -import qualified Data.IntMap as IntMap import qualified Data.Word as Word -- | Computes the CRC32 of some bytes. This is done to ensure that the bytes -- are valid before trying to parse them. -- -- @ --- getCrc32 ('Data.ByteString.Lazy.pack' [0x00]) +-- compute ('Data.ByteString.Lazy.pack' [0x00]) -- @ -- -- This CRC uses an initial value of @0xefcbf201@ and a polynomial of -- @0x04c11db7@. -getCrc32 :: Bytes.ByteString -> Word.Word32 -getCrc32 bytes = do - let - update = crc32Update crc32Table - initial = Bits.complement crc32Initial - crc = Bytes.foldl update initial bytes - Bits.complement crc +compute :: Bytes.ByteString -> Word.Word32 +compute = Bits.complement . Bytes.foldl' update initial -crc32Update - :: IntMap.IntMap Word.Word32 -> Word.Word32 -> Word.Word8 -> Word.Word32 -crc32Update table crc byte = do +update :: Word.Word32 -> Word.Word8 -> Word.Word32 +update crc byte = let - toWord8 :: (Integral a) => a -> Word.Word8 - toWord8 = fromIntegral - toInt :: (Integral a) => a -> Int - toInt = fromIntegral - index = toInt (Bits.xor byte (toWord8 (Bits.shiftR crc 24))) - left = table IntMap.! index + index = Bits.xor byte . unsafeWord32ToWord8 $ Bits.shiftR crc 24 + left = table Array.! index right = Bits.shiftL crc 8 - Bits.xor left right + in Bits.xor left right -crc32Initial :: Word.Word32 -crc32Initial = 0xefcbf201 +unsafeWord32ToWord8 :: Word.Word32 -> Word.Word8 +unsafeWord32ToWord8 = fromIntegral -crc32Table :: IntMap.IntMap Word.Word32 -crc32Table = IntMap.fromDistinctAscList (zip [0 ..] rawCrc32Table) +initial :: Word.Word32 +initial = Bits.complement 0xefcbf201 + +table :: Array.Array Word.Word8 Word.Word32 +table = Array.listArray + (0, 255) + [ 0x00000000 + , 0x04c11db7 + , 0x09823b6e + , 0x0d4326d9 + , 0x130476dc + , 0x17c56b6b + , 0x1a864db2 + , 0x1e475005 + , 0x2608edb8 + , 0x22c9f00f + , 0x2f8ad6d6 + , 0x2b4bcb61 + , 0x350c9b64 + , 0x31cd86d3 + , 0x3c8ea00a + , 0x384fbdbd + , 0x4c11db70 + , 0x48d0c6c7 + , 0x4593e01e + , 0x4152fda9 + , 0x5f15adac + , 0x5bd4b01b + , 0x569796c2 + , 0x52568b75 + , 0x6a1936c8 + , 0x6ed82b7f + , 0x639b0da6 + , 0x675a1011 + , 0x791d4014 + , 0x7ddc5da3 + , 0x709f7b7a + , 0x745e66cd + , 0x9823b6e0 + , 0x9ce2ab57 + , 0x91a18d8e + , 0x95609039 + , 0x8b27c03c + , 0x8fe6dd8b + , 0x82a5fb52 + , 0x8664e6e5 + , 0xbe2b5b58 + , 0xbaea46ef + , 0xb7a96036 + , 0xb3687d81 + , 0xad2f2d84 + , 0xa9ee3033 + , 0xa4ad16ea + , 0xa06c0b5d + , 0xd4326d90 + , 0xd0f37027 + , 0xddb056fe + , 0xd9714b49 + , 0xc7361b4c + , 0xc3f706fb + , 0xceb42022 + , 0xca753d95 + , 0xf23a8028 + , 0xf6fb9d9f + , 0xfbb8bb46 + , 0xff79a6f1 + , 0xe13ef6f4 + , 0xe5ffeb43 + , 0xe8bccd9a + , 0xec7dd02d + , 0x34867077 + , 0x30476dc0 + , 0x3d044b19 + , 0x39c556ae + , 0x278206ab + , 0x23431b1c + , 0x2e003dc5 + , 0x2ac12072 + , 0x128e9dcf + , 0x164f8078 + , 0x1b0ca6a1 + , 0x1fcdbb16 + , 0x018aeb13 + , 0x054bf6a4 + , 0x0808d07d + , 0x0cc9cdca + , 0x7897ab07 + , 0x7c56b6b0 + , 0x71159069 + , 0x75d48dde + , 0x6b93dddb + , 0x6f52c06c + , 0x6211e6b5 + , 0x66d0fb02 + , 0x5e9f46bf + , 0x5a5e5b08 + , 0x571d7dd1 + , 0x53dc6066 + , 0x4d9b3063 + , 0x495a2dd4 + , 0x44190b0d + , 0x40d816ba + , 0xaca5c697 + , 0xa864db20 + , 0xa527fdf9 + , 0xa1e6e04e + , 0xbfa1b04b + , 0xbb60adfc + , 0xb6238b25 + , 0xb2e29692 + , 0x8aad2b2f + , 0x8e6c3698 + , 0x832f1041 + , 0x87ee0df6 + , 0x99a95df3 + , 0x9d684044 + , 0x902b669d + , 0x94ea7b2a + , 0xe0b41de7 + , 0xe4750050 + , 0xe9362689 + , 0xedf73b3e + , 0xf3b06b3b + , 0xf771768c + , 0xfa325055 + , 0xfef34de2 + , 0xc6bcf05f + , 0xc27dede8 + , 0xcf3ecb31 + , 0xcbffd686 + , 0xd5b88683 + , 0xd1799b34 + , 0xdc3abded + , 0xd8fba05a + , 0x690ce0ee + , 0x6dcdfd59 + , 0x608edb80 + , 0x644fc637 + , 0x7a089632 + , 0x7ec98b85 + , 0x738aad5c + , 0x774bb0eb + , 0x4f040d56 + , 0x4bc510e1 + , 0x46863638 + , 0x42472b8f + , 0x5c007b8a + , 0x58c1663d + , 0x558240e4 + , 0x51435d53 + , 0x251d3b9e + , 0x21dc2629 + , 0x2c9f00f0 + , 0x285e1d47 + , 0x36194d42 + , 0x32d850f5 + , 0x3f9b762c + , 0x3b5a6b9b + , 0x0315d626 + , 0x07d4cb91 + , 0x0a97ed48 + , 0x0e56f0ff + , 0x1011a0fa + , 0x14d0bd4d + , 0x19939b94 + , 0x1d528623 + , 0xf12f560e + , 0xf5ee4bb9 + , 0xf8ad6d60 + , 0xfc6c70d7 + , 0xe22b20d2 + , 0xe6ea3d65 + , 0xeba91bbc + , 0xef68060b + , 0xd727bbb6 + , 0xd3e6a601 + , 0xdea580d8 + , 0xda649d6f + , 0xc423cd6a + , 0xc0e2d0dd + , 0xcda1f604 + , 0xc960ebb3 + , 0xbd3e8d7e + , 0xb9ff90c9 + , 0xb4bcb610 + , 0xb07daba7 + , 0xae3afba2 + , 0xaafbe615 + , 0xa7b8c0cc + , 0xa379dd7b + , 0x9b3660c6 + , 0x9ff77d71 + , 0x92b45ba8 + , 0x9675461f + , 0x8832161a + , 0x8cf30bad + , 0x81b02d74 + , 0x857130c3 + , 0x5d8a9099 + , 0x594b8d2e + , 0x5408abf7 + , 0x50c9b640 + , 0x4e8ee645 + , 0x4a4ffbf2 + , 0x470cdd2b + , 0x43cdc09c + , 0x7b827d21 + , 0x7f436096 + , 0x7200464f + , 0x76c15bf8 + , 0x68860bfd + , 0x6c47164a + , 0x61043093 + , 0x65c52d24 + , 0x119b4be9 + , 0x155a565e + , 0x18197087 + , 0x1cd86d30 + , 0x029f3d35 + , 0x065e2082 + , 0x0b1d065b + , 0x0fdc1bec + , 0x3793a651 + , 0x3352bbe6 + , 0x3e119d3f + , 0x3ad08088 + , 0x2497d08d + , 0x2056cd3a + , 0x2d15ebe3 + , 0x29d4f654 + , 0xc5a92679 + , 0xc1683bce + , 0xcc2b1d17 + , 0xc8ea00a0 + , 0xd6ad50a5 + , 0xd26c4d12 + , 0xdf2f6bcb + , 0xdbee767c + , 0xe3a1cbc1 + , 0xe760d676 + , 0xea23f0af + , 0xeee2ed18 + , 0xf0a5bd1d + , 0xf464a0aa + , 0xf9278673 + , 0xfde69bc4 + , 0x89b8fd09 + , 0x8d79e0be + , 0x803ac667 + , 0x84fbdbd0 + , 0x9abc8bd5 + , 0x9e7d9662 + , 0x933eb0bb + , 0x97ffad0c + , 0xafb010b1 + , 0xab710d06 + , 0xa6322bdf + , 0xa2f33668 + , 0xbcb4666d + , 0xb8757bda + , 0xb5365d03 + , 0xb1f740b4 + ] diff --git a/src/lib/Rattletrap/Utility/Helper.hs b/src/lib/Rattletrap/Utility/Helper.hs --- a/src/lib/Rattletrap/Utility/Helper.hs +++ b/src/lib/Rattletrap/Utility/Helper.hs @@ -5,42 +5,41 @@ , encodeReplayJson , decodeReplayJson , encodeReplayFile - ) -where + ) where -import Rattletrap.Decode.Common -import Rattletrap.Encode.Content -import Rattletrap.Decode.Replay -import Rattletrap.Encode.Replay -import Rattletrap.Type.Replay -import Rattletrap.Type.Section -import Rattletrap.Type.Content +import qualified Rattletrap.ByteGet as ByteGet +import qualified Rattletrap.BytePut as BytePut +import qualified Rattletrap.Type.Content as Content +import qualified Rattletrap.Type.Replay as Replay +import qualified Rattletrap.Type.Section as Section -import qualified Data.Aeson as Json -import qualified Data.Aeson.Encode.Pretty as Json -import qualified Data.Binary.Put as Binary +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.ByteString as Bytes import qualified Data.ByteString.Lazy as LazyBytes -- | Parses a raw replay. -decodeReplayFile :: Bool -> Bytes.ByteString -> Either String FullReplay -decodeReplayFile fast = runDecode $ decodeReplay fast +decodeReplayFile + :: Bool -> Bool -> Bytes.ByteString -> Either String Replay.Replay +decodeReplayFile fast = ByteGet.run . Replay.byteGet fast -- | Encodes a replay as JSON. -encodeReplayJson :: FullReplay -> Bytes.ByteString -encodeReplayJson = LazyBytes.toStrict . Json.encodePretty' Json.defConfig - { Json.confCompare = compare - , Json.confIndent = Json.Spaces 2 - , Json.confTrailingNewline = True +encodeReplayJson :: Replay.Replay -> LazyBytes.ByteString +encodeReplayJson = Aeson.encodePretty' Aeson.defConfig + { Aeson.confCompare = compare + , Aeson.confIndent = Aeson.Tab + , Aeson.confTrailingNewline = True } -- | Parses a JSON replay. -decodeReplayJson :: Bytes.ByteString -> Either String FullReplay -decodeReplayJson = Json.eitherDecodeStrict' +decodeReplayJson :: Bytes.ByteString -> Either String Replay.Replay +decodeReplayJson = Aeson.eitherDecodeStrict' -- | Encodes a raw replay. -encodeReplayFile :: Bool -> FullReplay -> Bytes.ByteString +encodeReplayFile :: Bool -> Replay.Replay -> LazyBytes.ByteString encodeReplayFile fast replay = - LazyBytes.toStrict . Binary.runPut . putReplay $ if fast - then replay { replayContent = toSection putContent defaultContent } + BytePut.toLazyByteString . Replay.bytePut $ if fast + then replay + { Replay.content = Section.create Content.bytePut Content.empty + } else replay diff --git a/src/lib/Rattletrap/Utility/Json.hs b/src/lib/Rattletrap/Utility/Json.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Utility/Json.hs @@ -0,0 +1,23 @@ +module Rattletrap.Utility.Json + ( module Rattletrap.Utility.Json + , Aeson.FromJSON(parseJSON) + , Aeson.ToJSON(toJSON) + , Aeson.Value + , Aeson.object + , Aeson.withObject + , Aeson.withText + ) where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import qualified Data.Text as Text + +required + :: Aeson.FromJSON value => Aeson.Object -> String -> Aeson.Parser value +required object key = object Aeson..: Text.pack key + +optional :: Aeson.FromJSON value => Aeson.Object -> String -> Aeson.Parser (Maybe value) +optional object key = object Aeson..:? Text.pack key + +pair :: (Aeson.ToJSON value, Aeson.KeyValue pair) => String -> value -> pair +pair key value = Text.pack key Aeson..= value diff --git a/src/lib/Rattletrap/Utility/Monad.hs b/src/lib/Rattletrap/Utility/Monad.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Utility/Monad.hs @@ -0,0 +1,4 @@ +module Rattletrap.Utility.Monad where + +whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a) +whenMaybe p f = if p then Just <$> f else pure Nothing diff --git a/src/lib/Rattletrap/Version.hs b/src/lib/Rattletrap/Version.hs new file mode 100644 --- /dev/null +++ b/src/lib/Rattletrap/Version.hs @@ -0,0 +1,7 @@ +module Rattletrap.Version where + +import qualified Data.Version as Version +import qualified Paths_rattletrap as Package + +string :: String +string = Version.showVersion Package.version diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -1,76 +1,54 @@ module Main ( main - ) -where + ) where import qualified Control.Monad as Monad -import qualified Data.ByteString.Lazy as Bytes -import qualified Data.Int as Int -import qualified Data.Word as Word +import qualified Data.ByteString as Bytes import qualified GHC.Clock as Clock import qualified Rattletrap import qualified System.Exit as Exit import qualified System.FilePath as Path -import qualified System.IO.Temp as Temp -import qualified System.Mem as Mem import qualified Test.HUnit as Test import qualified Text.Printf as Printf main :: IO () -main = Temp.withSystemTempDirectory "rattletrap-" (runTests . toTests) +main = runTests makeTests runTests :: Test.Test -> IO () runTests test = do - result <- Test.runTestTT test + Rattletrap.rattletrap + "" + ["--schema", "--output", Path.combine directory "schema.json"] + (result, elapsed) <- withElapsed $ Test.runTestTT test + Printf.printf "Total time: %.3f seconds\n" elapsed Monad.when (Test.errors result > 0 || Test.failures result > 0) Exit.exitFailure -toTests :: FilePath -> Test.Test -toTests directory = Test.TestList (fmap (toTest directory) replays) +makeTests :: Test.Test +makeTests = Test.TestList $ fmap toTest replays -toTest :: FilePath -> (String, String) -> Test.Test -toTest directory (uuid, name) = Test.TestLabel - (toLabel uuid name) - (Test.TestCase (toAssertion directory uuid)) +toTest :: (String, String) -> Test.Test +toTest (uuid, name) = + Test.TestLabel (toLabel uuid name) . Test.TestCase $ toAssertion uuid toLabel :: String -> String -> String toLabel uuid name = uuid <> ": " <> name -toAssertion :: FilePath -> String -> Test.Assertion -toAssertion directory uuid = do +toAssertion :: String -> Test.Assertion +toAssertion uuid = do let - inputFile = Path.joinPath ["replays", Path.addExtension uuid ".replay"] - jsonFile = Path.joinPath [directory, Path.addExtension uuid ".json"] - outputFile = Path.joinPath [directory, Path.addExtension uuid ".replay"] + inputFile = Path.combine "replays" $ uuid <> ".replay" + jsonFile = Path.combine directory $ uuid <> ".json" + outputFile = Path.combine directory $ uuid <> ".replay" input <- Bytes.readFile inputFile - putStrLn ("\t" <> uuid) - do - (((), allocated), elapsed) <- withElapsed - (withAllocations (decode inputFile jsonFile)) - put "decoding" (Bytes.length input) elapsed allocated - do - (((), allocated), elapsed) <- withElapsed - (withAllocations (encode jsonFile outputFile)) - put "encoding" (Bytes.length input) elapsed allocated + decode inputFile jsonFile + encode jsonFile outputFile output <- Bytes.readFile outputFile Monad.unless (output == input) (Test.assertFailure "output does not match input") -put :: String -> Int.Int64 -> Word.Word64 -> Int.Int64 -> IO () -put label size elapsed allocated = Printf.printf - "%s %d byte%s took %d nanosecond%s (%.3f MB/s) and allocated %d byte%s (%d x)\n" - label - size - (if size == 1 then "" else "s") - elapsed - (if elapsed == 1 then "" else "s") - ((1e9 * fromIntegral size) / (1048576 * fromIntegral elapsed) :: Double) - allocated - (if allocated == 1 then "" else "s") - (div allocated size) - decode :: FilePath -> FilePath -> IO () decode input output = Rattletrap.rattletrap "" ["--compact", "--input", input, "--output", output] @@ -79,19 +57,15 @@ encode input output = Rattletrap.rattletrap "" ["--input", input, "--output", output] -withAllocations :: IO a -> IO (a, Int.Int64) -withAllocations action = do - before <- Mem.getAllocationCounter - result <- action - after <- Mem.getAllocationCounter - pure (result, before - after) - -withElapsed :: IO a -> IO (a, Word.Word64) +withElapsed :: IO a -> IO (a, Double) withElapsed action = do - before <- Clock.getMonotonicTimeNSec + before <- Clock.getMonotonicTime result <- action - after <- Clock.getMonotonicTimeNSec + after <- Clock.getMonotonicTime pure (result, after - before) + +directory :: FilePath +directory = "output" replays :: [(String, String)] replays =