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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"CamSettings" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    F32
fov <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"fov"
    F32
height <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"height"
    F32
angle <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"angle"
    F32
distance <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"distance"
    F32
stiffness <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stiffness"
    F32
swivelSpeed <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"swivel_speed"
    Maybe F32
transitionSpeed <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"transition_speed"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      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 =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"fov" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
fov CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"height" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
height CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angle" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
angle CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"distance" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
distance CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stiffness" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
stiffness CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"swivel_speed" forall a b. (a -> b) -> a -> b
$ CamSettings -> F32
swivelSpeed CamSettings
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"transition_speed" 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" 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
"fov" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"height" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"angle" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"distance" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stiffness" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"swivel_speed" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"transition_speed" 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
F32.schema,
          Bool
False
        )
      ]

bitPut :: CamSettings -> BitPut.BitPut
bitPut :: CamSettings -> BitPut
bitPut CamSettings
camSettingsAttribute =
  F32 -> BitPut
F32.bitPut (CamSettings -> F32
fov CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
height CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
angle CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
distance CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
stiffness CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (CamSettings -> F32
swivelSpeed CamSettings
camSettingsAttribute)
    forall a. Semigroup a => a -> a -> a
<> 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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"CamSettings" forall a b. (a -> b) -> a -> b
$ do
  F32
fov <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"fov" BitGet F32
F32.bitGet
  F32
height <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"height" BitGet F32
F32.bitGet
  F32
angle <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"angle" BitGet F32
F32.bitGet
  F32
distance <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"distance" BitGet F32
F32.bitGet
  F32
stiffness <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"stiffness" BitGet F32
F32.bitGet
  F32
swivelSpeed <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"swivelSpeed" BitGet F32
F32.bitGet
  Maybe F32
transitionSpeed <-
    forall a. String -> BitGet a -> BitGet a
BitGet.label String
"transitionSpeed" forall a b. (a -> b) -> a -> b
$
      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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    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
      }