module Rattletrap.Decode.GameModeAttribute
  ( decodeGameModeAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Type.GameModeAttribute

decodeGameModeAttributeBits :: (Int, Int, Int) -> DecodeBits GameModeAttribute
decodeGameModeAttributeBits :: (Int, Int, Int) -> DecodeBits GameModeAttribute
decodeGameModeAttributeBits (Int, Int, Int)
version =
  Int -> Word8 -> GameModeAttribute
GameModeAttribute (Int -> Word8 -> GameModeAttribute)
-> BitGet Int -> BitGet (Word8 -> GameModeAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Int, Int) -> Int
numBits (Int, Int, Int)
version) BitGet (Word8 -> GameModeAttribute)
-> BitGet Word8 -> DecodeBits GameModeAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> BitGet Word8
getWord8Bits
    ((Int, Int, Int) -> Int
numBits (Int, Int, Int)
version)

numBits :: (Int, Int, Int) -> Int
numBits :: (Int, Int, Int) -> Int
numBits (Int, Int, Int)
version = if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
12, Int
0) then Int
8 else Int
2