module Rattletrap.Type.Replication.Spawned where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.Initialization as Initialization
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

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

data Spawned = Spawned
  { Spawned -> Bool
flag :: Bool
  -- ^ Unclear what this is.
  , Spawned -> Maybe U32
nameIndex :: Maybe U32.U32
  , Spawned -> Maybe Str
name :: Maybe Str.Str
  -- ^ Read-only! Changing a replication's name requires editing the
  -- 'nameIndex' and maybe the class attribute map.
  , Spawned -> U32
objectId :: U32.U32
  , Spawned -> Str
objectName :: Str.Str
  -- ^ Read-only! Changing a replication's object requires editing the class
  -- attribute map.
  , Spawned -> Str
className :: Str.Str
  -- ^ Read-only! Changing a replication's class requires editing the class
  -- attribute map.
  , Spawned -> Initialization
initialization :: Initialization.Initialization
  }
  deriving (Spawned -> Spawned -> Bool
(Spawned -> Spawned -> Bool)
-> (Spawned -> Spawned -> Bool) -> Eq Spawned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spawned -> Spawned -> Bool
$c/= :: Spawned -> Spawned -> Bool
== :: Spawned -> Spawned -> Bool
$c== :: Spawned -> Spawned -> Bool
Eq, Int -> Spawned -> ShowS
[Spawned] -> ShowS
Spawned -> String
(Int -> Spawned -> ShowS)
-> (Spawned -> String) -> ([Spawned] -> ShowS) -> Show Spawned
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spawned] -> ShowS
$cshowList :: [Spawned] -> ShowS
show :: Spawned -> String
$cshow :: Spawned -> String
showsPrec :: Int -> Spawned -> ShowS
$cshowsPrec :: Int -> Spawned -> ShowS
Show)

instance Json.FromJSON Spawned where
  parseJSON :: Value -> Parser Spawned
parseJSON = String -> (Object -> Parser Spawned) -> Value -> Parser Spawned
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Spawned" ((Object -> Parser Spawned) -> Value -> Parser Spawned)
-> (Object -> Parser Spawned) -> Value -> Parser Spawned
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
flag <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"flag"
    Maybe U32
nameIndex <- Object -> String -> Parser (Maybe U32)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name_index"
    Maybe Str
name <- Object -> String -> Parser (Maybe Str)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name"
    U32
objectId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_id"
    Str
objectName <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"object_name"
    Str
className <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_name"
    Initialization
initialization <- Object -> String -> Parser Initialization
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"initialization"
    Spawned -> Parser Spawned
forall (f :: * -> *) a. Applicative f => a -> f a
pure Spawned :: Bool
-> Maybe U32
-> Maybe Str
-> U32
-> Str
-> Str
-> Initialization
-> Spawned
Spawned
      { Bool
flag :: Bool
flag :: Bool
flag
      , Maybe U32
nameIndex :: Maybe U32
nameIndex :: Maybe U32
nameIndex
      , Maybe Str
name :: Maybe Str
name :: Maybe Str
name
      , U32
objectId :: U32
objectId :: U32
objectId
      , Str
objectName :: Str
objectName :: Str
objectName
      , Str
className :: Str
className :: Str
className
      , Initialization
initialization :: Initialization
initialization :: Initialization
initialization
      }

instance Json.ToJSON Spawned where
  toJSON :: Spawned -> Value
toJSON Spawned
x = [Pair] -> Value
Json.object
    [ String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Bool
flag Spawned
x
    , String -> Maybe U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name_index" (Maybe U32 -> Pair) -> Maybe U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe U32
nameIndex Spawned
x
    , String -> Maybe Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (Maybe Str -> Pair) -> Maybe Str -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Maybe Str
name Spawned
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> U32
objectId Spawned
x
    , String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_name" (Str -> Pair) -> Str -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Str
objectName Spawned
x
    , String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_name" (Str -> Pair) -> Str -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Str
className Spawned
x
    , String -> Initialization -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"initialization" (Initialization -> Pair) -> Initialization -> Pair
forall a b. (a -> b) -> a -> b
$ Spawned -> Initialization
initialization Spawned
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"replication-spawned" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"flag" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name_index" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
U32.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"object_name" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_name" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"initialization" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Initialization.schema, Bool
True)
  ]

bitPut :: Spawned -> BitPut.BitPut
bitPut :: Spawned -> BitPut
bitPut Spawned
spawnedReplication =
  Bool -> BitPut
BitPut.bool (Spawned -> Bool
flag Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (U32 -> BitPut) -> Maybe U32 -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap U32 -> BitPut
U32.bitPut (Spawned -> Maybe U32
nameIndex Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (Spawned -> U32
objectId Spawned
spawnedReplication)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Initialization -> BitPut
Initialization.bitPut (Spawned -> Initialization
initialization Spawned
spawnedReplication)

bitGet
  :: Maybe Str.Str
  -> Version.Version
  -> ClassAttributeMap.ClassAttributeMap
  -> CompressedWord.CompressedWord
  -> State.StateT
       (Map.Map CompressedWord.CompressedWord U32.U32)
       BitGet.BitGet
       Spawned
bitGet :: Maybe Str
-> Version
-> ClassAttributeMap
-> CompressedWord
-> StateT (Map CompressedWord U32) BitGet Spawned
bitGet Maybe Str
matchType Version
version ClassAttributeMap
classAttributeMap CompressedWord
actorId = do
  Bool
flag_ <- Get BitString Identity Bool
-> StateT (Map CompressedWord U32) BitGet Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity Bool
BitGet.bool
  Maybe U32
nameIndex_ <- Bool
-> StateT (Map CompressedWord U32) BitGet U32
-> StateT (Map CompressedWord U32) BitGet (Maybe U32)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Maybe Str -> Version -> Bool
hasNameIndex Maybe Str
matchType Version
version)
    (StateT (Map CompressedWord U32) BitGet U32
 -> StateT (Map CompressedWord U32) BitGet (Maybe U32))
-> StateT (Map CompressedWord U32) BitGet U32
-> StateT (Map CompressedWord U32) BitGet (Maybe U32)
forall a b. (a -> b) -> a -> b
$ Get BitString Identity U32
-> StateT (Map CompressedWord U32) BitGet U32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity U32
U32.bitGet
  Maybe Str
name_ <- (String -> StateT (Map CompressedWord U32) BitGet (Maybe Str))
-> (Maybe Str
    -> StateT (Map CompressedWord U32) BitGet (Maybe Str))
-> Either String (Maybe Str)
-> StateT (Map CompressedWord U32) BitGet (Maybe Str)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> StateT (Map CompressedWord U32) BitGet (Maybe Str)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Maybe Str -> StateT (Map CompressedWord U32) BitGet (Maybe Str)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClassAttributeMap -> Maybe U32 -> Either String (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe U32
nameIndex_)
  U32
objectId_ <- Get BitString Identity U32
-> StateT (Map CompressedWord U32) BitGet U32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Get BitString Identity U32
U32.bitGet
  (Map CompressedWord U32 -> Map CompressedWord U32)
-> StateT (Map CompressedWord U32) BitGet ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (CompressedWord
-> U32 -> Map CompressedWord U32 -> Map CompressedWord U32
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CompressedWord
actorId U32
objectId_)
  Str
objectName_ <- (String -> StateT (Map CompressedWord U32) BitGet Str)
-> (Str -> StateT (Map CompressedWord U32) BitGet Str)
-> Either String Str
-> StateT (Map CompressedWord U32) BitGet Str
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> StateT (Map CompressedWord U32) BitGet Str
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
    Str -> StateT (Map CompressedWord U32) BitGet Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ClassAttributeMap -> U32 -> Either String Str
lookupObjectName ClassAttributeMap
classAttributeMap U32
objectId_)
  Str
className_ <- (String -> StateT (Map CompressedWord U32) BitGet Str)
-> (Str -> StateT (Map CompressedWord U32) BitGet Str)
-> Either String Str
-> StateT (Map CompressedWord U32) BitGet Str
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> StateT (Map CompressedWord U32) BitGet Str
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Str -> StateT (Map CompressedWord U32) BitGet Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Str -> Either String Str
lookupClassName Str
objectName_)
  let hasLocation :: Bool
hasLocation = Str -> Bool
ClassAttributeMap.classHasLocation Str
className_
  let hasRotation :: Bool
hasRotation = Str -> Bool
ClassAttributeMap.classHasRotation Str
className_
  Initialization
initialization_ <- Get BitString Identity Initialization
-> StateT (Map CompressedWord U32) BitGet Initialization
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift
    (Version -> Bool -> Bool -> Get BitString Identity Initialization
Initialization.bitGet Version
version Bool
hasLocation Bool
hasRotation)
  Spawned -> StateT (Map CompressedWord U32) BitGet Spawned
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Bool
-> Maybe U32
-> Maybe Str
-> U32
-> Str
-> Str
-> Initialization
-> Spawned
Spawned
      Bool
flag_
      Maybe U32
nameIndex_
      Maybe Str
name_
      U32
objectId_
      Str
objectName_
      Str
className_
      Initialization
initialization_
    )

hasNameIndex :: Maybe Str.Str -> Version.Version -> Bool
hasNameIndex :: Maybe Str -> Version -> Bool
hasNameIndex Maybe Str
matchType Version
version =
  Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
14 Int
0 Version
version Bool -> Bool -> Bool
&& Maybe Str
matchType Maybe Str -> Maybe Str -> Bool
forall a. Eq a => a -> a -> Bool
/= Str -> Maybe Str
forall a. a -> Maybe a
Just (String -> Str
Str.fromString String
"Lan")

lookupName
  :: ClassAttributeMap.ClassAttributeMap
  -> Maybe U32.U32
  -> Either String (Maybe Str.Str)
lookupName :: ClassAttributeMap -> Maybe U32 -> Either String (Maybe Str)
lookupName ClassAttributeMap
classAttributeMap Maybe U32
maybeNameIndex = case Maybe U32
maybeNameIndex of
  Maybe U32
Nothing -> Maybe Str -> Either String (Maybe Str)
forall a b. b -> Either a b
Right Maybe Str
forall a. Maybe a
Nothing
  Just U32
nameIndex_ ->
    case
        IntMap Str -> U32 -> Maybe Str
ClassAttributeMap.getName
          (ClassAttributeMap -> IntMap Str
ClassAttributeMap.nameMap ClassAttributeMap
classAttributeMap)
          U32
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> U32 -> String
forall a. Show a => a -> String
show U32
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.ClassAttributeMap -> U32.U32 -> Either String Str.Str
lookupObjectName :: ClassAttributeMap -> U32 -> Either String Str
lookupObjectName ClassAttributeMap
classAttributeMap U32
objectId_ =
  case
      Map U32 Str -> U32 -> Maybe Str
ClassAttributeMap.getObjectName
        (ClassAttributeMap -> Map U32 Str
ClassAttributeMap.objectMap ClassAttributeMap
classAttributeMap)
        U32
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> U32 -> String
forall a. Show a => a -> String
show U32
objectId_)
      Just Str
objectName_ -> Str -> Either String Str
forall a b. b -> Either a b
Right Str
objectName_

lookupClassName :: Str.Str -> Either String Str.Str
lookupClassName :: Str -> Either String Str
lookupClassName Str
objectName_ =
  case Str -> Maybe Str
ClassAttributeMap.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 -> ShowS
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_