module Rattletrap.Type.Attribute.WeldedInfo where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.F32 as F32
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.Int8Vector as Int8Vector
import qualified Rattletrap.Type.Vector as Vector
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data WeldedInfo = WeldedInfo
  { WeldedInfo -> Bool
active :: Bool,
    WeldedInfo -> I32
actorId :: I32.I32,
    WeldedInfo -> Vector
offset :: Vector.Vector,
    WeldedInfo -> F32
mass :: F32.F32,
    WeldedInfo -> Int8Vector
rotation :: Int8Vector.Int8Vector
  }
  deriving (WeldedInfo -> WeldedInfo -> Bool
(WeldedInfo -> WeldedInfo -> Bool)
-> (WeldedInfo -> WeldedInfo -> Bool) -> Eq WeldedInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WeldedInfo -> WeldedInfo -> Bool
== :: WeldedInfo -> WeldedInfo -> Bool
$c/= :: WeldedInfo -> WeldedInfo -> Bool
/= :: WeldedInfo -> WeldedInfo -> Bool
Eq, Int -> WeldedInfo -> ShowS
[WeldedInfo] -> ShowS
WeldedInfo -> String
(Int -> WeldedInfo -> ShowS)
-> (WeldedInfo -> String)
-> ([WeldedInfo] -> ShowS)
-> Show WeldedInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WeldedInfo -> ShowS
showsPrec :: Int -> WeldedInfo -> ShowS
$cshow :: WeldedInfo -> String
show :: WeldedInfo -> String
$cshowList :: [WeldedInfo] -> ShowS
showList :: [WeldedInfo] -> ShowS
Show)

instance Json.FromJSON WeldedInfo where
  parseJSON :: Value -> Parser WeldedInfo
parseJSON = String
-> (Object -> Parser WeldedInfo) -> Value -> Parser WeldedInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"WeldedInfo" ((Object -> Parser WeldedInfo) -> Value -> Parser WeldedInfo)
-> (Object -> Parser WeldedInfo) -> Value -> Parser WeldedInfo
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    active <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"active"
    actorId <- Json.required object "actor_id"
    offset <- Json.required object "offset"
    mass <- Json.required object "mass"
    rotation <- Json.required object "rotation"
    pure WeldedInfo {active, actorId, offset, mass, rotation}

instance Json.ToJSON WeldedInfo where
  toJSON :: WeldedInfo -> Value
toJSON WeldedInfo
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"active" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Bool
active WeldedInfo
x,
        String -> I32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"actor_id" (I32 -> (Key, Value)) -> I32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ WeldedInfo -> I32
actorId WeldedInfo
x,
        String -> Vector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"offset" (Vector -> (Key, Value)) -> Vector -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Vector
offset WeldedInfo
x,
        String -> F32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"mass" (F32 -> (Key, Value)) -> F32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ WeldedInfo -> F32
mass WeldedInfo
x,
        String -> Int8Vector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"rotation" (Int8Vector -> (Key, Value)) -> Int8Vector -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Int8Vector
rotation WeldedInfo
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-welded-info" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"active" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"actor_id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
I32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"offset" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Vector.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"mass" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"rotation" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Int8Vector.schema, Bool
True)
      ]

bitPut :: WeldedInfo -> BitPut.BitPut
bitPut :: WeldedInfo -> BitPut
bitPut WeldedInfo
weldedInfoAttribute =
  Bool -> BitPut
BitPut.bool (WeldedInfo -> Bool
active WeldedInfo
weldedInfoAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> I32 -> BitPut
I32.bitPut (WeldedInfo -> I32
actorId WeldedInfo
weldedInfoAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Vector -> BitPut
Vector.bitPut (WeldedInfo -> Vector
offset WeldedInfo
weldedInfoAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (WeldedInfo -> F32
mass WeldedInfo
weldedInfoAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Int8Vector -> BitPut
Int8Vector.bitPut (WeldedInfo -> Int8Vector
rotation WeldedInfo
weldedInfoAttribute)

bitGet :: Version.Version -> BitGet.BitGet WeldedInfo
bitGet :: Version -> BitGet WeldedInfo
bitGet Version
version = String -> BitGet WeldedInfo -> BitGet WeldedInfo
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"WeldedInfo" (BitGet WeldedInfo -> BitGet WeldedInfo)
-> BitGet WeldedInfo -> BitGet WeldedInfo
forall a b. (a -> b) -> a -> b
$ do
  active <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"active" BitGet Bool
BitGet.bool
  actorId <- BitGet.label "actorId" I32.bitGet
  offset <- BitGet.label "offset" $ Vector.bitGet version
  mass <- BitGet.label "mass" F32.bitGet
  rotation <- BitGet.label "rotation" Int8Vector.bitGet
  pure WeldedInfo {active, actorId, offset, mass, rotation}