+++ /dev/null
-{-# LANGUAGE
- UnicodeSyntax
- #-}
--- | Data types for WavPack codec.
-module Codec.Audio.WavPack.Types
- ( BlockHeader(..)
- , BlockFlags(..)
- )
- where
-import Data.Binary
-import Data.Binary.BitPut (putBit, putNBits, runBitPut)
-import Data.Binary.Get
-import Data.Binary.Put
-import qualified Data.Binary.Strict.BitGet as BG
-import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-
--- | The preamble to every block in both the .wv and .wvc files.
-data BlockHeader
- = BlockHeader {
- -- | size of entire block (minus 8, of course)
- bhSize ∷ !Word32
- -- | 0x402 to 0x410 are currently valid for decode
- , bhVersion ∷ !Word16
- -- | track number (0 if not used, like now)
- , bhTrackNo ∷ !Word8
- -- | track sub-index (0 if not used, like now)
- , bhIndexNo ∷ !Word8
- -- | total samples for entire file, but this is only valid if
- -- 'bhBlockIndex' == 0 and a value of -1 indicates unknown
- -- length
- , bhTotalSamples ∷ !Word32
- -- | index of first sample in block relative to beginning of
- -- file (normally this would start at 0 for the first block)
- , bhBlockIndex ∷ !Word32
- -- | number of samples in this block (0 = no audio)
- , bhBlockSamples ∷ !Word32
- -- | various flags for id and decoding
- , bhFlags ∷ !BlockHeader
- -- | crc for actual decoded data
- , bhCRC ∷ !Word32
- }
- deriving (Show, Eq)
-
-instance Binary BlockHeader where
- put bh
- = do putWord8 119 -- 'w'
- putWord8 118 -- 'v'
- putWord8 112 -- 'p'
- putWord8 107 -- 'k'
- putWord32le $ bhSize bh
- putWord16le $ bhVersion bh
- putWord8 $ bhTrackNo bh
- putWord8 $ bhIndexNo bh
- putWord32le $ bhTotalSamples bh
- putWord32le $ bhBlockIndex bh
- putWord32le $ bhBlockSamples bh
- put $ bhFlags bh
- putWord32le $ bhCRC bh
-
- get = do skip 4 -- "wvpk"
- size ← getWord32le
- version ← getWord16le
- trackNo ← getWord8
- indexNo ← getWord8
- totalSamples ← getWord32le
- blockIndex ← getWord32le
- blockSamples ← getWord32le
- flags ← get
- crc ← getWord32le
- return BlockHeader {
- bhSize = size
- , bhVersion = version
- , bhTrackNo = trackNo
- , bhIndexNo = indexNo
- , bhTotalSamples = totalSamples
- , bhBlockIndex = blockIndex
- , bhBlockSamples = blockSamples
- , bhFlags = flags
- , bhCRC = crc
- }
-
--- | Various flags for decoding blocks
-data BlockFlags
- = BlockFlags {
- -- | 1 <= n <= 4
- bfBytesPerSample ∷ !Word8
- -- | 'False' = stereo output; 'True' = mono output
- , bfMono ∷ !Bool
- -- | 'False' = lossless mode; 'True' = hybrid mode
- , bfHybrid ∷ !Bool
- -- | 'False' = true stereo; 'True' = joint stereo (mid/side)
- , bfJointStereo ∷ !Bool
- -- | 'False' = independent channels; 'True' = cross-channel
- -- decorrelation
- , bfCrossDecorr ∷ !Bool
- -- | 'False' = flat noise spectrum in hybrid; 'True' = hybrid
- -- noise shaping
- , bfHybridShape ∷ !Bool
- -- | 'False' = integer data; 'True' = floating point data
- , bfFloatData ∷ !Bool
- -- | 'True' = extended size integers (> 24-bit); 'False' =
- -- shifted integers
- , bfExtendedInt ∷ !Bool
- -- | 'False' = hybrid mode parameters control noise level;
- -- 'True' = hybrid mode parameters control bitrate
- , bfHybridBitrate ∷ !Bool
- -- | 'True' = hybrid noise balanced between channels
- , bfHybridBalance ∷ !Bool
- -- | 'True' = initial block in sequence (for multichannel)
- , bfInitialBlock ∷ !Bool
- -- | 'True' = final block in sequence (for multichannel)
- , bfFinalBlock ∷ !Bool
- -- | amount of data left-shift after decode (0-31 places)
- , bfLeftShift ∷ !Word8
- -- | maximum magnitude of decoded data (number of bits integers
- -- require minus 1)
- , bfMaxMagnitude ∷ !Word8
- -- | sampling rate (0x1111 = unknown/custom) (THINKME)
- , bfSamplingRate ∷ !Word8
- -- | 'True' = use IIR for negative hybrid noise shaping
- , bfIIRShaping ∷ !Bool
- -- | 'True' = false stereo (data is mono but output is stereo)
- , bfFalseStereo ∷ !Bool
- }
- deriving (Show, Eq)
-
-instance Binary BlockFlags where
- put bf
- = let bs = runBitPut $
- do putBit False -- reserved
- putBit $ bfFalseStereo bf
- putBit $ bfIIRShaping bf
- putNBits 2 (0 ∷ Word8) -- reserved
- putNBits 4 $ bfSamplingRate bf
- putNBits 5 $ bfMaxMagnitude bf
- putNBits 5 $ bfLeftShift bf
- putBit $ bfFinalBlock bf
- putBit $ bfInitialBlock bf
- putBit $ bfFinalBlock bf
- putBit $ bfHybridBalance bf
- putBit $ bfHybridBitrate bf
- putBit $ bfExtendedInt bf
- putBit $ bfFloatData bf
- putBit $ bfHybridShape bf
- putBit $ bfCrossDecorr bf
- putBit $ bfJointStereo bf
- putBit $ bfHybrid bf
- putBit $ bfMono bf
- putNBits 2 $ bfBytesPerSample bf - 1
- in
- putLazyByteString (L.reverse bs)
-
- get = do bs ← getBytes 4
- let Right bf
- = runBitGet (S.reverse bs) $
- do BG.skip 1 -- reserved
- falseStereo ← getBit
- iirShaping ← getBit
- BG.skip 2 -- reserved
- samplingRate ← getAsWord8 4
- maxMagnitude ← getAsWord8 5
- leftShift ← getAsWord8 5
- finalBlock ← getBit
- initialBlock ← getBit
- hybridBalance ← getBit
- hybridBitrate ← getBit
- extendedInt ← getBit
- floatData ← getBit
- hybridShape ← getBit
- crossDecorr ← getBit
- jointStereo ← getBit
- hybrid ← getBit
- mono ← getBit
- bytesPerSample ← getAsWord8 2
- return BlockFlags {
- bfBytesPerSample = bytesPerSample + 1
- , bfMono = mono
- , bfHybrid = hybrid
- , bfJointStereo = jointStereo
- , bfCrossDecorr = crossDecorr
- , bfHybridShape = hybridShape
- , bfFloatData = floatData
- , bfExtendedInt = extendedInt
- , bfHybridBitrate = hybridBitrate
- , bfHybridBalance = hybridBalance
- , bfInitialBlock = initialBlock
- , bfFinalBlock = finalBlock
- , bfLeftShift = leftShift
- , bfMaxMagnitude = maxMagnitude
- , bfSamplingRate = samplingRate
- , bfIIRShaping = iirShaping
- , bfFalseStereo = falseStereo
- }
- return bf