module Rattletrap.Type.Attribute.RigidBodyState where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Rotation as Rotation
import qualified Rattletrap.Type.Vector as Vector
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

data RigidBodyState = RigidBodyState
  { RigidBodyState -> Bool
sleeping :: Bool
  , RigidBodyState -> Vector
location :: Vector.Vector
  , RigidBodyState -> Rotation
rotation :: Rotation.Rotation
  , RigidBodyState -> Maybe Vector
linearVelocity :: Maybe Vector.Vector
  , RigidBodyState -> Maybe Vector
angularVelocity :: Maybe Vector.Vector
  }
  deriving (RigidBodyState -> RigidBodyState -> Bool
(RigidBodyState -> RigidBodyState -> Bool)
-> (RigidBodyState -> RigidBodyState -> Bool) -> Eq RigidBodyState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RigidBodyState -> RigidBodyState -> Bool
$c/= :: RigidBodyState -> RigidBodyState -> Bool
== :: RigidBodyState -> RigidBodyState -> Bool
$c== :: RigidBodyState -> RigidBodyState -> Bool
Eq, Int -> RigidBodyState -> ShowS
[RigidBodyState] -> ShowS
RigidBodyState -> String
(Int -> RigidBodyState -> ShowS)
-> (RigidBodyState -> String)
-> ([RigidBodyState] -> ShowS)
-> Show RigidBodyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RigidBodyState] -> ShowS
$cshowList :: [RigidBodyState] -> ShowS
show :: RigidBodyState -> String
$cshow :: RigidBodyState -> String
showsPrec :: Int -> RigidBodyState -> ShowS
$cshowsPrec :: Int -> RigidBodyState -> ShowS
Show)

instance Json.FromJSON RigidBodyState where
  parseJSON :: Value -> Parser RigidBodyState
parseJSON = String
-> (Object -> Parser RigidBodyState)
-> Value
-> Parser RigidBodyState
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"RigidBodyState" ((Object -> Parser RigidBodyState)
 -> Value -> Parser RigidBodyState)
-> (Object -> Parser RigidBodyState)
-> Value
-> Parser RigidBodyState
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
sleeping <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"sleeping"
    Vector
location <- Object -> String -> Parser Vector
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"location"
    Rotation
rotation <- Object -> String -> Parser Rotation
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rotation"
    Maybe Vector
linearVelocity <- Object -> String -> Parser (Maybe Vector)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"linear_velocity"
    Maybe Vector
angularVelocity <- Object -> String -> Parser (Maybe Vector)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"angular_velocity"
    RigidBodyState -> Parser RigidBodyState
forall (f :: * -> *) a. Applicative f => a -> f a
pure RigidBodyState :: Bool
-> Vector
-> Rotation
-> Maybe Vector
-> Maybe Vector
-> RigidBodyState
RigidBodyState
      { Bool
sleeping :: Bool
sleeping :: Bool
sleeping
      , Vector
location :: Vector
location :: Vector
location
      , Rotation
rotation :: Rotation
rotation :: Rotation
rotation
      , Maybe Vector
linearVelocity :: Maybe Vector
linearVelocity :: Maybe Vector
linearVelocity
      , Maybe Vector
angularVelocity :: Maybe Vector
angularVelocity :: Maybe Vector
angularVelocity
      }

instance Json.ToJSON RigidBodyState where
  toJSON :: RigidBodyState -> Value
toJSON RigidBodyState
x = [Pair] -> Value
Json.object
    [ String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"sleeping" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Bool
sleeping RigidBodyState
x
    , String -> Vector -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"location" (Vector -> Pair) -> Vector -> Pair
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Vector
location RigidBodyState
x
    , String -> Rotation -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" (Rotation -> Pair) -> Rotation -> Pair
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Rotation
rotation RigidBodyState
x
    , String -> Maybe Vector -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"linear_velocity" (Maybe Vector -> Pair) -> Maybe Vector -> Pair
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Maybe Vector
linearVelocity RigidBodyState
x
    , String -> Maybe Vector -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angular_velocity" (Maybe Vector -> Pair) -> Maybe Vector -> Pair
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Maybe Vector
angularVelocity RigidBodyState
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-rigid-body-state" (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
"sleeping" (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
"location" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Vector.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Rotation.schema, Bool
True)
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"linear_velocity" (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
Vector.schema
    , Bool
False
    )
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angular_velocity" (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
Vector.schema
    , Bool
False
    )
  ]

bitPut :: RigidBodyState -> BitPut.BitPut
bitPut :: RigidBodyState -> BitPut
bitPut RigidBodyState
rigidBodyStateAttribute =
  Bool -> BitPut
BitPut.bool (RigidBodyState -> Bool
sleeping RigidBodyState
rigidBodyStateAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Vector -> BitPut
Vector.bitPut (RigidBodyState -> Vector
location RigidBodyState
rigidBodyStateAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Rotation -> BitPut
Rotation.bitPut (RigidBodyState -> Rotation
rotation RigidBodyState
rigidBodyStateAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (Vector -> BitPut) -> Maybe Vector -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vector -> BitPut
Vector.bitPut (RigidBodyState -> Maybe Vector
linearVelocity RigidBodyState
rigidBodyStateAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (Vector -> BitPut) -> Maybe Vector -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vector -> BitPut
Vector.bitPut (RigidBodyState -> Maybe Vector
angularVelocity RigidBodyState
rigidBodyStateAttribute)

bitGet :: Version.Version -> BitGet.BitGet RigidBodyState
bitGet :: Version -> BitGet RigidBodyState
bitGet Version
version = do
  Bool
sleeping <- BitGet Bool
BitGet.bool
  Vector
location <- Version -> BitGet Vector
Vector.bitGet Version
version
  Rotation
rotation <- Version -> BitGet Rotation
Rotation.bitGet Version
version
  Maybe Vector
linearVelocity <- Bool -> BitGet Vector -> Get BitString Identity (Maybe Vector)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Bool -> Bool
not Bool
sleeping) (Version -> BitGet Vector
Vector.bitGet Version
version)
  Maybe Vector
angularVelocity <- Bool -> BitGet Vector -> Get BitString Identity (Maybe Vector)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Bool -> Bool
not Bool
sleeping) (Version -> BitGet Vector
Vector.bitGet Version
version)
  RigidBodyState -> BitGet RigidBodyState
forall (f :: * -> *) a. Applicative f => a -> f a
pure RigidBodyState :: Bool
-> Vector
-> Rotation
-> Maybe Vector
-> Maybe Vector
-> RigidBodyState
RigidBodyState
    { Bool
sleeping :: Bool
sleeping :: Bool
sleeping
    , Vector
location :: Vector
location :: Vector
location
    , Rotation
rotation :: Rotation
rotation :: Rotation
rotation
    , Maybe Vector
linearVelocity :: Maybe Vector
linearVelocity :: Maybe Vector
linearVelocity
    , Maybe Vector
angularVelocity :: Maybe Vector
angularVelocity :: Maybe Vector
angularVelocity
    }