module Rattletrap.Type.ClassAttributeMap
  ( ClassAttributeMap(..)
  , classHasLocation
  , classHasRotation
  , getAttributeIdLimit
  , getAttributeMap
  , getAttributeName
  , getClassName
  , getName
  , getObjectName
  , makeClassAttributeMap
  )
where

import Rattletrap.Data
import Rattletrap.Type.AttributeMapping
import Rattletrap.Type.Cache
import Rattletrap.Type.ClassMapping
import Rattletrap.Type.Common
import Rattletrap.Type.CompressedWord
import Rattletrap.Type.List
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

import qualified 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

-- | 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 'makeClassAttributeMap'.
data ClassAttributeMap = ClassAttributeMap
  { ClassAttributeMap -> Map Word32le Str
classAttributeMapObjectMap :: Map Word32le Str
  -- ^ A map from object IDs to their names.
  , ClassAttributeMap -> Map Word32le Word32le
classAttributeMapObjectClassMap :: Map Word32le Word32le
  -- ^ A map from object IDs to their class IDs.
    , ClassAttributeMap -> Map Word32le (Map Word32le Word32le)
classAttributeMapValue :: Map Word32le (Map Word32le Word32le)
  -- ^ A map from class IDs to a map from attribute stream IDs to attribute
  -- IDs.
  , ClassAttributeMap -> IntMap Str
classAttributeMapNameMap :: IntMap.IntMap Str
  } deriving (ClassAttributeMap -> ClassAttributeMap -> Bool
(ClassAttributeMap -> ClassAttributeMap -> Bool)
-> (ClassAttributeMap -> ClassAttributeMap -> Bool)
-> Eq ClassAttributeMap
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, Eq ClassAttributeMap
Eq ClassAttributeMap
-> (ClassAttributeMap -> ClassAttributeMap -> Ordering)
-> (ClassAttributeMap -> ClassAttributeMap -> Bool)
-> (ClassAttributeMap -> ClassAttributeMap -> Bool)
-> (ClassAttributeMap -> ClassAttributeMap -> Bool)
-> (ClassAttributeMap -> ClassAttributeMap -> Bool)
-> (ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap)
-> (ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap)
-> Ord ClassAttributeMap
ClassAttributeMap -> ClassAttributeMap -> Bool
ClassAttributeMap -> ClassAttributeMap -> Ordering
ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap
$cmin :: ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap
max :: ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap
$cmax :: ClassAttributeMap -> ClassAttributeMap -> ClassAttributeMap
>= :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c>= :: ClassAttributeMap -> ClassAttributeMap -> Bool
> :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c> :: ClassAttributeMap -> ClassAttributeMap -> Bool
<= :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c<= :: ClassAttributeMap -> ClassAttributeMap -> Bool
< :: ClassAttributeMap -> ClassAttributeMap -> Bool
$c< :: ClassAttributeMap -> ClassAttributeMap -> Bool
compare :: ClassAttributeMap -> ClassAttributeMap -> Ordering
$ccompare :: ClassAttributeMap -> ClassAttributeMap -> Ordering
$cp1Ord :: Eq ClassAttributeMap
Ord, Int -> ClassAttributeMap -> ShowS
[ClassAttributeMap] -> ShowS
ClassAttributeMap -> String
(Int -> ClassAttributeMap -> ShowS)
-> (ClassAttributeMap -> String)
-> ([ClassAttributeMap] -> ShowS)
-> Show ClassAttributeMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassAttributeMap] -> ShowS
$cshowList :: [ClassAttributeMap] -> ShowS
show :: ClassAttributeMap -> String
$cshow :: ClassAttributeMap -> String
showsPrec :: Int -> ClassAttributeMap -> ShowS
$cshowsPrec :: Int -> ClassAttributeMap -> ShowS
Show)

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

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

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

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

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

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

getName :: IntMap.IntMap Str -> Word32le -> Maybe Str
getName :: IntMap Str -> Word32le -> Maybe Str
getName IntMap Str
nameMap Word32le
nameIndex =
  Int -> IntMap Str -> Maybe Str
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32le -> Word32
word32leValue Word32le
nameIndex)) IntMap Str
nameMap

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

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

makeClassCache
  :: Bimap Word32le Str
  -> List Cache
  -> [(Maybe Str, Word32le, Word32le, Word32le)]
makeClassCache :: Bimap Word32le Str
-> List Cache -> [(Maybe Str, Word32le, Word32le, Word32le)]
makeClassCache Bimap Word32le Str
classMap List Cache
caches = (Cache -> (Maybe Str, Word32le, Word32le, Word32le))
-> [Cache] -> [(Maybe Str, Word32le, Word32le, Word32le)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\Cache
cache ->
    let classId :: Word32le
classId = Cache -> Word32le
cacheClassId Cache
cache
    in
      ( Word32le -> Bimap Word32le Str -> Maybe Str
forall l r. Ord l => l -> Bimap l r -> Maybe r
lookupL Word32le
classId Bimap Word32le Str
classMap
      , Word32le
classId
      , Cache -> Word32le
cacheCacheId Cache
cache
      , Cache -> Word32le
cacheParentCacheId Cache
cache
      )
  )
  (List Cache -> [Cache]
forall a. List a -> [a]
listValue List Cache
caches)

makeClassMap :: List ClassMapping -> Bimap Word32le Str
makeClassMap :: List ClassMapping -> Bimap Word32le Str
makeClassMap List ClassMapping
classMappings = [(Word32le, Str)] -> Bimap Word32le Str
forall l r. (Ord l, Ord r) => [(l, r)] -> Bimap l r
bimap
  ((ClassMapping -> (Word32le, Str))
-> [ClassMapping] -> [(Word32le, Str)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\ClassMapping
classMapping ->
      (ClassMapping -> Word32le
classMappingStreamId ClassMapping
classMapping, ClassMapping -> Str
classMappingName ClassMapping
classMapping)
    )
    (List ClassMapping -> [ClassMapping]
forall a. List a -> [a]
listValue List ClassMapping
classMappings)
  )

makeAttributeMap :: List Cache -> Map Word32le (Map Word32le Word32le)
makeAttributeMap :: List Cache -> Map Word32le (Map Word32le Word32le)
makeAttributeMap List Cache
caches = [(Word32le, Map Word32le Word32le)]
-> Map Word32le (Map Word32le Word32le)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  ((Cache -> (Word32le, Map Word32le Word32le))
-> [Cache] -> [(Word32le, Map Word32le Word32le)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Cache
cache ->
      ( Cache -> Word32le
cacheClassId Cache
cache
      , [(Word32le, Word32le)] -> Map Word32le Word32le
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ((AttributeMapping -> (Word32le, Word32le))
-> [AttributeMapping] -> [(Word32le, Word32le)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (\AttributeMapping
attributeMapping ->
            ( AttributeMapping -> Word32le
attributeMappingStreamId AttributeMapping
attributeMapping
            , AttributeMapping -> Word32le
attributeMappingObjectId AttributeMapping
attributeMapping
            )
          )
          (List AttributeMapping -> [AttributeMapping]
forall a. List a -> [a]
listValue (Cache -> List AttributeMapping
cacheAttributeMappings Cache
cache))
        )
      )
    )
    (List Cache -> [Cache]
forall a. List a -> [a]
listValue List Cache
caches)
  )

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

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

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

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

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

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

parentClasses :: Map Str Str
parentClasses :: Map Str Str
parentClasses =
  (String -> Str) -> Map Str String -> Map Str Str
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map String -> Str
toStr ((String -> Str) -> Map String String -> Map Str String
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Str
toStr ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
rawParentClasses))

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

getObjectName :: Map Word32le Str -> Word32le -> Maybe Str
getObjectName :: Map Word32le Str -> Word32le -> Maybe Str
getObjectName Map Word32le Str
objectMap Word32le
objectId = Word32le -> Map Word32le Str -> Maybe Str
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word32le
objectId Map Word32le Str
objectMap

getClassName :: Str -> Maybe Str
getClassName :: Str -> Maybe Str
getClassName Str
rawObjectName =
  Str -> Map Str Str -> Maybe Str
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Str -> Str
normalizeObjectName Str
rawObjectName) Map Str Str
objectClasses

normalizeObjectName :: Str -> Str
normalizeObjectName :: Str -> Str
normalizeObjectName Str
objectName =
  let
    name :: Text
name = Str -> Text
strValue 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 Text
crowdActor
    else if Text -> Text -> Bool
Text.isInfixOf Text
crowdManager Text
name
      then Text -> Str
Str Text
crowdManager
      else if Text -> Text -> Bool
Text.isInfixOf Text
boostPickup Text
name
        then Text -> Str
Str Text
boostPickup
        else if Text -> Text -> Bool
Text.isInfixOf Text
mapScoreboard Text
name
          then Text -> Str
Str Text
mapScoreboard
          else if Text -> Text -> Bool
Text.isInfixOf Text
breakout Text
name
            then Text -> Str
Str Text
breakout
            else Str
objectName

objectClasses :: Map Str Str
objectClasses :: Map Str Str
objectClasses =
  (String -> Str) -> Map Str String -> Map Str Str
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map String -> Str
toStr ((String -> Str) -> Map String String -> Map Str String
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Str
toStr ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
rawObjectClasses))

classHasLocation :: Str -> Bool
classHasLocation :: Str -> Bool
classHasLocation Str
className = Str -> Set Str -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Str
className Set Str
classesWithLocation

classesWithLocation :: Set.Set Str
classesWithLocation :: Set Str
classesWithLocation = [Str] -> Set Str
forall a. Ord a => [a] -> Set a
Set.fromList ((String -> Str) -> [String] -> [Str]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Str
toStr [String]
rawClassesWithLocation)

classHasRotation :: Str -> Bool
classHasRotation :: Str -> Bool
classHasRotation Str
className = Str -> Set Str -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Str
className Set Str
classesWithRotation

classesWithRotation :: Set.Set Str
classesWithRotation :: Set Str
classesWithRotation = [Str] -> Set Str
forall a. Ord a => [a] -> Set a
Set.fromList ((String -> Str) -> [String] -> [Str]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Str
toStr [String]
rawClassesWithRotation)

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

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

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