X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=blobdiff_plain;f=Codec%2FAudio%2FWavPack%2FBlock.hs;fp=Codec%2FAudio%2FWavPack%2FBlock.hs;h=e3732eeba813f0b613537e81442447a38ffd8876;hp=0000000000000000000000000000000000000000;hb=29798f163756481db542070067dee15501f281a6;hpb=756e67d4885f0f8b043c907c7ac8693abc5f417d diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs new file mode 100644 index 0000000..e3732ee --- /dev/null +++ b/Codec/Audio/WavPack/Block.hs @@ -0,0 +1,196 @@ +{-# 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