Codec/Audio/WavPack/Unpack.hs

   1 {-# LANGUAGE
   2     DoAndIfThenElse
   3   , FlexibleContexts
   4   , ScopedTypeVariables
   5   , UnicodeSyntax
   6   #-}
   7 module Codec.Audio.WavPack.Unpack
   8     ( WavpackStream(..)
   9     , unpackSamples
  10     )
  11     where
  12 import Codec.Audio.WavPack.Block
  13 import Codec.Audio.WavPack.Words
  14 import Control.Monad.ST
  15 import Data.Bits
  16 import Data.Bitstream.Generic (Bitstream)
  17 import Data.Int
  18 import Data.STRef
  19 import qualified Data.Strict as S
  20 import qualified Data.Vector.Generic.Mutable as MV
  21 import Data.Word
  22 import Prelude.Unicode
  23
  24 -- | FIXME
  25 data WavpackStream bs s
  26     = WavpackStream {
  27         wpsWVBlock     ∷ !Block
  28       , wpsWVCBlock    ∷ !(S.Maybe Block)
  29       , wpsWordsData   ∷ !(WordsData s)
  30       , wpsMuteError   ∷ !(STRef s Bool)
  31       , wpsSampleIndex ∷ !(STRef s Word32)
  32       , wpsWVBits      ∷ !(STRef s bs)
  33       , wpsWVCBits     ∷ !(S.Maybe (STRef s bs))
  34       }
  35
  36 -- |This monster actually unpacks the WavPack bitstream(s) into the
  37 -- specified buffer as 32-bit integers or floats (depending on orignal
  38 -- data). Lossy samples will be clipped to their original limits
  39 -- (i.e. 8-bit samples are clipped to -128/+127) but are still
  40 -- returned in longs. It is up to the caller to potentially reformat
  41 -- this for the final output including any multichannel distribution,
  42 -- block alignment or endian compensation.
  43 unpackSamples ∷ ∀bs v s. (Bitstream bs, MV.MVector v Int32)
  44               ⇒ WavpackStream bs s
  45               → Int    -- ^ Number of channels.
  46               → Int    -- ^ Reduced number of channels (1 or 2).
  47               → Word32 -- ^ Number of samples to get.
  48               → ST s (v s Int32)
  49 {-# INLINEABLE unpackSamples #-}
  50 unpackSamples wps numChannels reducedChannels nSamples0
  51     = do let hdr        = blockHeader $ wpsWVBlock wps
  52              flags      = bhFlags hdr
  53              muteLimit0 = (1 `shiftL` fromIntegral (bfMaxMagnitude flags)) + 2
  54              muteLimit ∷ Int32 -- FIXME: Do we really need to explicitly type this?
  55              muteLimit
  56                  | bfHybrid flags ∧ S.isNothing (wpsWVCBlock wps)
  57                      = muteLimit0 ⋅ 2
  58                  | otherwise
  59                      = muteLimit0
  60
  61          nSamples ← do idx ← readSTRef (wpsSampleIndex wps)
  62                        if idx + nSamples0 > bhBlockIndex hdr + bhBlockSamples hdr then
  63                            return $ bhBlockIndex hdr + bhBlockSamples hdr - idx
  64                        else
  65                            return nSamples0
  66
  67          muteError ← readSTRef (wpsMuteError wps)
  68          if muteError then
  69              do v ← if reducedChannels ≡ 1 ∨ numChannels ≡ 1 ∨ bfMono flags then
  70                         MV.replicate (fromIntegral nSamples) 0
  71                     else
  72                         MV.replicate (fromIntegral nSamples ⋅ 2) 0
  73                 modifySTRef (wpsSampleIndex wps) (+ nSamples)
  74                 return v
  75          else
  76              do v ← if S.isNothing (wpsWVCBlock wps) ∧ bfMono flags then
  77                        -- handle lossless or hybrid lossy mono data
  78                        fail "FIXME: unsupported stream type: monaural stream"
  79                     else
  80                        if S.isNothing (wpsWVCBlock wps) ∧ (¬) (bfMono flags) then
  81                            -- handle lossless or hybrid lossy stereo data
  82                            do v ← if bfHybrid flags then
  83                                        fail "FIXME: unsupported stream type: lossy stereo stream"
  84                                    else
  85                                        getWordsLossless
  86                                            (bfMono flags)
  87                                            (wpsWordsData wps)
  88                                            (wpsWVBits wps)
  89                                            nSamples
  90                               error "FIXME"
  91                               return v
  92                        else
  93                            error "FIXME"
  94                 error "FIXME"
  95                 return v