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
$c== :: RigidBodyState -> RigidBodyState -> Bool
== :: RigidBodyState -> RigidBodyState -> Bool
$c/= :: RigidBodyState -> RigidBodyState -> Bool
/= :: 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
$cshowsPrec :: Int -> RigidBodyState -> ShowS
showsPrec :: Int -> RigidBodyState -> ShowS
$cshow :: RigidBodyState -> String
show :: RigidBodyState -> String
$cshowList :: [RigidBodyState] -> ShowS
showList :: [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
    sleeping <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"sleeping"
    location <- Json.required object "location"
    rotation <- Json.required object "rotation"
    linearVelocity <- Json.optional object "linear_velocity"
    angularVelocity <- Json.optional object "angular_velocity"
    pure
      RigidBodyState
        { sleeping,
          location,
          rotation,
          linearVelocity,
          angularVelocity
        }

instance Json.ToJSON RigidBodyState where
  toJSON :: RigidBodyState -> Value
toJSON RigidBodyState
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
"sleeping" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Bool
sleeping RigidBodyState
x,
        String -> Vector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"location" (Vector -> (Key, Value)) -> Vector -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Vector
location RigidBodyState
x,
        String -> Rotation -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"rotation" (Rotation -> (Key, Value)) -> Rotation -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Rotation
rotation RigidBodyState
x,
        String -> Maybe Vector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"linear_velocity" (Maybe Vector -> (Key, Value)) -> Maybe Vector -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ RigidBodyState -> Maybe Vector
linearVelocity RigidBodyState
x,
        String -> Maybe Vector -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"angular_velocity" (Maybe Vector -> (Key, Value)) -> Maybe Vector -> (Key, Value)
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
$
    [((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
"sleeping" (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
"location" (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
"rotation" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Rotation.schema, Bool
True),
        ( String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"linear_velocity" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Vector.schema,
          Bool
False
        ),
        ( String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"angular_velocity" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
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 m a. Monoid m => (a -> m) -> Maybe a -> m
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 m a. Monoid m => (a -> m) -> Maybe a -> m
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 = String -> BitGet RigidBodyState -> BitGet RigidBodyState
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"RigidBodyState" (BitGet RigidBodyState -> BitGet RigidBodyState)
-> BitGet RigidBodyState -> BitGet RigidBodyState
forall a b. (a -> b) -> a -> b
$ do
  sleeping <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"sleeping" BitGet Bool
BitGet.bool
  location <- BitGet.label "location" $ Vector.bitGet version
  rotation <- BitGet.label "rotation" $ Rotation.bitGet version
  linearVelocity <-
    BitGet.label "linearVelocity" $
      Monad.whenMaybe (not sleeping) (Vector.bitGet version)
  angularVelocity <-
    BitGet.label "angularVelocity" $
      Monad.whenMaybe (not sleeping) (Vector.bitGet version)
  pure
    RigidBodyState
      { sleeping,
        location,
        rotation,
        linearVelocity,
        angularVelocity
      }