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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"RigidBodyState" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
sleeping <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"sleeping"
    Vector
location <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"location"
    Rotation
rotation <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rotation"
    Maybe Vector
linearVelocity <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"linear_velocity"
    Maybe Vector
angularVelocity <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"angular_velocity"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      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 =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"sleeping" forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Bool
sleeping RigidBodyState
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"location" forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Vector
location RigidBodyState
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Rotation
rotation RigidBodyState
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"linear_velocity" forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Maybe Vector
linearVelocity RigidBodyState
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angular_velocity" 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" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"sleeping" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"location" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Vector.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Rotation.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"linear_velocity" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Vector.schema,
          Bool
False
        ),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angular_velocity" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json 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)
    forall a. Semigroup a => a -> a -> a
<> Vector -> BitPut
Vector.bitPut (RigidBodyState -> Vector
location RigidBodyState
rigidBodyStateAttribute)
    forall a. Semigroup a => a -> a -> a
<> Rotation -> BitPut
Rotation.bitPut (RigidBodyState -> Rotation
rotation RigidBodyState
rigidBodyStateAttribute)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vector -> BitPut
Vector.bitPut (RigidBodyState -> Maybe Vector
linearVelocity RigidBodyState
rigidBodyStateAttribute)
    forall a. Semigroup a => a -> a -> a
<> 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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"RigidBodyState" forall a b. (a -> b) -> a -> b
$ do
  Bool
sleeping <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"sleeping" BitGet Bool
BitGet.bool
  Vector
location <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"location" forall a b. (a -> b) -> a -> b
$ Version -> BitGet Vector
Vector.bitGet Version
version
  Rotation
rotation <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"rotation" forall a b. (a -> b) -> a -> b
$ Version -> BitGet Rotation
Rotation.bitGet Version
version
  Maybe Vector
linearVelocity <-
    forall a. String -> BitGet a -> BitGet a
BitGet.label String
"linearVelocity" forall a b. (a -> b) -> a -> b
$
      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 <-
    forall a. String -> BitGet a -> BitGet a
BitGet.label String
"angularVelocity" forall a b. (a -> b) -> a -> b
$
      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)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    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
      }