module Rattletrap.Type.Attribute.CamSettings 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.Version as Version
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

data CamSettings = CamSettings
  { CamSettings -> F32
fov :: F32.F32
  , CamSettings -> F32
height :: F32.F32
  , CamSettings -> F32
angle :: F32.F32
  , CamSettings -> F32
distance :: F32.F32
  , CamSettings -> F32
stiffness :: F32.F32
  , CamSettings -> F32
swivelSpeed :: F32.F32
  , CamSettings -> Maybe F32
transitionSpeed :: Maybe F32.F32
  }
  deriving (CamSettings -> CamSettings -> Bool
(CamSettings -> CamSettings -> Bool)
-> (CamSettings -> CamSettings -> Bool) -> Eq CamSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CamSettings -> CamSettings -> Bool
$c/= :: CamSettings -> CamSettings -> Bool
== :: CamSettings -> CamSettings -> Bool
$c== :: CamSettings -> CamSettings -> Bool
Eq, Int -> CamSettings -> ShowS
[CamSettings] -> ShowS
CamSettings -> String
(Int -> CamSettings -> ShowS)
-> (CamSettings -> String)
-> ([CamSettings] -> ShowS)
-> Show CamSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CamSettings] -> ShowS
$cshowList :: [CamSettings] -> ShowS
show :: CamSettings -> String
$cshow :: CamSettings -> String
showsPrec :: Int -> CamSettings -> ShowS
$cshowsPrec :: Int -> CamSettings -> ShowS
Show)

instance Json.FromJSON CamSettings where
  parseJSON :: Value -> Parser CamSettings
parseJSON = String
-> (Object -> Parser CamSettings) -> Value -> Parser CamSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"CamSettings" ((Object -> Parser CamSettings) -> Value -> Parser CamSettings)
-> (Object -> Parser CamSettings) -> Value -> Parser CamSettings
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    F32
fov <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"fov"
    F32
height <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"height"
    F32
angle <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"angle"
    F32
distance <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"distance"
    F32
stiffness <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stiffness"
    F32
swivelSpeed <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"swivel_speed"
    Maybe F32
transitionSpeed <- Object -> String -> Parser (Maybe F32)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"transition_speed"
    CamSettings -> Parser CamSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure CamSettings :: F32 -> F32 -> F32 -> F32 -> F32 -> F32 -> Maybe F32 -> CamSettings
CamSettings
      { F32
fov :: F32
fov :: F32
fov
      , F32
height :: F32
height :: F32
height
      , F32
angle :: F32
angle :: F32
angle
      , F32
distance :: F32
distance :: F32
distance
      , F32
stiffness :: F32
stiffness :: F32
stiffness
      , F32
swivelSpeed :: F32
swivelSpeed :: F32
swivelSpeed
      , Maybe F32
transitionSpeed :: Maybe F32
transitionSpeed :: Maybe F32
transitionSpeed
      }

instance Json.ToJSON CamSettings where
  toJSON :: CamSettings -> Value
toJSON CamSettings
x = [Pair] -> Value
Json.object
    [ String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"fov" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
fov CamSettings
x
    , String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"height" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
height CamSettings
x
    , String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angle" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
angle CamSettings
x
    , String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"distance" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
distance CamSettings
x
    , String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stiffness" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
stiffness CamSettings
x
    , String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"swivel_speed" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
swivelSpeed CamSettings
x
    , String -> Maybe F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"transition_speed" (Maybe F32 -> Pair) -> Maybe F32 -> Pair
forall a b. (a -> b) -> a -> b
$ CamSettings -> Maybe F32
transitionSpeed CamSettings
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-cam-settings" (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
"fov" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"height" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angle" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"distance" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stiffness" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"swivel_speed" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True)
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"transition_speed" (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
F32.schema
    , Bool
False
    )
  ]

bitPut :: CamSettings -> BitPut.BitPut
bitPut :: CamSettings -> BitPut
bitPut CamSettings
camSettingsAttribute =
  F32 -> BitPut
F32.bitPut (CamSettings -> F32
fov CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
height CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
angle CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
distance CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
stiffness CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
swivelSpeed CamSettings
camSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (F32 -> BitPut) -> Maybe F32 -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap F32 -> BitPut
F32.bitPut (CamSettings -> Maybe F32
transitionSpeed CamSettings
camSettingsAttribute)

bitGet :: Version.Version -> BitGet.BitGet CamSettings
bitGet :: Version -> BitGet CamSettings
bitGet Version
version = String -> BitGet CamSettings -> BitGet CamSettings
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"CamSettings" (BitGet CamSettings -> BitGet CamSettings)
-> BitGet CamSettings -> BitGet CamSettings
forall a b. (a -> b) -> a -> b
$ do
  F32
fov <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"fov" BitGet F32
F32.bitGet
  F32
height <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"height" BitGet F32
F32.bitGet
  F32
angle <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"angle" BitGet F32
F32.bitGet
  F32
distance <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"distance" BitGet F32
F32.bitGet
  F32
stiffness <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"stiffness" BitGet F32
F32.bitGet
  F32
swivelSpeed <- String -> BitGet F32 -> BitGet F32
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"swivelSpeed" BitGet F32
F32.bitGet
  Maybe F32
transitionSpeed <- String -> BitGet (Maybe F32) -> BitGet (Maybe F32)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"transitionSpeed"
    (BitGet (Maybe F32) -> BitGet (Maybe F32))
-> BitGet (Maybe F32) -> BitGet (Maybe F32)
forall a b. (a -> b) -> a -> b
$ Bool -> BitGet F32 -> BitGet (Maybe F32)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
20 Int
0 Version
version) BitGet F32
F32.bitGet
  CamSettings -> BitGet CamSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure CamSettings :: F32 -> F32 -> F32 -> F32 -> F32 -> F32 -> Maybe F32 -> CamSettings
CamSettings
    { F32
fov :: F32
fov :: F32
fov
    , F32
height :: F32
height :: F32
height
    , F32
angle :: F32
angle :: F32
angle
    , F32
distance :: F32
distance :: F32
distance
    , F32
stiffness :: F32
stiffness :: F32
stiffness
    , F32
swivelSpeed :: F32
swivelSpeed :: F32
swivelSpeed
    , Maybe F32
transitionSpeed :: Maybe F32
transitionSpeed :: Maybe F32
transitionSpeed
    }