module Rattletrap.Type.Keyframe where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.F32 as F32
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

data Keyframe = Keyframe
  { Keyframe -> F32
time :: F32.F32
  -- ^ When this key frame occurs, in seconds.
  , Keyframe -> U32
frame :: U32.U32
  -- ^ The frame number of this key frame, starting from 0.
  , Keyframe -> U32
position :: U32.U32
  -- ^ The bit position of this key frame in the stream.
  }
  deriving (Keyframe -> Keyframe -> Bool
(Keyframe -> Keyframe -> Bool)
-> (Keyframe -> Keyframe -> Bool) -> Eq Keyframe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keyframe -> Keyframe -> Bool
$c/= :: Keyframe -> Keyframe -> Bool
== :: Keyframe -> Keyframe -> Bool
$c== :: Keyframe -> Keyframe -> Bool
Eq, Int -> Keyframe -> ShowS
[Keyframe] -> ShowS
Keyframe -> String
(Int -> Keyframe -> ShowS)
-> (Keyframe -> String) -> ([Keyframe] -> ShowS) -> Show Keyframe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Keyframe] -> ShowS
$cshowList :: [Keyframe] -> ShowS
show :: Keyframe -> String
$cshow :: Keyframe -> String
showsPrec :: Int -> Keyframe -> ShowS
$cshowsPrec :: Int -> Keyframe -> ShowS
Show)

instance Json.FromJSON Keyframe where
  parseJSON :: Value -> Parser Keyframe
parseJSON = String -> (Object -> Parser Keyframe) -> Value -> Parser Keyframe
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Keyframe" ((Object -> Parser Keyframe) -> Value -> Parser Keyframe)
-> (Object -> Parser Keyframe) -> Value -> Parser Keyframe
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    F32
time <- Object -> String -> Parser F32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"time"
    U32
frame <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"frame"
    U32
position <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"position"
    Keyframe -> Parser Keyframe
forall (f :: * -> *) a. Applicative f => a -> f a
pure Keyframe :: F32 -> U32 -> U32 -> Keyframe
Keyframe { F32
time :: F32
time :: F32
time, U32
frame :: U32
frame :: U32
frame, U32
position :: U32
position :: U32
position }

instance Json.ToJSON Keyframe where
  toJSON :: Keyframe -> Value
toJSON Keyframe
x = [Pair] -> Value
Json.object
    [ String -> F32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"time" (F32 -> Pair) -> F32 -> Pair
forall a b. (a -> b) -> a -> b
$ Keyframe -> F32
time Keyframe
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frame" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Keyframe -> U32
frame Keyframe
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"position" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Keyframe -> U32
position Keyframe
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"keyframe" (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
"time" (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
"frame" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"position" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  ]

bytePut :: Keyframe -> BytePut.BytePut
bytePut :: Keyframe -> BytePut
bytePut Keyframe
x =
  F32 -> BytePut
F32.bytePut (Keyframe -> F32
time Keyframe
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Keyframe -> U32
frame Keyframe
x) BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Keyframe -> U32
position Keyframe
x)

byteGet :: ByteGet.ByteGet Keyframe
byteGet :: ByteGet Keyframe
byteGet = String -> ByteGet Keyframe -> ByteGet Keyframe
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Keyframe" (ByteGet Keyframe -> ByteGet Keyframe)
-> ByteGet Keyframe -> ByteGet Keyframe
forall a b. (a -> b) -> a -> b
$ do
  F32
time <- String -> ByteGet F32 -> ByteGet F32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"time" ByteGet F32
F32.byteGet
  U32
frame <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"frame" ByteGet U32
U32.byteGet
  U32
position <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"position" ByteGet U32
U32.byteGet
  Keyframe -> ByteGet Keyframe
forall (f :: * -> *) a. Applicative f => a -> f a
pure Keyframe :: F32 -> U32 -> U32 -> Keyframe
Keyframe { F32
time :: F32
time :: F32
time, U32
frame :: U32
frame :: U32
frame, U32
position :: U32
position :: U32
position }