octane 0.4.24 → 0.5.0
raw patch · 6 files changed
+595/−281 lines, 6 filesdep +regex-compat
Dependencies added: regex-compat
Files
- library/Octane/Main.hs +8/−3
- library/Octane/Parser.hs +582/−241
- library/Octane/Type/Frame.hs +0/−17
- library/Octane/Type/Replication.hs +0/−15
- octane.cabal +3/−4
- package.yaml +2/−1
library/Octane/Main.hs view
@@ -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!")
library/Octane/Parser.hs view
@@ -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
− library/Octane/Type/Frame.hs
@@ -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
− library/Octane/Type/Replication.hs
@@ -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
octane.cabal view
@@ -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
package.yaml view
@@ -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'