Codec/Audio/WavPack/Block.hs

   1 {-# LANGUAGE
   2     UnicodeSyntax
   3   #-}
   4 -- | Data types for WavPack codec.
   5 module Codec.Audio.WavPack.Block
   6     ( BlockHeader(..)
   7     , BlockFlags(..)
   8     )
   9     where
  10 import Data.Binary
  11 import Data.Binary.BitPut (putBit, putNBits, runBitPut)
  12 import Data.Binary.Get
  13 import Data.Binary.Put
  14 import qualified Data.Binary.Strict.BitGet as BG
  15 import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
  16 import qualified Data.ByteString as S
  17 import qualified Data.ByteString.Lazy as L
  18
  19 -- | The preamble to every block in both the .wv and .wvc files.
  20 data BlockHeader
  21     = BlockHeader {
  22       -- | size of entire block (minus 8, of course)
  23         bhSize         ∷ !Word32
  24       -- | 0x402 to 0x410 are currently valid for decode
  25       , bhVersion      ∷ !Word16
  26       -- | track number (0 if not used, like now)
  27       , bhTrackNo      ∷ !Word8
  28       -- | track sub-index (0 if not used, like now)
  29       , bhIndexNo      ∷ !Word8
  30       -- | total samples for entire file, but this is only valid if
  31       --   'bhBlockIndex' == 0 and a value of -1 indicates unknown
  32       --   length
  33       , bhTotalSamples ∷ !Word32
  34       -- | index of first sample in block relative to beginning of
  35       --   file (normally this would start at 0 for the first block)
  36       , bhBlockIndex   ∷ !Word32
  37       -- | number of samples in this block (0 = no audio)
  38       , bhBlockSamples ∷ !Word32
  39       -- | various flags for id and decoding
  40       , bhFlags        ∷ !BlockHeader
  41       -- | crc for actual decoded data
  42       , bhCRC          ∷ !Word32
  43       }
  44     deriving (Show, Eq)
  45
  46 instance Binary BlockHeader where
  47     put bh
  48         = do putWord8 119 -- 'w'
  49              putWord8 118 -- 'v'
  50              putWord8 112 -- 'p'
  51              putWord8 107 -- 'k'
  52              putWord32le $ bhSize         bh
  53              putWord16le $ bhVersion      bh
  54              putWord8    $ bhTrackNo      bh
  55              putWord8    $ bhIndexNo      bh
  56              putWord32le $ bhTotalSamples bh
  57              putWord32le $ bhBlockIndex   bh
  58              putWord32le $ bhBlockSamples bh
  59              put         $ bhFlags        bh
  60              putWord32le $ bhCRC          bh
  61
  62     get = do skip 4 -- "wvpk"
  63              size         ← getWord32le
  64              version      ← getWord16le
  65              trackNo      ← getWord8
  66              indexNo      ← getWord8
  67              totalSamples ← getWord32le
  68              blockIndex   ← getWord32le
  69              blockSamples ← getWord32le
  70              flags        ← get
  71              crc          ← getWord32le
  72              return BlockHeader {
  73                               bhSize         = size
  74                             , bhVersion      = version
  75                             , bhTrackNo      = trackNo
  76                             , bhIndexNo      = indexNo
  77                             , bhTotalSamples = totalSamples
  78                             , bhBlockIndex   = blockIndex
  79                             , bhBlockSamples = blockSamples
  80                             , bhFlags        = flags
  81                             , bhCRC          = crc
  82                             }
  83
  84 -- | Various flags for decoding blocks
  85 data BlockFlags
  86     = BlockFlags {
  87       -- | 1 <= n <= 4
  88         bfBytesPerSample ∷ !Word8
  89       -- | 'False' = stereo output; 'True' = mono output
  90       , bfMono           ∷ !Bool
  91       -- | 'False' = lossless mode; 'True' = hybrid mode
  92       , bfHybrid         ∷ !Bool
  93       -- | 'False' = true stereo; 'True' = joint stereo (mid/side)
  94       , bfJointStereo    ∷ !Bool
  95       -- | 'False' = independent channels; 'True' = cross-channel
  96       --   decorrelation
  97       , bfCrossDecorr    ∷ !Bool
  98       -- | 'False' = flat noise spectrum in hybrid; 'True' = hybrid
  99       --   noise shaping
 100       , bfHybridShape    ∷ !Bool
 101       -- | 'False' = integer data; 'True' = floating point data
 102       , bfFloatData      ∷ !Bool
 103       -- | 'True' = extended size integers (> 24-bit); 'False' =
 104       --   shifted integers
 105       , bfExtendedInt    ∷ !Bool
 106       -- | 'False' = hybrid mode parameters control noise level;
 107       --   'True' = hybrid mode parameters control bitrate
 108       , bfHybridBitrate  ∷ !Bool
 109       -- | 'True' = hybrid noise balanced between channels
 110       , bfHybridBalance  ∷ !Bool
 111       -- | 'True' = initial block in sequence (for multichannel)
 112       , bfInitialBlock   ∷ !Bool
 113       -- | 'True' = final block in sequence (for multichannel)
 114       , bfFinalBlock     ∷ !Bool
 115       -- | amount of data left-shift after decode (0-31 places)
 116       , bfLeftShift      ∷ !Word8
 117       -- | maximum magnitude of decoded data (number of bits integers
 118       --   require minus 1)
 119       , bfMaxMagnitude   ∷ !Word8
 120       -- | sampling rate (0x1111 = unknown/custom) (THINKME)
 121       , bfSamplingRate   ∷ !Word8
 122       -- | 'True' = use IIR for negative hybrid noise shaping
 123       , bfIIRShaping     ∷ !Bool
 124       -- | 'True' = false stereo (data is mono but output is stereo)
 125       , bfFalseStereo    ∷ !Bool
 126       }
 127     deriving (Show, Eq)
 128
 129 instance Binary BlockFlags where
 130     put bf
 131         = let bs = runBitPut $
 132                    do putBit False -- reserved
 133                       putBit $ bfFalseStereo bf
 134                       putBit $ bfIIRShaping  bf
 135                       putNBits 2 (0 ∷ Word8) -- reserved
 136                       putNBits 4 $ bfSamplingRate bf
 137                       putNBits 5 $ bfMaxMagnitude bf
 138                       putNBits 5 $ bfLeftShift    bf
 139                       putBit $ bfFinalBlock    bf
 140                       putBit $ bfInitialBlock  bf
 141                       putBit $ bfFinalBlock    bf
 142                       putBit $ bfHybridBalance bf
 143                       putBit $ bfHybridBitrate bf
 144                       putBit $ bfExtendedInt   bf
 145                       putBit $ bfFloatData     bf
 146                       putBit $ bfHybridShape   bf
 147                       putBit $ bfCrossDecorr   bf
 148                       putBit $ bfJointStereo   bf
 149                       putBit $ bfHybrid        bf
 150                       putBit $ bfMono          bf
 151                       putNBits 2 $ bfBytesPerSample bf - 1
 152           in
 153             putLazyByteString (L.reverse bs)
 154
 155     get = do bs ← getBytes 4
 156              let Right bf
 157                      = runBitGet (S.reverse bs) $
 158                        do BG.skip 1 -- reserved
 159                           falseStereo    ← getBit
 160                           iirShaping     ← getBit
 161                           BG.skip 2 -- reserved
 162                           samplingRate   ← getAsWord8 4
 163                           maxMagnitude   ← getAsWord8 5
 164                           leftShift      ← getAsWord8 5
 165                           finalBlock     ← getBit
 166                           initialBlock   ← getBit
 167                           hybridBalance  ← getBit
 168                           hybridBitrate  ← getBit
 169                           extendedInt    ← getBit
 170                           floatData      ← getBit
 171                           hybridShape    ← getBit
 172                           crossDecorr    ← getBit
 173                           jointStereo    ← getBit
 174                           hybrid         ← getBit
 175                           mono           ← getBit
 176                           bytesPerSample ← getAsWord8 2
 177                           return BlockFlags {
 178                                        bfBytesPerSample = bytesPerSample + 1
 179                                      , bfMono           = mono
 180                                      , bfHybrid         = hybrid
 181                                      , bfJointStereo    = jointStereo
 182                                      , bfCrossDecorr    = crossDecorr
 183                                      , bfHybridShape    = hybridShape
 184                                      , bfFloatData      = floatData
 185                                      , bfExtendedInt    = extendedInt
 186                                      , bfHybridBitrate  = hybridBitrate
 187                                      , bfHybridBalance  = hybridBalance
 188                                      , bfInitialBlock   = initialBlock
 189                                      , bfFinalBlock     = finalBlock
 190                                      , bfLeftShift      = leftShift
 191                                      , bfMaxMagnitude   = maxMagnitude
 192                                      , bfSamplingRate   = samplingRate
 193                                      , bfIIRShaping     = iirShaping
 194                                      , bfFalseStereo    = falseStereo
 195                                      }
 196              return bf