diff --git a/library/Rattletrap/Attribute.hs b/library/Rattletrap/Attribute.hs --- a/library/Rattletrap/Attribute.hs +++ b/library/Rattletrap/Attribute.hs @@ -40,15 +40,19 @@ -> CompressedWord -> BinaryBit.BitGet Attribute getAttribute version classAttributeMap actorMap actorId = - case getAttributeIdLimit classAttributeMap actorMap actorId of - Nothing -> fail ("could not get attribute ID limit for " ++ show actorId) - Just limit -> do - id_ <- getCompressedWord limit - case getAttributeName classAttributeMap actorMap actorId id_ of - Nothing -> fail ("could not get attribute name for " ++ show id_) - Just name -> do - value <- getAttributeValue version name - pure (Attribute id_ value) + case getAttributeMap classAttributeMap actorMap actorId of + Nothing -> fail ("could not get attribute map for " ++ show actorId) + Just attributeMap -> + case getAttributeIdLimit attributeMap of + Nothing -> + fail ("could not get attribute ID limit for " ++ show actorId) + Just limit -> do + id_ <- getCompressedWord limit + case getAttributeName classAttributeMap attributeMap id_ of + Nothing -> fail ("could not get attribute name for " ++ show id_) + Just name -> do + value <- getAttributeValue version name + pure (Attribute id_ value) putAttribute :: Attribute -> BinaryBit.BitPut () putAttribute attribute = do diff --git a/library/Rattletrap/ClassAttributeMap.hs b/library/Rattletrap/ClassAttributeMap.hs --- a/library/Rattletrap/ClassAttributeMap.hs +++ b/library/Rattletrap/ClassAttributeMap.hs @@ -17,6 +17,7 @@ data ClassAttributeMap = ClassAttributeMap { classAttributeMapObjectMap :: Map.Map Word32 Text , classAttributeMapClassMap :: Bimap.Bimap Word32 Text + , classAttributeMapObjectClassMap :: Map.Map Word32 Word32 , classAttributeMapValue :: Map.Map Word32 (Map.Map Word32 Word32) } deriving (Eq, Show) @@ -26,11 +27,12 @@ -> ClassAttributeMap makeClassAttributeMap objects classMappings caches = let objectMap = makeObjectMap objects - classCache = makeClassCache classMappings caches + classMap = makeClassMap classMappings + objectClassMap = makeObjectClassMap objectMap classMap + classCache = makeClassCache classMap caches attributeMap = makeAttributeMap caches classIds = map (\(_, classId, _, _) -> classId) classCache - parentMap = makeParentMap classMappings caches - classMap = makeClassMap classMappings + parentMap = makeParentMap classCache value = Map.fromList (map @@ -52,21 +54,45 @@ attributes = ownAttributes : parentsAttributes in (classId, Map.fromList (concatMap Map.toList attributes))) classIds) - in ClassAttributeMap objectMap classMap value + in ClassAttributeMap objectMap classMap objectClassMap value -makeClassCache :: List ClassMapping +makeObjectClassMap :: Map.Map Word32 Text + -> Bimap.Bimap Word32 Text + -> Map.Map Word32 Word32 +makeObjectClassMap objectMap classMap = do + let objectIds = Map.keys objectMap + let classIds = map (getClassId objectMap classMap) objectIds + let rawPairs = zip objectIds classIds + let pairs = + Maybe.mapMaybe + (\(objectId, maybeClassId) -> + case maybeClassId of + Nothing -> Nothing + Just classId -> Just (objectId, classId)) + rawPairs + Map.fromList pairs + +getClassId :: Map.Map Word32 Text + -> Bimap.Bimap Word32 Text + -> Word32 + -> Maybe Word32 +getClassId objectMap classMap objectId = do + objectName <- getObjectName objectMap objectId + className <- getClassName objectName + Bimap.lookupR className classMap + +makeClassCache :: Bimap.Bimap Word32 Text -> List Cache -> [(Maybe Text, Word32, Word32, Word32)] -makeClassCache classMappings caches = - let classMap = makeClassMap classMappings - in map - (\cache -> - let classId = cacheClassId cache - in ( Bimap.lookup classId classMap - , classId - , cacheCacheId cache - , cacheParentCacheId cache)) - (listValue caches) +makeClassCache classMap caches = + map + (\cache -> + let classId = cacheClassId cache + in ( Bimap.lookup classId classMap + , classId + , cacheCacheId cache + , cacheParentCacheId cache)) + (listValue caches) makeClassMap :: List ClassMapping -> Bimap.Bimap Word32 Text makeClassMap classMappings = @@ -90,23 +116,23 @@ (listValue (cacheAttributeMappings cache))))) (listValue caches)) -makeShallowParentMap :: List ClassMapping -> List Cache -> Map.Map Word32 Word32 -makeShallowParentMap classMappings caches = - let classCache = makeClassCache classMappings caches - in Map.fromList - (Maybe.mapMaybe - (\xs -> - case xs of - [] -> Nothing - (maybeClassName, classId, _, parentCacheId):rest -> do - parentClassId <- - getParentClass maybeClassName parentCacheId rest - pure (classId, parentClassId)) - (List.tails (reverse classCache))) +makeShallowParentMap :: [(Maybe Text, Word32, Word32, Word32)] + -> Map.Map Word32 Word32 +makeShallowParentMap classCache = + Map.fromList + (Maybe.mapMaybe + (\xs -> + case xs of + [] -> Nothing + (maybeClassName, classId, _, parentCacheId):rest -> do + parentClassId <- getParentClass maybeClassName parentCacheId rest + pure (classId, parentClassId)) + (List.tails (reverse classCache))) -makeParentMap :: List ClassMapping -> List Cache -> Map.Map Word32 [Word32] -makeParentMap classMappings caches = - let shallowParentMap = makeShallowParentMap classMappings caches +makeParentMap :: [(Maybe Text, Word32, Word32, Word32)] + -> Map.Map Word32 [Word32] +makeParentMap classCache = + let shallowParentMap = makeShallowParentMap classCache in Map.mapWithKey (\classId _ -> getParentClasses shallowParentMap classId) shallowParentMap @@ -169,9 +195,8 @@ makeObjectMap objects = Map.fromAscList (zip (map Word32 [0 ..]) (listValue objects)) -getObjectName :: ClassAttributeMap -> Word32 -> Maybe Text -getObjectName classAttributeMap objectId = - Map.lookup objectId (classAttributeMapObjectMap classAttributeMap) +getObjectName :: Map.Map Word32 Text -> Word32 -> Maybe Text +getObjectName objectMap objectId = Map.lookup objectId objectMap getClassName :: Text -> Maybe Text getClassName rawObjectName = @@ -216,24 +241,17 @@ classesWithRotation :: Set.Set Text classesWithRotation = Set.fromList (map stringToText rawClassesWithRotation) -getAttributeIdLimit :: ClassAttributeMap - -> ActorMap - -> CompressedWord - -> Maybe Word -getAttributeIdLimit classAttributeMap actorMap actorId = do - attributeMap <- getAttributeMap classAttributeMap actorMap actorId - let streamIds = Map.keys attributeMap - let maxStreamId = maximum (Word32 0 : streamIds) - let limit = fromIntegral (word32Value maxStreamId) +getAttributeIdLimit :: Map.Map Word32 Word32 -> Maybe Word +getAttributeIdLimit attributeMap = do + ((streamId, _), _) <- Map.maxViewWithKey attributeMap + let limit = fromIntegral (word32Value streamId) pure limit getAttributeName :: ClassAttributeMap - -> ActorMap - -> CompressedWord + -> Map.Map Word32 Word32 -> CompressedWord -> Maybe Text -getAttributeName classAttributeMap actorMap actorId streamId = do - attributeMap <- getAttributeMap classAttributeMap actorMap actorId +getAttributeName classAttributeMap attributeMap streamId = do let key = Word32 (fromIntegral (compressedWordValue streamId)) attributeId <- Map.lookup key attributeMap let objectMap = classAttributeMapObjectMap classAttributeMap @@ -245,9 +263,7 @@ -> Maybe (Map.Map Word32 Word32) getAttributeMap classAttributeMap actorMap actorId = do objectId <- Map.lookup actorId actorMap - objectName <- getObjectName classAttributeMap objectId - className <- getClassName objectName - let classMap = classAttributeMapClassMap classAttributeMap - classId <- Bimap.lookupR className classMap + let objectClassMap = classAttributeMapObjectClassMap classAttributeMap + classId <- Map.lookup objectId objectClassMap let value = classAttributeMapValue classAttributeMap Map.lookup classId value diff --git a/library/Rattletrap/Replication/Spawned.hs b/library/Rattletrap/Replication/Spawned.hs --- a/library/Rattletrap/Replication/Spawned.hs +++ b/library/Rattletrap/Replication/Spawned.hs @@ -44,7 +44,7 @@ :: Monad m => ClassAttributeMap -> Word32 -> m Text lookupObjectName classAttributeMap objectId = - case getObjectName classAttributeMap objectId of + case getObjectName (classAttributeMapObjectMap classAttributeMap) objectId of Nothing -> fail ("could not get object name for id " ++ show objectId) Just objectName -> pure objectName diff --git a/rattletrap.cabal b/rattletrap.cabal --- a/rattletrap.cabal +++ b/rattletrap.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: rattletrap -version: 0.3.0 +version: 0.4.0 synopsis: Parse and generate Rocket League replays. description: Rattletrap parses and generates Rocket League replays. category: Game