Codec/Audio/WavPack/Words.hs

   1 {-# LANGUAGE
   2     BangPatterns
   3   , UnboxedTuples
   4   , UnicodeSyntax
   5   #-}
   6 -- | FIXME
   7 module Codec.Audio.WavPack.Words
   8     ( WordsData(..)
   9     )
  10     where
  11 import Codec.Audio.WavPack.Entropy
  12 import Codec.Audio.WavPack.Internal
  13 import Data.Bits
  14 import Data.Bitstream.Generic (Bitstream)
  15 import qualified Data.Bitstream.Generic as B
  16 import Data.Word
  17 import Prelude.Unicode
  18
  19 -- | FIXME
  20 data WordsData
  21     = WordsData {
  22         wdBitrateDelta ∷ !(Word32, Word32)
  23       , wdBitrateAcc   ∷ !(Word32, Word32)
  24       , wdPendingData  ∷ !Word32
  25       , wdHoldingOne   ∷ !Word32
  26       , wdZeroesAcc    ∷ !Word32
  27       , wdHoldingZero  ∷ !Bool
  28       , wdPendingCount ∷ !Int
  29       , wdEntropyData  ∷ !(EntropyData, EntropyData)
  30       }
  31     deriving (Eq, Show)
  32
  33 -- This is an optimized version of 'getWord' that is used for lossless
  34 -- only (error_limit ≡ 0). Also, rather than obtaining a single
  35 -- sample, it can be used to obtain an entire buffer of either mono or
  36 -- stereo samples.
  37 --getWordsLossless ∷
  38
  39 -- Read a single unsigned value from the specified bitstream with a
  40 -- value from 0 to maxCode. If there are exactly a power of two number
  41 -- of possible codes then this will read a fixed number of bits;
  42 -- otherwise it reads the minimum number of bits and then determines
  43 -- whether another bit is needed to define the code.
  44 readCode ∷ Bitstream bs ⇒ bs → Word32 → (# Word32, bs #)
  45 {-# INLINEABLE readCode #-}
  46 readCode bs 0       = (# 0, bs #)
  47 readCode bs 1       = (# b2n (B.head bs), B.tail bs #)
  48 readCode bs maxCode
  49     = let !bitCount = countBits maxCode
  50           !extras   = bit bitCount - maxCode - 1
  51           !code     = B.toBits (B.take (bitCount - 1) bs)
  52           (# code', bitCount' #)
  53                     = if code ≥ extras then
  54                           (# (code `shiftL` 1)
  55                              - extras
  56                              + b2n (bs B.!! bitCount)
  57                            , bitCount #)
  58                       else
  59                           (# code, bitCount - 1 #)
  60           !bs'      = B.drop bitCount' bs
  61       in
  62         (# code', bs' #)