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 qualified Data.Vector.Generic.Mutable as MV
  21 import Data.Vector.Generic.New (New)
  22 import qualified Data.Vector.Generic.New as New
  23 import Data.Word
  24 import Prelude.Unicode
  25
  26 -- | FIXME
  27 data WordsData
  28     = WordsData {
  29         wdBitrateDelta ∷ !(Word32, Word32)
  30       , wdBitrateAcc   ∷ !(Word32, Word32)
  31       , wdPendingData  ∷ !Word32
  32       , wdHoldingOne   ∷ !Word32
  33       , wdZeroesAcc    ∷ !Word32
  34       , wdHoldingZero  ∷ !Bool
  35       , wdPendingCount ∷ !Int
  36       , wdEntropyData  ∷ !(EntropyData, EntropyData)
  37       }
  38     deriving (Eq, Show)
  39
  40 -- | This is an optimized version of 'getWord' that is used for
  41 -- lossless only ('edErrorLimit' ≡ 0). Also, rather than obtaining a
  42 -- single sample, it can be used to obtain an entire buffer of either
  43 -- mono or stereo samples.
  44 getWordsLossless ∷ ∀bs n v. (Bitstream bs, Integral n, GV.Vector v Int32)
  45                  ⇒ Bool -- ^ Is the stream monaural?
  46                  → WordsData
  47                  → bs -- ^ WV bitstream.
  48                  → n  -- ^ Number of samples to get.
  49                  → (# WordsData, bs, v Int32 #)
  50 {-# INLINEABLE getWordsLossless #-}
  51 getWordsLossless isMono w0 bs0 nSamples0
  52     = let v0  = New.create $ MV.new $ fromIntegral nSamples
  53           (# w1, bs1, n1, v1 #)
  54               = go w0 bs0 0 v0
  55           v2  = GV.new $ New.take (fromIntegral n1) v1
  56       in
  57         (# w1, bs1, v2 #)
  58     where
  59       nSamples ∷ n
  60       {-# INLINE nSamples #-}
  61       nSamples = if isMono
  62                  then nSamples0
  63                  else nSamples0 ⋅ 2
  64
  65       go ∷ WordsData
  66          → bs
  67          → n
  68          → New v Int32
  69          → (# WordsData, bs, n, New v Int32 #)
  70       {-# INLINE go #-}
  71       go w bs n v
  72           | n ≥ nSamples = (# w, bs, n, v #)
  73           | otherwise
  74               = error "FIXME"
  75           where
  76             c ∷ EntropyData
  77             c | n `rem` 2 ≡ 0 = fst $ wdEntropyData w
  78               | otherwise     = snd $ wdEntropyData w
  79
  80 -- | Read a single unsigned value from the specified bitstream with a
  81 -- value from 0 to maxCode. If there are exactly a power of two number
  82 -- of possible codes then this will read a fixed number of bits;
  83 -- otherwise it reads the minimum number of bits and then determines
  84 -- whether another bit is needed to define the code.
  85 readCode ∷ Bitstream bs ⇒ bs → Word32 → (# Word32, bs #)
  86 {-# INLINEABLE readCode #-}
  87 readCode bs 0       = (# 0, bs #)
  88 readCode bs 1       = (# b2n (B.head bs), B.tail bs #)
  89 readCode bs maxCode
  90     = let !bitCount = countBits maxCode
  91           !extras   = bit bitCount - maxCode - 1
  92           !code     = B.toBits (B.take (bitCount - 1) bs)
  93           (# code', bitCount' #)
  94                     = if code ≥ extras then
  95                           (# (code `shiftL` 1)
  96                              - extras
  97                              + b2n (bs B.!! bitCount)
  98                            , bitCount #)
  99                       else
 100                           (# code, bitCount - 1 #)
 101           !bs'      = B.drop bitCount' bs
 102       in
 103         (# code', bs' #)