Codec/Audio/WavPack/Words.hs

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