module Rattletrap.Decode.CompressedWord
  ( decodeCompressedWordBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Type.CompressedWord

import qualified Data.Bits as Bits

decodeCompressedWordBits :: Word -> DecodeBits CompressedWord
decodeCompressedWordBits :: Word -> DecodeBits CompressedWord
decodeCompressedWordBits Word
limit =
  Word -> Word -> CompressedWord
CompressedWord Word
limit (Word -> CompressedWord)
-> BitGet Word -> DecodeBits CompressedWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Word -> Word -> Word -> BitGet Word
step Word
limit (Word -> Word
getMaxBits Word
limit) Word
0 Word
0

getMaxBits :: Word -> Word
getMaxBits :: Word -> Word
getMaxBits Word
x = do
  let
    n :: Word
    n :: Word
n = Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 (Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
2 :: Double) (Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
1 Word
x))))
  if Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
1024 Bool -> Bool -> Bool
&& Word
x Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Word
n then Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 else Word
n

step :: Word -> Word -> Word -> Word -> DecodeBits Word
step :: Word -> Word -> Word -> Word -> BitGet Word
step Word
limit Word
maxBits Word
position Word
value = do
  let x :: Word
x = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
Bits.shiftL Word
1 (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
position) :: Word
  if Word
position Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
maxBits Bool -> Bool -> Bool
&& Word
value Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
limit
    then do
      Bool
bit <- BitGet Bool
getBool
      let newValue :: Word
newValue = if Bool
bit then Word
value Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
x else Word
value
      Word -> Word -> Word -> Word -> BitGet Word
step Word
limit Word
maxBits (Word
position Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) Word
newValue
    else Word -> BitGet Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
value