diff --git a/library/Octane/Main.hs b/library/Octane/Main.hs --- a/library/Octane/Main.hs +++ b/library/Octane/Main.hs @@ -1,6 +1,7 @@ module Octane.Main (main) where import qualified Control.Monad as Monad +import qualified Control.Newtype as Newtype import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary @@ -8,6 +9,8 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSL8 import Data.Function ((&)) +import qualified Data.Map as Map +import qualified Data.Text as Text import qualified Octane.Parser as Parser import qualified Octane.Type as Type import qualified System.Environment as Environment @@ -42,7 +45,9 @@ Aeson.defConfig { Aeson.confCompare = compare } - Monad.when False $ replay & Aeson.encodePretty' config & BSL8.putStrLn -- TODO + replay & Aeson.encodePretty' config & BSL8.putStrLn + let frames = Parser.parseFrames replay - let frame = take 1 frames - print frame + let expectedFrames = replay & Type.replayProperties & Newtype.unpack & Map.lookup ("NumFrames" & Text.pack & Newtype.pack) + let actualFrames = frames & length & fromIntegral & Newtype.pack & Type.IntProperty (Newtype.pack 4) & Just + Monad.when (expectedFrames /= actualFrames) $ IO.hPutStrLn IO.stderr ("expected " ++ show expectedFrames ++ " frames but found " ++ show actualFrames ++ " frames!") diff --git a/library/Octane/Parser.hs b/library/Octane/Parser.hs --- a/library/Octane/Parser.hs +++ b/library/Octane/Parser.hs @@ -1,5 +1,9 @@ -module Octane.Parser where +{-# LANGUAGE DeriveGeneric #-} +module Octane.Parser (parseFrames) where + +import Data.Function ((&)) + import qualified Control.Newtype as Newtype import qualified Data.Binary.Bits.Get as Bits import qualified Data.Binary.IEEE754 as IEEE754 @@ -7,80 +11,77 @@ import qualified Data.Bits as Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Data.Function ((&)) import qualified Data.IntMap as IntMap +import qualified Data.List as List +import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Set as Set import qualified Data.Text as Text -import qualified Debug.Trace as Trace +import qualified Data.Text.Encoding as Encoding +import qualified Data.Word as Word +import qualified GHC.Generics as Generics import qualified Octane.Type as Type -import qualified Text.Printf as Printf +import qualified Text.Regex as Regex -parseFrames :: Type.Replay -> [Type.Frame] -parseFrames replay = do - let get = replay & extractContext & getFrames & Bits.runBitGet - stream = replay & Type.replayStream & Newtype.unpack & BSL.fromStrict - Binary.runGet get stream +parseFrames :: Type.Replay -> [Frame] +parseFrames replay = let + get = replay & extractContext & getFrames & Bits.runBitGet + stream = replay & Type.replayStream & Newtype.unpack & BSL.fromStrict + (_context, frames) = Binary.runGet get stream + in frames -getFrames :: Context -> Bits.BitGet [Type.Frame] +getFrames :: Context -> Bits.BitGet (Context, [Frame]) getFrames context = do maybeFrame <- getMaybeFrame context case maybeFrame of - Nothing -> return [] - Just frame -> do - frames <- getFrames context - return (frame : frames) + Nothing -> return (context, []) + Just (newContext, frame) -> do + (newerContext, frames) <- getFrames newContext + return (newerContext, (frame : frames)) -getMaybeFrame :: Context -> Bits.BitGet (Maybe Type.Frame) +getMaybeFrame :: Context -> Bits.BitGet (Maybe (Context, Frame)) getMaybeFrame context = do - timeBytes <- Bits.getByteString 4 - let time = byteStringToFloat timeBytes - deltaBytes <- Bits.getByteString 4 - let delta = byteStringToFloat deltaBytes - if BS.all (== 0) timeBytes && BS.all (== 0) deltaBytes + time <- getFloat32 + delta <- getFloat32 + if time == 0 && delta == 0 then return Nothing else do - frame <- getFrame context time delta - return (Just frame) + (newContext, frame) <- getFrame context time delta + return (Just (newContext, frame)) -getFrame :: Context -> Time -> Delta -> Bits.BitGet Type.Frame +getFrame :: Context -> Time -> Delta -> Bits.BitGet (Context, Frame) getFrame context time delta = do - Trace.traceM ("Time:\t" ++ show time) - Trace.traceM ("Delta:\t" ++ show delta) - replications <- getReplications context + (newContext, replications) <- getReplications context let frame = - Type.Frame - { Type.frameTime = time - , Type.frameDelta = delta - , Type.frameReplications = replications + Frame + { frameTime = time + , frameDelta = delta + , frameReplications = replications } - return frame + return (newContext, frame) -getReplications :: Context -> Bits.BitGet [Type.Replication] +getReplications :: Context -> Bits.BitGet (Context, [Replication]) getReplications context = do - (context',maybeReplication) <- getMaybeReplication context + maybeReplication <- getMaybeReplication context case maybeReplication of - Nothing -> return [] - Just replication -> do - replications <- getReplications context' - return (replication : replications) + Nothing -> return (context, []) + Just (newContext, replication) -> do + (newerContext, replications) <- getReplications newContext + return (newerContext, replication : replications) -getMaybeReplication :: Context -> Bits.BitGet (Context, Maybe Type.Replication) +getMaybeReplication :: Context -> Bits.BitGet (Maybe (Context, Replication)) getMaybeReplication context = do hasReplication <- Bits.getBool - Trace.traceM ("Replication?:\t" ++ show hasReplication) if not hasReplication - then return (context, Nothing) + then return Nothing else do (newContext,replication) <- getReplication context - return (newContext, Just replication) + return (Just (newContext, replication)) -getReplication :: Context -> Bits.BitGet (Context, Type.Replication) +getReplication :: Context -> Bits.BitGet (Context, Replication) getReplication context = do actorId <- getInt maxChannels isOpen <- Bits.getBool - Trace.traceM ("Actor ID:\t" ++ show actorId) - Trace.traceM ("Open?:\t" ++ show isOpen) let go = if isOpen then getOpenReplication @@ -89,10 +90,9 @@ getOpenReplication :: Context -> ActorId - -> Bits.BitGet (Context, Type.Replication) + -> Bits.BitGet (Context, Replication) getOpenReplication context actorId = do isNew <- Bits.getBool - Trace.traceM ("New?:\t" ++ show isNew) let go = if isNew then getNewReplication @@ -101,22 +101,17 @@ getNewReplication :: Context -> ActorId - -> Bits.BitGet (Context, Type.Replication) + -> Bits.BitGet (Context, Replication) getNewReplication context actorId = do unknownFlag <- Bits.getBool - objectId <- getInt (2 ^ (32 :: Int)) - let objectName = - context & contextObjectMap & IntMap.lookup objectId & - Maybe.fromJust - let (classId,className) = - getClass (contextObjectMap context) objectId & Maybe.fromJust + objectId <- getInt32 + let objectName = case context & contextObjectMap & IntMap.lookup objectId of + Nothing -> error ("could not find object name for id " ++ show objectId) + Just x -> x + let (classId,className) = case getClass context objectId of + Nothing -> error ("could not find class for object id " ++ show objectId) + Just x -> x classInit <- getClassInit className - Trace.traceM ("Flag:\t" ++ show unknownFlag) - Trace.traceM ("Object ID:\t" ++ show objectId) - Trace.traceM ("Class ID:\t" ++ show classId) - Trace.traceM ("Object name:\t" ++ show objectName) - Trace.traceM ("Class name:\t" ++ show className) - Trace.traceM ("Initialization:\t" ++ show classInit) let thing = Thing { thingFlag = unknownFlag , thingObjectId = objectId @@ -130,66 +125,369 @@ let newContext = context { contextThings = newThings } return ( newContext - , Type.Replication - { Type.replicationActorId = actorId - , Type.replicationIsOpen = True - , Type.replicationIsNew = Just True + , Replication + { replicationActorId = actorId + , replicationIsOpen = True + , replicationIsNew = Just True + , replicationProps = [] }) getExistingReplication :: Context -> ActorId - -> Bits.BitGet (Context, Type.Replication) + -> Bits.BitGet (Context, Replication) getExistingReplication context actorId = do - let thing = context & contextThings & IntMap.lookup actorId & Maybe.fromJust - props <- getProps thing - Trace.traceM ("Props:\t" ++ show props) - return (context, Type.Replication - { Type.replicationActorId = actorId - , Type.replicationIsOpen = True - , Type.replicationIsNew = Just False + let thing = case context & contextThings & IntMap.lookup actorId of + Nothing -> error ("could not find thing for actor id " ++ show actorId) + Just x -> x + props <- getProps context thing + return (context, Replication + { replicationActorId = actorId + , replicationIsOpen = True + , replicationIsNew = Just False + , replicationProps = props }) getClosedReplication :: Context -> ActorId - -> Bits.BitGet (Context, Type.Replication) + -> Bits.BitGet (Context, Replication) getClosedReplication context actorId = do let newThings = context & contextThings & IntMap.delete actorId let newContext = context { contextThings = newThings } return ( newContext - , Type.Replication - { Type.replicationActorId = actorId - , Type.replicationIsOpen = False - , Type.replicationIsNew = Nothing + , Replication + { replicationActorId = actorId + , replicationIsOpen = False + , replicationIsNew = Nothing + , replicationProps = [] }) -data Prop = Prop Int - deriving (Show) - -getProps :: Thing -> Bits.BitGet [Prop] -getProps thing = do - maybeProp <- getMaybeProp thing +getProps :: Context -> Thing -> Bits.BitGet [Prop] +getProps context thing = do + maybeProp <- getMaybeProp context thing case maybeProp of Nothing -> return [] Just prop -> do - props <- getProps thing + props <- getProps context thing return (prop : props) -getMaybeProp :: Thing -> Bits.BitGet (Maybe Prop) -getMaybeProp thing = do +getMaybeProp :: Context -> Thing -> Bits.BitGet (Maybe Prop) +getMaybeProp context thing = do hasProp <- Bits.getBool if hasProp then do - prop <- getProp thing + prop <- getProp context thing return (Just prop) else return Nothing -getProp :: Thing -> Bits.BitGet Prop -getProp _thing = do - -- TODO: Correctly read ID and actually read prop. - propId <- getInt 1 - return (Prop propId) +getProp :: Context -> Thing -> Bits.BitGet Prop +getProp context thing = do + let classId = thing & thingClassId + let props = case context & contextClassPropertyMap & IntMap.lookup classId of + Nothing -> error ("could not find property map for class id " ++ show classId) + Just x -> x + let maxId = props & IntMap.keys & maximum + pid <- getInt maxId + let propName = case props & IntMap.lookup pid of + Nothing -> error ("could not find property name for property id " ++ show pid) + Just x -> x + value <- getPropValue propName + return (Prop { propId = pid, propValue = value }) +getPropValue :: Text.Text -> Bits.BitGet PropValue +getPropValue name = case Text.unpack name of + _ | Set.member name propsWithRigidBodyState -> do + flag <- Bits.getBool + position <- getVector + rotation <- getFloatVector + x <- if flag then return Nothing else fmap Just getVector + y <- if flag then return Nothing else fmap Just getVector + return (PRigidBodyState flag position rotation x y) + _ | Set.member name propsWithFlaggedInt -> do + flag <- Bits.getBool + int <- getInt32 + return (PFlaggedInt flag (fromIntegral int)) + _ | Set.member name propsWithString -> do + string <- getString + return (PString string) + _ | Set.member name propsWithBoolean -> do + bool <- Bits.getBool + return (PBoolean bool) + _ | Set.member name propsWithQWord -> do + x <- getInt32 + y <- getInt32 + return (PQWord x y) + _ | Set.member name propsWithInt -> do + int <- getInt32 + return (PInt int) + _ | Set.member name propsWithByte -> do + int <- getInt8 + return (PByte int) + _ | Set.member name propsWithUniqueId -> do + (systemId, remoteId, localId) <- getUniqueId + return (PUniqueId systemId remoteId localId) + _ | Set.member name propsWithCamSettings -> do + fov <- getFloat32 + height <- getFloat32 + pitch <- getFloat32 + dist <- getFloat32 + stiff <- getFloat32 + swiv <- getFloat32 + return (PCamSettings fov height pitch dist stiff swiv) + _ | Set.member name propsWithLocation -> do + vector <- getVector + return (PLocation vector) + "ProjectX.GRI_X:Reservations" -> do + -- I think this is the connection order. The first player to connect + -- gets number 0, and it goes up from there. The maximum is 8, which + -- would be a full 4x4 game. + number <- getInt 8 + (systemId, remoteId, localId) <- getUniqueId + playerName <- if systemId == 0 then return Nothing else do + string <- getString + return (Just string) + -- No idea what these two flags are. Might be for bots? + a <- Bits.getBool + b <- Bits.getBool + return (PReservation number systemId remoteId localId playerName a b) + "TAGame.PRI_TA:ClientLoadoutOnline" -> do + version <- getInt32 + x <- getInt32 + y <- getInt32 + z <- if version >= 12 + then do + value <- getInt8 + return (Just value) + else return Nothing + return (PLoadoutOnline version x y z) + "TAGame.PRI_TA:ClientLoadout" -> do + version <- getInt8 + a <- getInt32 + b <- getInt32 + c <- getInt32 + d <- getInt32 + e <- getInt32 + f <- getInt32 + g <- getInt32 + h <- if version > 10 + then do + value <- getInt32 + return (Just value) + else return Nothing + return (PLoadout version a b c d e f g h) + "TAGame.Car_TA:TeamPaint" -> do + team <- getInt8 + teamColor <- getInt8 + customColor <- getInt8 + teamFinish <- getInt32 + customFinish <- getInt32 + return (PTeamPaint team teamColor customColor teamFinish customFinish) + "TAGame.VehiclePickup_TA:ReplicatedPickupData" -> do + instigator <- Bits.getBool + instigatorId <- if instigator then fmap Just getInt32 else return Nothing + pickedUp <- Bits.getBool + return (PPickup instigator instigatorId pickedUp) + "Engine.Actor:Role" -> do + x <- Bits.getWord16be 11 + return (PEnum x) + "TAGame.Ball_TA:ReplicatedExplosionData" -> do + noGoal <- Bits.getBool + a <- if noGoal then return Nothing else fmap Just getInt32 + b <- getVector + return (PExplosion noGoal a b) + "TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger" -> do + flag <- Bits.getBool + cue <- getInt32 + trigger <- getInt8 + return (PMusicStinger flag cue trigger) + -- TODO: Parse other prop types. + _ -> fail ("don't know how to read property " ++ show name) + +getFloat32 :: Bits.BitGet Float +getFloat32 = do + bytes <- Bits.getByteString 4 + bytes & byteStringToFloat & return + +-- TODO: This has a lot of overlap with PCString. +getString :: Bits.BitGet Text.Text +getString = do + rawSize <- getInt32 + rawText <- if rawSize < 0 + then do + let size = -2 * rawSize + bytes <- Bits.getByteString size + bytes & BS.map Type.reverseBits & Encoding.decodeUtf16LE & return + else do + bytes <- Bits.getByteString rawSize + bytes & BS.map Type.reverseBits & Encoding.decodeLatin1 & return + rawText & Text.dropEnd 1 & return + +getUniqueId :: Bits.BitGet (SystemId, RemoteId, LocalId) +getUniqueId = do + byte <- Bits.getWord8 8 + let systemId = Type.reverseBits byte + case systemId of + 0 -> error "don't know how to parse splitscreen ids" + 1 -> do + remoteId <- Bits.getByteString 8 + localId <- Bits.getWord8 8 + return (systemId, SteamId remoteId, localId) + 2 -> do + remoteId <- Bits.getByteString 32 + localId <- Bits.getWord8 8 + return (systemId, PlayStationId remoteId, localId) + _ -> error ("unknown system id " ++ show systemId) + +propsWithRigidBodyState :: Set.Set Text.Text +propsWithRigidBodyState = + [ "TAGame.RBActor_TA:ReplicatedRBState" + ] & map Text.pack & Set.fromList + +propsWithFlaggedInt :: Set.Set Text.Text +propsWithFlaggedInt = + [ "Engine.GameReplicationInfo:GameClass" + , "Engine.Pawn:PlayerReplicationInfo" + , "Engine.PlayerReplicationInfo:Team" + , "TAGame.Ball_TA:GameEvent" + , "TAGame.CameraSettingsActor_TA:PRI" + , "TAGame.CarComponent_TA:Vehicle" + , "TAGame.PRI_TA:PersistentCamera" + , "TAGame.PRI_TA:ReplicatedGameEvent" + , "TAGame.Team_TA:GameEvent" + ] & map Text.pack & Set.fromList + +propsWithString :: Set.Set Text.Text +propsWithString = + [ "Engine.GameReplicationInfo:ServerName" + , "Engine.PlayerReplicationInfo:PlayerName" + ] & map Text.pack & Set.fromList + +propsWithBoolean :: Set.Set Text.Text +propsWithBoolean = + [ "Engine.PlayerReplicationInfo:bReadyToPlay" + , "ProjectX.GRI_X:bGameStarted" + , "TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera" + , "TAGame.GameEvent_TA:bHasLeaveMatchPenalty" + , "TAGame.GameEvent_Team_TA:bDisableMutingOtherTeam" + , "TAGame.PRI_TA:bOnlineLoadoutSet" + , "TAGame.Vehicle_TA:bDriving" + , "TAGame.GameEvent_Soccar_TA:bBallHasBeenHit" + , "TAGame.Vehicle_TA:bReplicatedHandbrake" + , "Engine.Actor:bCollideActors" + , "Engine.Actor:bBlockActors" + , "TAGame.CameraSettingsActor_TA:bUsingBehindView" + ] & map Text.pack & Set.fromList + +propsWithQWord :: Set.Set Text.Text +propsWithQWord = + [ "ProjectX.GRI_X:GameServerID" + ] & map Text.pack & Set.fromList + +propsWithInt :: Set.Set Text.Text +propsWithInt = + [ "Engine.PlayerReplicationInfo:PlayerID" + , "ProjectX.GRI_X:ReplicatedGamePlaylist" + , "TAGame.GameEvent_Soccar_TA:SecondsRemaining" + , "TAGame.GameEvent_TA:BotSkill" + , "TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining" + , "TAGame.GameEvent_Soccar_TA:RoundNum" + , "TAGame.GameEvent_TA:ReplicatedStateName" + , "TAGame.GameEvent_Team_TA:MaxTeamSize" + , "TAGame.PRI_TA:Title" + , "TAGame.PRI_TA:TotalXP" + , "TAGame.PRI_TA:MatchScore" + , "TAGame.PRI_TA:MatchShots" + , "TAGame.PRI_TA:MatchSaves" + , "Engine.TeamInfo:Score" + , "Engine.PlayerReplicationInfo:Score" + , "TAGame.PRI_TA:MatchGoals" + , "TAGame.PRI_TA:MatchAssists" + ] & map Text.pack & Set.fromList + +propsWithByte :: Set.Set Text.Text +propsWithByte = + [ "Engine.PlayerReplicationInfo:Ping" + , "TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount" + , "TAGame.Vehicle_TA:ReplicatedThrottle" + , "TAGame.CarComponent_TA:ReplicatedActive" + , "TAGame.Vehicle_TA:ReplicatedSteer" + , "TAGame.Ball_TA:HitTeamNum" + , "TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam" + , "TAGame.CameraSettingsActor_TA:CameraYaw" + , "TAGame.CameraSettingsActor_TA:CameraPitch" + ] & map Text.pack & Set.fromList + +propsWithUniqueId :: Set.Set Text.Text +propsWithUniqueId = + [ "Engine.PlayerReplicationInfo:UniqueId" + , "TAGame.PRI_TA:PartyLeader" + ] & map Text.pack & Set.fromList + +propsWithCamSettings :: Set.Set Text.Text +propsWithCamSettings = + [ "TAGame.CameraSettingsActor_TA:ProfileSettings" + ] & map Text.pack & Set.fromList + +propsWithLocation :: Set.Set Text.Text +propsWithLocation = + [ "TAGame.CarComponent_Dodge_TA:DodgeTorque" + ] & map Text.pack & Set.fromList + +type SystemId = Word.Word8 + +-- This is the number associated with a splitscreen player. So the first player +-- is 0, the second is 1, and so on. +-- - 0 "Someone" +-- - 1 "Someone (1)" +type LocalId = Word.Word8 + +data RemoteId + = SteamId BS.ByteString -- TODO: This is an integer. + | PlayStationId BS.ByteString -- TODO: I think this is a string? + deriving (Eq, Show) + +data Prop = Prop + { propId :: Int + , propValue :: PropValue + } deriving (Eq, Show) + +data PropValue + = PRigidBodyState Bool (Vector Int) (Vector Float) (Maybe (Vector Int)) (Maybe (Vector Int)) + | PFlaggedInt Bool Int + | PString Text.Text + | PBoolean Bool + | PQWord Int Int + | PReservation Int SystemId RemoteId LocalId (Maybe Text.Text) Bool Bool + | PInt Int + | PByte Int + | PUniqueId SystemId RemoteId LocalId + | PLoadoutOnline Int Int Int (Maybe Int) + | PLoadout Int Int Int Int Int Int Int Int (Maybe Int) + | PCamSettings Float Float Float Float Float Float + | PTeamPaint Int Int Int Int Int + | PLocation (Vector Int) + | PPickup Bool (Maybe Int) Bool + | PEnum Word.Word16 -- TODO: This isn't the right data type. + | PExplosion Bool (Maybe Int) (Vector Int) + | PMusicStinger Bool Int Int + deriving (Eq, Show) + +-- | A frame in the net stream. Each frame has the time since the beginning of +-- | the match, the time since the last frame, and a list of replications. +data Frame = Frame + { frameTime :: Float + , frameDelta :: Float + , frameReplications :: [Replication] + } deriving (Eq,Generics.Generic,Show) + +-- | Replication information about an actor in the net stream. +data Replication = Replication + { replicationActorId :: Int + , replicationIsOpen :: Bool + , replicationIsNew :: Maybe Bool + , replicationProps :: [Prop] + } deriving (Eq,Generics.Generic,Show) + data Thing = Thing { thingFlag :: Bool , thingObjectId :: Int @@ -197,184 +495,152 @@ , thingClassId :: Int , thingClassName :: Text.Text , thingClassInit :: ClassInit - } - -showAsHex :: BS.ByteString -> String -showAsHex bytes - = bytes - & BS.unpack - & concatMap (\ byte -> Printf.printf "%02x" byte) - --- { stream id => object name } -type ObjectMap = IntMap.IntMap Text.Text - -buildObjectMap :: Type.Replay -> ObjectMap -buildObjectMap replay = - replay & Type.replayObjects & Newtype.unpack & map Newtype.unpack & - zip [0 ..] & - IntMap.fromAscList + } deriving (Show) --- { stream id => class name } -type ClassMap = IntMap.IntMap Text.Text +type Time = Float -buildClassMap :: Type.Replay -> ClassMap -buildClassMap replay = - replay & Type.replayActors & Newtype.unpack & - map - (\x -> - ( x & Type.actorStreamId & Newtype.unpack & fromIntegral - , x & Type.actorName & Newtype.unpack)) & - IntMap.fromList +type Delta = Float -data CacheNode = CacheNode - { cacheNodeClassId :: Int - , cacheNodeParentCacheId :: Int - , cacheNodeCacheId :: Int - , cacheNodeProperties :: IntMap.IntMap Text.Text - } +type ActorId = Int --- { class id => node } -type Cache = IntMap.IntMap CacheNode +data Vector a = Vector + { vectorX :: a + , vectorY :: a + , vectorZ :: a + } deriving (Eq, Show) -buildCache :: Type.Replay -> Cache -buildCache replay = - let objectMap = buildObjectMap replay - in replay & Type.replayCacheItems & Newtype.unpack & - map - (\item -> - CacheNode - { cacheNodeClassId = item & Type.cacheItemClassId & - Newtype.unpack & - fromIntegral - , cacheNodeParentCacheId = item & Type.cacheItemParentCacheId & - Newtype.unpack & - fromIntegral - , cacheNodeCacheId = item & Type.cacheItemCacheId & - Newtype.unpack & - fromIntegral - , cacheNodeProperties = item & Type.cacheItemCacheProperties & - Newtype.unpack & - map - (\property -> - ( property & Type.cachePropertyStreamId & - Newtype.unpack & - fromIntegral - , property & Type.cachePropertyObjectId & - Newtype.unpack & - fromIntegral & - (\objectId -> - IntMap.lookup objectId objectMap) & - Maybe.fromJust)) & - IntMap.fromList - }) & - map - (\node -> - (cacheNodeClassId node, node)) & - IntMap.fromList +data ClassInit = ClassInit + { classInitLocation :: Maybe (Vector Int) + , classInitRotation :: Maybe (Vector Int) + } deriving (Show) -- { class stream id => { property stream id => name } } type ClassPropertyMap = IntMap.IntMap (IntMap.IntMap Text.Text) -getPropertyMap :: Cache -> Int -> IntMap.IntMap Text.Text -getPropertyMap cache cacheId = - case IntMap.lookup cacheId cache of - Nothing -> IntMap.empty - Just node -> - if cacheNodeParentCacheId node == 0 || - cacheNodeParentCacheId node == cacheId - then cacheNodeProperties node - else IntMap.union - (cacheNodeProperties node) - (getPropertyMap cache (cacheNodeParentCacheId node)) +-- { stream id => object name } +type ObjectMap = IntMap.IntMap Text.Text -buildClassPropertyMap :: Type.Replay -> ClassPropertyMap -buildClassPropertyMap replay = - let classMap = buildClassMap replay - cacheByStreamId = buildCache replay - cacheByCacheId = - cacheByStreamId & IntMap.toList & map snd & - map - (\node -> - (cacheNodeCacheId node, node)) & - IntMap.fromList - f streamId _ m = - case IntMap.lookup streamId cacheByStreamId of - Nothing -> m - Just node -> - IntMap.insert - streamId - (getPropertyMap cacheByCacheId (cacheNodeCacheId node)) - m - in IntMap.foldrWithKey f IntMap.empty classMap +-- { archetype (object) name => class name } +type ArchetypeMap = Map.Map Text.Text Text.Text -getClass :: ObjectMap -> Int -> Maybe (Int, Text.Text) -getClass objectMap objectId = - case IntMap.lookup objectId objectMap of - Nothing -> Nothing - Just name -> - if name == Text.pack "TAGame.Default__PRI_TA" || - Text.isInfixOf (Text.pack "Archetype") name - then getClass objectMap (objectId - 1) - else Just (objectId, name) +-- { class name => class id } +type ClassMap = Map.Map Text.Text Int data Context = Context { contextObjectMap :: ObjectMap , contextClassPropertyMap :: ClassPropertyMap , contextThings :: IntMap.IntMap Thing - } + , contextArchetypeMap :: ArchetypeMap + , contextClassMap :: ClassMap + } deriving (Show) +buildObjectMap :: Type.Replay -> ObjectMap +buildObjectMap replay = + replay & Type.replayObjects & Newtype.unpack & map Newtype.unpack & + zip [0 ..] & + IntMap.fromAscList + +buildArchetypeMap :: Type.Replay -> ArchetypeMap +buildArchetypeMap replay + = replay + & Type.replayObjects + & Newtype.unpack + & map Newtype.unpack + & map (\ archetype -> let + k = archetype + v = archetypeToClass archetype + in (k, v)) + & Map.fromList + & Map.union specialArchetypes + +specialArchetypes :: ArchetypeMap +specialArchetypes = + [ ("GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype", "GRI") + ] & map (\ (k, v) -> (Text.pack k, Text.pack v)) & Map.fromList + +buildClassMap :: Type.Replay -> ClassMap +buildClassMap replay + = replay + & Type.replayObjects + & Newtype.unpack + & map Newtype.unpack + & zip [0 ..] + & map (\ (objectId, objectName) -> let + k = archetypeToClass objectName + v = objectId + in (k, v)) + & reverse + & Map.fromList + +getClass :: Context -> Int -> Maybe (Int, Text.Text) +getClass context objectId = let + objectMap = contextObjectMap context + archetypeMap = contextArchetypeMap context + classMap = contextClassMap context + in case IntMap.lookup objectId objectMap of + Nothing -> Nothing + Just archetypeName -> case Map.lookup archetypeName archetypeMap of + Nothing -> Nothing + Just className -> case Map.lookup className classMap of + Nothing -> Nothing + Just classId -> Just (classId, className) + +archetypeToClass :: Text.Text -> Text.Text +archetypeToClass text + = text + & Text.splitOn (Text.pack ".") + & last + & Text.splitOn (Text.pack ":") + & last + & Text.unpack + & substitute "_?[0-9]+$" "" + & substitute "^Default__" "" + & substitute "_TA$" "" + & substitute "_Default$" "" + & substitute "Archetype$" "" + & Text.pack + +substitute :: String -> String -> String -> String +substitute pattern replacement input = + Regex.subRegex (Regex.mkRegex pattern) input replacement + extractContext :: Type.Replay -> Context extractContext replay = Context { contextObjectMap = buildObjectMap replay , contextClassPropertyMap = buildClassPropertyMap replay , contextThings = IntMap.empty + , contextArchetypeMap = buildArchetypeMap replay + , contextClassMap = buildClassMap replay } -type Time = Float - -type Delta = Float - -type ActorId = Int - -data Vector = Vector - { vectorX :: Int - , vectorY :: Int - , vectorZ :: Int - } deriving (Show) - -data ClassInit = ClassInit - { classInitLocation :: Maybe Vector - , classInitRotation :: Maybe Vector - } deriving (Show) - classesWithLocation :: Set.Set Text.Text classesWithLocation = - [ "Engine.GameReplicationInfo" - , "TAGame.Ball_TA" - , "TAGame.CarComponent_Boost_TA" - , "TAGame.CarComponent_Dodge_TA" - , "TAGame.CarComponent_DoubleJump_TA" - , "TAGame.CarComponent_FlipCar_TA" - , "TAGame.CarComponent_Jump_TA" - , "TAGame.Car_TA" - , "TAGame.Default__CameraSettingsActor_TA" - , "TAGame.Default__PRI_TA" - , "TAGame.GRI_TA" - , "TAGame.GameEvent_Season_TA" - , "TAGame.GameEvent_SoccarPrivate_TA" - , "TAGame.GameEvent_SoccarSplitscreen_TA" - , "TAGame.GameEvent_Soccar_TA" - , "TAGame.PRI_TA" - , "TAGame.Team_Soccar_TA" - , "TAGame.Team_TA"] & - map Text.pack & - Set.fromList + [ "Ball" + , "CameraSettingsActor" + , "Car" + , "CarComponent_Boost" + , "CarComponent_Dodge" + , "CarComponent_DoubleJump" + , "CarComponent_FlipCar" + , "CarComponent_Jump" + , "GRI" + , "GameEvent_Season" + , "GameEvent_Soccar" + , "GameEvent_SoccarPrivate" + , "GameEvent_SoccarSplitscreen" + , "GameReplicationInfo" + , "PRI" + , "Team" + , "Team_Soccar" + ] & map Text.pack & Set.fromList classesWithRotation :: Set.Set Text.Text classesWithRotation = - ["TAGame.Ball_TA", "TAGame.Car_Season_TA", "TAGame.Car_TA"] & map Text.pack & - Set.fromList + [ "Ball" + , "Car_Season" + , "Car" + ] & map Text.pack & Set.fromList maxVectorValue :: Int maxVectorValue = 19 @@ -384,7 +650,7 @@ IEEE754.getFloat32le (bytes & BSL.fromStrict & BSL.map Type.reverseBits) -getVector :: Bits.BitGet Vector +getVector :: Bits.BitGet (Vector Int) getVector = do numBits <- getInt maxVectorValue let bias = Bits.shiftL 1 (numBits + 1) @@ -401,7 +667,7 @@ } getVectorBytewise - :: Bits.BitGet Vector + :: Bits.BitGet (Vector Int) getVectorBytewise = do hasX <- Bits.getBool x <- @@ -431,6 +697,31 @@ , vectorZ = z } +getFloatVector :: Bits.BitGet (Vector Float) +getFloatVector = do + let maxValue = 1 + let numBits = 16 + x <- getFloat maxValue numBits + y <- getFloat maxValue numBits + z <- getFloat maxValue numBits + return Vector { vectorX = x, vectorY = y, vectorZ = z } + +getFloat :: Int -> Int -> Bits.BitGet Float +getFloat maxValue numBits = do + let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1 + let bias = Bits.shiftL 1 (numBits - 1) + let serIntMax = Bits.shiftL 1 numBits + delta <- getInt serIntMax + let unscaledValue = delta - bias + if maxValue > maxBitValue + then do + let invScale = fromIntegral maxValue / fromIntegral maxBitValue + return (fromIntegral unscaledValue * invScale) + else do + let scale = fromIntegral maxBitValue / fromIntegral maxValue + let invScale = 1.0 / scale + return (fromIntegral unscaledValue * invScale) + getClassInit :: Text.Text -> Bits.BitGet ClassInit getClassInit className = do location <- @@ -486,3 +777,53 @@ go (i + 1) newValue else return value go 0 0 + +getInt32 :: Bits.BitGet Int +getInt32 = getInt (2 ^ (32 :: Int)) + +getInt8 :: Bits.BitGet Int +getInt8 = getInt (2 ^ (8 :: Int)) + +-- builds a map from property ids in the stream to property names +buildPropertyMap :: Type.Replay -> IntMap.IntMap Text.Text +buildPropertyMap replay + = replay + & Type.replayObjects + & Newtype.unpack + & map Newtype.unpack + & zip [0 ..] + & IntMap.fromDistinctAscList + +buildClassPropertyMap :: Type.Replay -> IntMap.IntMap (IntMap.IntMap Text.Text) +buildClassPropertyMap replay = let + propertyMap = buildPropertyMap replay + g x items = case items of + [] -> IntMap.empty + _ -> case dropWhile (\ (_, cacheId, _, _) -> cacheId /= x) items of + [] -> g (x - 1) items + (_, _, parentCacheId, properties) : others -> IntMap.union + properties + (g parentCacheId others) + f x items = case items of + (classId, _cacheId, parentCacheId, properties) : others -> IntMap.insert + classId + (IntMap.union + properties + (g parentCacheId others)) + x + [] -> x + in replay + & Type.replayCacheItems + & Newtype.unpack + & map (\ item -> + ( item & Type.cacheItemClassId & Newtype.unpack & fromIntegral + , item & Type.cacheItemCacheId & Newtype.unpack & fromIntegral & (\ x -> x :: Int) + , item & Type.cacheItemParentCacheId & Newtype.unpack & fromIntegral + , item & Type.cacheItemCacheProperties & Newtype.unpack & map (\ x -> + ( x & Type.cachePropertyStreamId & Newtype.unpack & fromIntegral + , x & Type.cachePropertyObjectId & Newtype.unpack & fromIntegral & flip IntMap.lookup propertyMap & Maybe.fromJust + )) & IntMap.fromList + )) + & reverse + & List.tails + & foldl f IntMap.empty diff --git a/library/Octane/Type/Frame.hs b/library/Octane/Type/Frame.hs deleted file mode 100644 --- a/library/Octane/Type/Frame.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Octane.Type.Frame (Frame(..)) where - -import qualified Control.DeepSeq as DeepSeq -import qualified GHC.Generics as Generics -import qualified Octane.Type.Replication as Replication - --- | A frame in the net stream. Each frame has the time since the beginning of --- | the match, the time since the last frame, and a list of replications. -data Frame = Frame - { frameTime :: Float - , frameDelta :: Float - , frameReplications :: [Replication.Replication] - } deriving (Eq,Generics.Generic,Show) - -instance DeepSeq.NFData Frame diff --git a/library/Octane/Type/Replication.hs b/library/Octane/Type/Replication.hs deleted file mode 100644 --- a/library/Octane/Type/Replication.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Octane.Type.Replication (Replication(..)) where - -import qualified Control.DeepSeq as DeepSeq -import qualified GHC.Generics as Generics - --- | Replication information about an actor in the net stream. -data Replication = Replication - { replicationActorId :: Int - , replicationIsOpen :: Bool - , replicationIsNew :: Maybe Bool - } deriving (Eq,Generics.Generic,Show) - -instance DeepSeq.NFData Replication diff --git a/octane.cabal b/octane.cabal --- a/octane.cabal +++ b/octane.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.13.0. +-- This file has been generated from package.yaml by hpack version 0.14.0. -- -- see: https://github.com/sol/hpack name: octane -version: 0.4.24 +version: 0.5.0 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game @@ -41,6 +41,7 @@ , data-binary-ieee754 ==0.4.* , deepseq ==1.4.* , newtype-generics ==0.4.* + , regex-compat ==0.95.* , text ==1.2.* exposed-modules: Octane @@ -50,7 +51,6 @@ Octane.Type.Actor Octane.Type.CacheItem Octane.Type.CacheProperty - Octane.Type.Frame Octane.Type.KeyFrame Octane.Type.Mark Octane.Type.Message @@ -65,7 +65,6 @@ Octane.Type.Primitive.Word64LE Octane.Type.Property Octane.Type.Replay - Octane.Type.Replication Octane.Version other-modules: Paths_octane diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -46,6 +46,7 @@ - data-binary-ieee754 ==0.4.* - deepseq ==1.4.* - newtype-generics ==0.4.* + - regex-compat ==0.95.* - text ==1.2.* other-modules: Paths_octane source-dirs: library @@ -70,4 +71,4 @@ - -with-rtsopts=-N main: TestSuite.hs source-dirs: test-suite -version: '0.4.24' +version: '0.5.0'