{-# LANGUAGE UnicodeSyntax #-} -- | Data types for WavPack codec. module Codec.Audio.WavPack.Block ( 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