module Rattletrap.Type.ClassAttributeMap where

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 Data.Tuple as Tuple
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

-- | This data structure holds all the information about classes, objects, and
-- 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 'make'.
data ClassAttributeMap = ClassAttributeMap
  { -- | A map from object IDs to their names.
    ClassAttributeMap -> Map U32 Str
objectMap :: Map.Map U32.U32 Str.Str,
    -- | A map from object IDs to their class IDs.
    ClassAttributeMap -> Map U32 U32
objectClassMap :: Map.Map U32.U32 U32.U32,
    -- | A map from class IDs to a map from attribute stream IDs to attribute
    -- IDs.
    ClassAttributeMap -> Map U32 (Map U32 U32)
value :: Map.Map U32.U32 (Map.Map U32.U32 U32.U32),
    ClassAttributeMap -> IntMap Str
nameMap :: IntMap.IntMap Str.Str
  }
  deriving (ClassAttributeMap -> ClassAttributeMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c/= :: ClassAttributeMap -> ClassAttributeMap -> Bool
== :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c== :: ClassAttributeMap -> ClassAttributeMap -> Bool
Eq, Key -> ClassAttributeMap -> ShowS
[ClassAttributeMap] -> ShowS
ClassAttributeMap -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassAttributeMap] -> ShowS
$cshowList :: [ClassAttributeMap] -> ShowS
show :: ClassAttributeMap -> String
$cshow :: ClassAttributeMap -> String
showsPrec :: Key -> ClassAttributeMap -> ShowS
$cshowsPrec :: Key -> ClassAttributeMap -> ShowS
Show)

type Bimap l r = (Map.Map l r, Map.Map r l)

bimap :: (Ord l, Ord r) => [(l, r)] -> Bimap l r
bimap :: forall l r. (Ord l, Ord r) => [(l, r)] -> Bimap l r
bimap [(l, r)]
xs = (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(l, r)]
xs, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
Tuple.swap [(l, r)]
xs))

lookupL :: (Ord l) => l -> Bimap l r -> Maybe r
lookupL :: forall l r. Ord l => l -> Bimap l r -> Maybe r
lookupL l
k = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup l
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

lookupR :: (Ord r) => r -> Bimap l r -> Maybe l
lookupR :: forall r l. Ord r => r -> Bimap l r -> Maybe l
lookupR r
k = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

-- | Makes a 'ClassAttributeMap' given the necessary fields from the
-- 'Rattletrap.Content.Content'.
make ::
  -- | From 'Rattletrap.Content.objects'.
  List.List Str.Str ->
  -- | From 'Rattletrap.Content.classMappings'.
  List.List ClassMapping.ClassMapping ->
  -- | From 'Rattletrap.Content.caches'.
  List.List Cache.Cache ->
  -- | From 'Rattletrap.Content.names'.
  List.List Str.Str ->
  ClassAttributeMap
make :: List Str
-> List ClassMapping -> List Cache -> List Str -> ClassAttributeMap
make List Str
objects List ClassMapping
classMappings List Cache
caches List Str
names =
  let objectMap_ :: Map U32 Str
objectMap_ = List Str -> Map U32 Str
makeObjectMap List Str
objects
      classMap :: Bimap U32 Str
classMap = List ClassMapping -> Bimap U32 Str
makeClassMap List ClassMapping
classMappings
      objectClassMap_ :: Map U32 U32
objectClassMap_ = Map U32 Str -> Bimap U32 Str -> Map U32 U32
makeObjectClassMap Map U32 Str
objectMap_ Bimap U32 Str
classMap
      classCache :: [(Maybe Str, U32, U32, U32)]
classCache = Bimap U32 Str -> List Cache -> [(Maybe Str, U32, U32, U32)]
makeClassCache Bimap U32 Str
classMap List Cache
caches
      attributeMap :: Map U32 (Map U32 U32)
attributeMap = List Cache -> Map U32 (Map U32 U32)
makeAttributeMap List Cache
caches
      classIds :: [U32]
classIds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Str
_, U32
classId, U32
_, U32
_) -> U32
classId) [(Maybe Str, U32, U32, U32)]
classCache
      parentMap :: Map U32 [U32]
parentMap = [(Maybe Str, U32, U32, U32)] -> Map U32 [U32]
makeParentMap [(Maybe Str, U32, U32, U32)]
classCache
      value_ :: Map U32 (Map U32 U32)
value_ =
        forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \U32
classId ->
                  let ownAttributes :: Map U32 U32
ownAttributes =
                        forall a. a -> Maybe a -> a
Maybe.fromMaybe forall k a. Map k a
Map.empty (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
classId Map U32 (Map U32 U32)
attributeMap)
                      parentsAttributes :: [Map U32 U32]
parentsAttributes = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
classId Map U32 [U32]
parentMap of
                        Maybe [U32]
Nothing -> []
                        Just [U32]
parentClassIds ->
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            ( \U32
parentClassId ->
                                forall a. a -> Maybe a -> a
Maybe.fromMaybe
                                  forall k a. Map k a
Map.empty
                                  (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
parentClassId Map U32 (Map U32 U32)
attributeMap)
                            )
                            [U32]
parentClassIds
                      attributes :: [Map U32 U32]
attributes = Map U32 U32
ownAttributes forall a. a -> [a] -> [a]
: [Map U32 U32]
parentsAttributes
                   in (U32
classId, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall k a. Map k a -> [(k, a)]
Map.toList [Map U32 U32]
attributes))
              )
              [U32]
classIds
          )
      nameMap_ :: IntMap Str
nameMap_ = List Str -> IntMap Str
makeNameMap List Str
names
   in Map U32 Str
-> Map U32 U32
-> Map U32 (Map U32 U32)
-> IntMap Str
-> ClassAttributeMap
ClassAttributeMap Map U32 Str
objectMap_ Map U32 U32
objectClassMap_ Map U32 (Map U32 U32)
value_ IntMap Str
nameMap_

makeNameMap :: List.List Str.Str -> IntMap.IntMap Str.Str
makeNameMap :: List Str -> IntMap Str
makeNameMap List Str
names =
  forall a. [(Key, a)] -> IntMap a
IntMap.fromDistinctAscList (forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0 ..] (forall a. List a -> [a]
List.toList List Str
names))

getName :: IntMap.IntMap Str.Str -> U32.U32 -> Maybe Str.Str
getName :: IntMap Str -> U32 -> Maybe Str
getName IntMap Str
nameMap_ U32
nameIndex =
  forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral (U32 -> Word32
U32.toWord32 U32
nameIndex)) IntMap Str
nameMap_

makeObjectClassMap ::
  Map.Map U32.U32 Str.Str ->
  Bimap U32.U32 Str.Str ->
  Map.Map U32.U32 U32.U32
makeObjectClassMap :: Map U32 Str -> Bimap U32 Str -> Map U32 U32
makeObjectClassMap Map U32 Str
objectMap_ Bimap U32 Str
classMap = do
  let objectIds :: [U32]
objectIds = forall k a. Map k a -> [k]
Map.keys Map U32 Str
objectMap_
  let classIds :: [Maybe U32]
classIds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map U32 Str -> Bimap U32 Str -> U32 -> Maybe U32
getClassId Map U32 Str
objectMap_ Bimap U32 Str
classMap) [U32]
objectIds
  let rawPairs :: [(U32, Maybe U32)]
rawPairs = forall a b. [a] -> [b] -> [(a, b)]
zip [U32]
objectIds [Maybe U32]
classIds
  let pairs :: [(U32, U32)]
pairs =
        forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
          ( \(U32
objectId, Maybe U32
maybeClassId) -> case Maybe U32
maybeClassId of
              Maybe U32
Nothing -> forall a. Maybe a
Nothing
              Just U32
classId -> forall a. a -> Maybe a
Just (U32
objectId, U32
classId)
          )
          [(U32, Maybe U32)]
rawPairs
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(U32, U32)]
pairs

getClassId ::
  Map.Map U32.U32 Str.Str ->
  Bimap U32.U32 Str.Str ->
  U32.U32 ->
  Maybe U32.U32
getClassId :: Map U32 Str -> Bimap U32 Str -> U32 -> Maybe U32
getClassId Map U32 Str
objectMap_ Bimap U32 Str
classMap U32
objectId = do
  Str
objectName <- Map U32 Str -> U32 -> Maybe Str
getObjectName Map U32 Str
objectMap_ U32
objectId
  Str
className <- Str -> Maybe Str
getClassName Str
objectName
  forall r l. Ord r => r -> Bimap l r -> Maybe l
lookupR Str
className Bimap U32 Str
classMap

makeClassCache ::
  Bimap U32.U32 Str.Str ->
  List.List Cache.Cache ->
  [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)]
makeClassCache :: Bimap U32 Str -> List Cache -> [(Maybe Str, U32, U32, U32)]
makeClassCache Bimap U32 Str
classMap List Cache
caches =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( \Cache
cache ->
        let classId :: U32
classId = Cache -> U32
Cache.classId Cache
cache
         in ( forall l r. Ord l => l -> Bimap l r -> Maybe r
lookupL U32
classId Bimap U32 Str
classMap,
              U32
classId,
              Cache -> U32
Cache.cacheId Cache
cache,
              Cache -> U32
Cache.parentCacheId Cache
cache
            )
    )
    (forall a. List a -> [a]
List.toList List Cache
caches)

makeClassMap :: List.List ClassMapping.ClassMapping -> Bimap U32.U32 Str.Str
makeClassMap :: List ClassMapping -> Bimap U32 Str
makeClassMap List ClassMapping
classMappings =
  forall l r. (Ord l, Ord r) => [(l, r)] -> Bimap l r
bimap
    ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \ClassMapping
classMapping ->
            (ClassMapping -> U32
ClassMapping.streamId ClassMapping
classMapping, ClassMapping -> Str
ClassMapping.name ClassMapping
classMapping)
        )
        (forall a. List a -> [a]
List.toList List ClassMapping
classMappings)
    )

makeAttributeMap ::
  List.List Cache.Cache -> Map.Map U32.U32 (Map.Map U32.U32 U32.U32)
makeAttributeMap :: List Cache -> Map U32 (Map U32 U32)
makeAttributeMap List Cache
caches =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Cache
cache ->
            ( Cache -> U32
Cache.classId Cache
cache,
              forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                    ( \AttributeMapping
attributeMapping ->
                        ( AttributeMapping -> U32
AttributeMapping.streamId AttributeMapping
attributeMapping,
                          AttributeMapping -> U32
AttributeMapping.objectId AttributeMapping
attributeMapping
                        )
                    )
                    (forall a. List a -> [a]
List.toList (Cache -> List AttributeMapping
Cache.attributeMappings Cache
cache))
                )
            )
        )
        (forall a. List a -> [a]
List.toList List Cache
caches)
    )

makeShallowParentMap ::
  [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Map.Map U32.U32 U32.U32
makeShallowParentMap :: [(Maybe Str, U32, U32, U32)] -> Map U32 U32
makeShallowParentMap [(Maybe Str, U32, U32, U32)]
classCache =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ( forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
        ( \[(Maybe Str, U32, U32, U32)]
xs -> case [(Maybe Str, U32, U32, U32)]
xs of
            [] -> forall a. Maybe a
Nothing
            (Maybe Str
maybeClassName, U32
classId, U32
_, U32
parentCacheId) : [(Maybe Str, U32, U32, U32)]
rest -> do
              U32
parentClassId <- Maybe Str -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClass Maybe Str
maybeClassName U32
parentCacheId [(Maybe Str, U32, U32, U32)]
rest
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (U32
classId, U32
parentClassId)
        )
        (forall a. [a] -> [[a]]
List.tails (forall a. [a] -> [a]
reverse [(Maybe Str, U32, U32, U32)]
classCache))
    )

makeParentMap ::
  [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Map.Map U32.U32 [U32.U32]
makeParentMap :: [(Maybe Str, U32, U32, U32)] -> Map U32 [U32]
makeParentMap [(Maybe Str, U32, U32, U32)]
classCache =
  let shallowParentMap :: Map U32 U32
shallowParentMap = [(Maybe Str, U32, U32, U32)] -> Map U32 U32
makeShallowParentMap [(Maybe Str, U32, U32, U32)]
classCache
   in forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
        (\U32
classId U32
_ -> Map U32 U32 -> U32 -> [U32]
getParentClasses Map U32 U32
shallowParentMap U32
classId)
        Map U32 U32
shallowParentMap

getParentClasses :: Map.Map U32.U32 U32.U32 -> U32.U32 -> [U32.U32]
getParentClasses :: Map U32 U32 -> U32 -> [U32]
getParentClasses Map U32 U32
shallowParentMap U32
classId =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
classId Map U32 U32
shallowParentMap of
    Maybe U32
Nothing -> []
    Just U32
parentClassId ->
      U32
parentClassId forall a. a -> [a] -> [a]
: Map U32 U32 -> U32 -> [U32]
getParentClasses Map U32 U32
shallowParentMap U32
parentClassId

getParentClass ::
  Maybe Str.Str ->
  U32.U32 ->
  [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] ->
  Maybe U32.U32
getParentClass :: Maybe Str -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClass Maybe Str
maybeClassName U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs = case Maybe Str
maybeClassName of
  Maybe Str
Nothing -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassById U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs
  Just Str
className -> Str -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassByName Str
className U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs

getParentClassById ::
  U32.U32 -> [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] -> Maybe U32.U32
getParentClassById :: U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassById U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs =
  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Maybe Str
_, U32
_, U32
cacheId, U32
_) -> U32
cacheId forall a. Eq a => a -> a -> Bool
/= U32
parentCacheId) [(Maybe Str, U32, U32, U32)]
xs of
    [] ->
      if U32
parentCacheId forall a. Eq a => a -> a -> Bool
== Word32 -> U32
U32.fromWord32 Word32
0
        then forall a. Maybe a
Nothing
        else
          U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassById
            (Word32 -> U32
U32.fromWord32 (U32 -> Word32
U32.toWord32 U32
parentCacheId forall a. Num a => a -> a -> a
- Word32
1))
            [(Maybe Str, U32, U32, U32)]
xs
    (Maybe Str
_, U32
parentClassId, U32
_, U32
_) : [(Maybe Str, U32, U32, U32)]
_ -> forall a. a -> Maybe a
Just U32
parentClassId

getParentClassByName ::
  Str.Str ->
  U32.U32 ->
  [(Maybe Str.Str, U32.U32, U32.U32, U32.U32)] ->
  Maybe U32.U32
getParentClassByName :: Str -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassByName Str
className U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Str -> Text
Str.toText Str
className) Map Text Text
Data.parentClasses of
    Maybe Text
Nothing -> U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassById U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs
    Just Text
parentClassName ->
      forall b a. b -> (a -> b) -> Maybe a -> b
Maybe.maybe
        (U32 -> [(Maybe Str, U32, U32, U32)] -> Maybe U32
getParentClassById U32
parentCacheId [(Maybe Str, U32, U32, U32)]
xs)
        forall a. a -> Maybe a
Just
        ( forall a. [a] -> Maybe a
Maybe.listToMaybe
            ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\(Maybe Str
_, U32
parentClassId, U32
_, U32
_) -> U32
parentClassId)
                ( forall a. (a -> Bool) -> [a] -> [a]
filter
                    (\(Maybe Str
_, U32
_, U32
cacheId, U32
_) -> U32
cacheId forall a. Ord a => a -> a -> Bool
<= U32
parentCacheId)
                    ( forall a. (a -> Bool) -> [a] -> [a]
filter
                        ( \(Maybe Str
maybeClassName, U32
_, U32
_, U32
_) ->
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Text
Str.toText Maybe Str
maybeClassName forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
parentClassName
                        )
                        [(Maybe Str, U32, U32, U32)]
xs
                    )
                )
            )
        )

makeObjectMap :: List.List Str.Str -> Map.Map U32.U32 Str.Str
makeObjectMap :: List Str -> Map U32 Str
makeObjectMap List Str
objects =
  forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> U32
U32.fromWord32 [Word32
0 ..]) (forall a. List a -> [a]
List.toList List Str
objects))

getObjectName :: Map.Map U32.U32 Str.Str -> U32.U32 -> Maybe Str.Str
getObjectName :: Map U32 Str -> U32 -> Maybe Str
getObjectName Map U32 Str
objectMap_ U32
objectId = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
objectId Map U32 Str
objectMap_

getClassName :: Str.Str -> Maybe Str.Str
getClassName :: Str -> Maybe Str
getClassName Str
rawObjectName =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Str
Str.fromText forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
      (Str -> Text
Str.toText forall a b. (a -> b) -> a -> b
$ Str -> Str
normalizeObjectName Str
rawObjectName)
      Map Text Text
Data.objectClasses

normalizeObjectName :: Str.Str -> Str.Str
normalizeObjectName :: Str -> Str
normalizeObjectName Str
objectName =
  let name :: Text
name = Str -> Text
Str.toText Str
objectName
      crowdActor :: Text
crowdActor = String -> Text
Text.pack String
"TheWorld:PersistentLevel.CrowdActor_TA"
      crowdManager :: Text
crowdManager = String -> Text
Text.pack String
"TheWorld:PersistentLevel.CrowdManager_TA"
      boostPickup :: Text
boostPickup = String -> Text
Text.pack String
"TheWorld:PersistentLevel.VehiclePickup_Boost_TA"
      mapScoreboard :: Text
mapScoreboard = String -> Text
Text.pack String
"TheWorld:PersistentLevel.InMapScoreboard_TA"
      breakout :: Text
breakout = String -> Text
Text.pack String
"TheWorld:PersistentLevel.BreakOutActor_Platform_TA"
   in if Text -> Text -> Bool
Text.isInfixOf Text
crowdActor Text
name
        then Text -> Str
Str.fromText Text
crowdActor
        else
          if Text -> Text -> Bool
Text.isInfixOf Text
crowdManager Text
name
            then Text -> Str
Str.fromText Text
crowdManager
            else
              if Text -> Text -> Bool
Text.isInfixOf Text
boostPickup Text
name
                then Text -> Str
Str.fromText Text
boostPickup
                else
                  if Text -> Text -> Bool
Text.isInfixOf Text
mapScoreboard Text
name
                    then Text -> Str
Str.fromText Text
mapScoreboard
                    else
                      if Text -> Text -> Bool
Text.isInfixOf Text
breakout Text
name
                        then Text -> Str
Str.fromText Text
breakout
                        else Str
objectName

classHasLocation :: Str.Str -> Bool
classHasLocation :: Str -> Bool
classHasLocation Str
className =
  forall a. Ord a => a -> Set a -> Bool
Set.member (Str -> Text
Str.toText Str
className) Set Text
Data.classesWithLocation

classHasRotation :: Str.Str -> Bool
classHasRotation :: Str -> Bool
classHasRotation Str
className =
  forall a. Ord a => a -> Set a -> Bool
Set.member (Str -> Text
Str.toText Str
className) Set Text
Data.classesWithRotation

getAttributeIdLimit :: Map.Map U32.U32 U32.U32 -> Maybe Word
getAttributeIdLimit :: Map U32 U32 -> Maybe Word
getAttributeIdLimit Map U32 U32
attributeMap = do
  ((U32
streamId, U32
_), Map U32 U32
_) <- forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.maxViewWithKey Map U32 U32
attributeMap
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral (U32 -> Word32
U32.toWord32 U32
streamId))

getAttributeName ::
  ClassAttributeMap ->
  Map.Map U32.U32 U32.U32 ->
  CompressedWord.CompressedWord ->
  Maybe Str.Str
getAttributeName :: ClassAttributeMap -> Map U32 U32 -> CompressedWord -> Maybe Str
getAttributeName ClassAttributeMap
classAttributeMap Map U32 U32
attributeMap CompressedWord
streamId = do
  let key :: U32
key = Word32 -> U32
U32.fromWord32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressedWord -> Word
CompressedWord.value CompressedWord
streamId))
  U32
attributeId <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
key Map U32 U32
attributeMap
  let objectMap_ :: Map U32 Str
objectMap_ = ClassAttributeMap -> Map U32 Str
objectMap ClassAttributeMap
classAttributeMap
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
attributeId Map U32 Str
objectMap_

getAttributeMap ::
  ClassAttributeMap ->
  Map.Map CompressedWord.CompressedWord U32.U32 ->
  CompressedWord.CompressedWord ->
  Maybe (Map.Map U32.U32 U32.U32)
getAttributeMap :: ClassAttributeMap
-> Map CompressedWord U32 -> CompressedWord -> Maybe (Map U32 U32)
getAttributeMap ClassAttributeMap
classAttributeMap Map CompressedWord U32
actorMap CompressedWord
actorId = do
  U32
objectId <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CompressedWord
actorId Map CompressedWord U32
actorMap
  let objectClassMap_ :: Map U32 U32
objectClassMap_ = ClassAttributeMap -> Map U32 U32
objectClassMap ClassAttributeMap
classAttributeMap
  U32
classId <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
objectId Map U32 U32
objectClassMap_
  let value_ :: Map U32 (Map U32 U32)
value_ = ClassAttributeMap -> Map U32 (Map U32 U32)
value ClassAttributeMap
classAttributeMap
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup U32
classId Map U32 (Map U32 U32)
value_