module Rattletrap.Decode.KeyFrame
  ( decodeKeyFrame
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Float32le
import Rattletrap.Decode.Word32le
import Rattletrap.Type.KeyFrame

decodeKeyFrame :: Decode KeyFrame
decodeKeyFrame :: Decode KeyFrame
decodeKeyFrame =
  Float32le -> Word32le -> Word32le -> KeyFrame
KeyFrame (Float32le -> Word32le -> Word32le -> KeyFrame)
-> Get Float32le -> Get (Word32le -> Word32le -> KeyFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float32le
decodeFloat32le Get (Word32le -> Word32le -> KeyFrame)
-> Get Word32le -> Get (Word32le -> KeyFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32le
decodeWord32le Get (Word32le -> KeyFrame) -> Get Word32le -> Decode KeyFrame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32le
decodeWord32le