module Rattletrap.Decode.ExplosionAttribute
  ( decodeExplosionAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Int32le
import Rattletrap.Decode.Vector
import Rattletrap.Type.ExplosionAttribute

decodeExplosionAttributeBits
  :: (Int, Int, Int) -> DecodeBits ExplosionAttribute
decodeExplosionAttributeBits :: (Int, Int, Int) -> DecodeBits ExplosionAttribute
decodeExplosionAttributeBits (Int, Int, Int)
version =
  Bool -> Int32le -> Vector -> ExplosionAttribute
ExplosionAttribute
    (Bool -> Int32le -> Vector -> ExplosionAttribute)
-> BitGet Bool -> BitGet (Int32le -> Vector -> ExplosionAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Bool
getBool
    BitGet (Int32le -> Vector -> ExplosionAttribute)
-> BitGet Int32le -> BitGet (Vector -> ExplosionAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Int32le
decodeInt32leBits
    BitGet (Vector -> ExplosionAttribute)
-> BitGet Vector -> DecodeBits ExplosionAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet Vector
decodeVectorBits (Int, Int, Int)
version