module Rattletrap.Decode.DemolishAttribute
  ( decodeDemolishAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Vector
import Rattletrap.Decode.Word32le
import Rattletrap.Type.DemolishAttribute

decodeDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits DemolishAttribute
decodeDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits DemolishAttribute
decodeDemolishAttributeBits (Int, Int, Int)
version =
  Bool
-> Word32le
-> Bool
-> Word32le
-> Vector
-> Vector
-> DemolishAttribute
DemolishAttribute
    (Bool
 -> Word32le
 -> Bool
 -> Word32le
 -> Vector
 -> Vector
 -> DemolishAttribute)
-> BitGet Bool
-> BitGet
     (Word32le
      -> Bool -> Word32le -> Vector -> Vector -> DemolishAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Bool
getBool
    BitGet
  (Word32le
   -> Bool -> Word32le -> Vector -> Vector -> DemolishAttribute)
-> BitGet Word32le
-> BitGet
     (Bool -> Word32le -> Vector -> Vector -> DemolishAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Word32le
decodeWord32leBits
    BitGet (Bool -> Word32le -> Vector -> Vector -> DemolishAttribute)
-> BitGet Bool
-> BitGet (Word32le -> Vector -> Vector -> DemolishAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Bool
getBool
    BitGet (Word32le -> Vector -> Vector -> DemolishAttribute)
-> BitGet Word32le
-> BitGet (Vector -> Vector -> DemolishAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Word32le
decodeWord32leBits
    BitGet (Vector -> Vector -> DemolishAttribute)
-> BitGet Vector -> BitGet (Vector -> DemolishAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet Vector
decodeVectorBits (Int, Int, Int)
version
    BitGet (Vector -> DemolishAttribute)
-> BitGet Vector -> DecodeBits DemolishAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet Vector
decodeVectorBits (Int, Int, Int)
version