module Rattletrap.Encode.CompressedWord
  ( putCompressedWord
  )
where

import Rattletrap.Type.CompressedWord

import qualified Data.Binary.Bits.Put as BinaryBits
import qualified Data.Bits as Bits

putCompressedWord :: CompressedWord -> BinaryBits.BitPut ()
putCompressedWord :: CompressedWord -> BitPut ()
putCompressedWord CompressedWord
compressedWord =
  let
    limit :: Word
limit = CompressedWord -> Word
compressedWordLimit CompressedWord
compressedWord
    value :: Word
value = CompressedWord -> Word
compressedWordValue CompressedWord
compressedWord
    maxBits :: Int
maxBits = Word -> Int
getMaxBits Word
limit
  in Word -> Word -> Int -> Int -> Word -> BitPut ()
putCompressedWordStep Word
limit Word
value Int
maxBits Int
0 Word
0

putCompressedWordStep
  :: Word -> Word -> Int -> Int -> Word -> BinaryBits.BitPut ()
putCompressedWordStep :: Word -> Word -> Int -> Int -> Word -> BitPut ()
putCompressedWordStep Word
limit Word
value Int
maxBits Int
position Word
soFar =
  if Int
position Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxBits
    then do
      let x :: Word
x = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
Bits.shiftL Word
1 Int
position :: Word
      if Int
maxBits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Int
position Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Word
soFar 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 () -> BitPut ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else do
          let bit :: Bool
bit = Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word
value Int
position
          Bool -> BitPut ()
BinaryBits.putBool Bool
bit
          let delta :: Word
delta = if Bool
bit then Word
x else Word
0
          Word -> Word -> Int -> Int -> Word -> BitPut ()
putCompressedWordStep
            Word
limit
            Word
value
            Int
maxBits
            (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            (Word
soFar Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
delta)
    else () -> BitPut ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

getMaxBits :: Word -> Int
getMaxBits :: Word -> Int
getMaxBits Word
x =
  let
    n :: Int
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
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))))
  in 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 -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n