module Rattletrap.Decode.SpawnedReplication
  ( decodeSpawnedReplicationBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Initialization
import Rattletrap.Decode.Word32le
import Rattletrap.Type.ClassAttributeMap
import Rattletrap.Type.CompressedWord
import Rattletrap.Type.SpawnedReplication
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Monad.Trans.State as State
import qualified Data.Map as Map

decodeSpawnedReplicationBits
  :: (Int, Int, Int)
  -> ClassAttributeMap
  -> CompressedWord
  -> State.StateT
       (Map.Map CompressedWord Word32le)
       DecodeBits
       SpawnedReplication
decodeSpawnedReplicationBits :: (Int, Int, Int)
-> ClassAttributeMap
-> CompressedWord
-> StateT
     (Map CompressedWord Word32le) DecodeBits SpawnedReplication
decodeSpawnedReplicationBits (Int, Int, Int)
version ClassAttributeMap
classAttributeMap CompressedWord
actorId = do
  Bool
flag <- BitGet Bool -> StateT (Map CompressedWord Word32le) DecodeBits Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift BitGet Bool
getBool
  Maybe Word32le
nameIndex <- Bool
-> StateT (Map CompressedWord Word32le) DecodeBits Word32le
-> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Word32le)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen
    ((Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
14, Int
0))
    (BitGet Word32le
-> StateT (Map CompressedWord Word32le) DecodeBits Word32le
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift BitGet Word32le
decodeWord32leBits)
  Maybe Str
name <- (String
 -> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Str))
-> (Maybe Str
    -> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Str))
-> Either String (Maybe Str)
-> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Str)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String
-> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Str)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Maybe Str
-> StateT (Map CompressedWord Word32le) DecodeBits (Maybe Str)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClassAttributeMap -> Maybe Word32le -> Either String (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe Word32le
nameIndex)
  Word32le
objectId <- BitGet Word32le
-> StateT (Map CompressedWord Word32le) DecodeBits Word32le
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift BitGet Word32le
decodeWord32leBits
  (Map CompressedWord Word32le -> Map CompressedWord Word32le)
-> StateT (Map CompressedWord Word32le) DecodeBits ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (CompressedWord
-> Word32le
-> Map CompressedWord Word32le
-> Map CompressedWord Word32le
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CompressedWord
actorId Word32le
objectId)
  Str
objectName <- (String -> StateT (Map CompressedWord Word32le) DecodeBits Str)
-> (Str -> StateT (Map CompressedWord Word32le) DecodeBits Str)
-> Either String Str
-> StateT (Map CompressedWord Word32le) DecodeBits Str
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> StateT (Map CompressedWord Word32le) DecodeBits Str
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Str -> StateT (Map CompressedWord Word32le) DecodeBits Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClassAttributeMap -> Word32le -> Either String Str
lookupObjectName ClassAttributeMap
classAttributeMap Word32le
objectId)
  Str
className <- (String -> StateT (Map CompressedWord Word32le) DecodeBits Str)
-> (Str -> StateT (Map CompressedWord Word32le) DecodeBits Str)
-> Either String Str
-> StateT (Map CompressedWord Word32le) DecodeBits Str
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> StateT (Map CompressedWord Word32le) DecodeBits Str
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Str -> StateT (Map CompressedWord Word32le) DecodeBits Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> Either String Str
lookupClassName Str
objectName)
  let hasLocation :: Bool
hasLocation = Str -> Bool
classHasLocation Str
className
  let hasRotation :: Bool
hasRotation = Str -> Bool
classHasRotation Str
className
  Initialization
initialization <- BitGet Initialization
-> StateT (Map CompressedWord Word32le) DecodeBits Initialization
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
    ((Int, Int, Int) -> Bool -> Bool -> BitGet Initialization
decodeInitializationBits (Int, Int, Int)
version Bool
hasLocation Bool
hasRotation)
  SpawnedReplication
-> StateT
     (Map CompressedWord Word32le) DecodeBits SpawnedReplication
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Bool
-> Maybe Word32le
-> Maybe Str
-> Word32le
-> Str
-> Str
-> Initialization
-> SpawnedReplication
SpawnedReplication
      Bool
flag
      Maybe Word32le
nameIndex
      Maybe Str
name
      Word32le
objectId
      Str
objectName
      Str
className
      Initialization
initialization
    )

lookupName :: ClassAttributeMap -> Maybe Word32le -> Either String (Maybe Str)
lookupName :: ClassAttributeMap -> Maybe Word32le -> Either String (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe Word32le
maybeNameIndex = case Maybe Word32le
maybeNameIndex of
  Maybe Word32le
Nothing -> Maybe Str -> Either String (Maybe Str)
forall a b. b -> Either a b
Right Maybe Str
forall a. Maybe a
Nothing
  Just Word32le
nameIndex ->
    case IntMap Str -> Word32le -> Maybe Str
getName (ClassAttributeMap -> IntMap Str
classAttributeMapNameMap ClassAttributeMap
classAttributeMap) Word32le
nameIndex of
      Maybe Str
Nothing ->
        String -> Either String (Maybe Str)
forall a b. a -> Either a b
Left (String
"[RT11] could not get name for index " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32le -> String
forall a. Show a => a -> String
show Word32le
nameIndex)
      Just Str
name -> Maybe Str -> Either String (Maybe Str)
forall a b. b -> Either a b
Right (Str -> Maybe Str
forall a. a -> Maybe a
Just Str
name)

lookupObjectName :: ClassAttributeMap -> Word32le -> Either String Str
lookupObjectName :: ClassAttributeMap -> Word32le -> Either String Str
lookupObjectName ClassAttributeMap
classAttributeMap Word32le
objectId =
  case Map Word32le Str -> Word32le -> Maybe Str
getObjectName (ClassAttributeMap -> Map Word32le Str
classAttributeMapObjectMap ClassAttributeMap
classAttributeMap) Word32le
objectId of
    Maybe Str
Nothing ->
      String -> Either String Str
forall a b. a -> Either a b
Left (String
"[RT12] could not get object name for id " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32le -> String
forall a. Show a => a -> String
show Word32le
objectId)
    Just Str
objectName -> Str -> Either String Str
forall a b. b -> Either a b
Right Str
objectName

lookupClassName :: Str -> Either String Str
lookupClassName :: Str -> Either String Str
lookupClassName Str
objectName = case Str -> Maybe Str
getClassName Str
objectName of
  Maybe Str
Nothing ->
    String -> Either String Str
forall a b. a -> Either a b
Left (String
"[RT13] could not get class name for object " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Str -> String
forall a. Show a => a -> String
show Str
objectName)
  Just Str
className -> Str -> Either String Str
forall a b. b -> Either a b
Right Str
className