From 756e67d4885f0f8b043c907c7ac8693abc5f417d Mon Sep 17 00:00:00 2001 From: PHO Date: Tue, 4 Jan 2011 22:35:36 +0900 Subject: [PATCH] Binary instance for BlockFlags --- Codec/Audio/WavPack/Types.hs | 131 +++++++++++++++++++++++++++++++++-- wavpack.cabal | 1 + 2 files changed, 127 insertions(+), 5 deletions(-) diff --git a/Codec/Audio/WavPack/Types.hs b/Codec/Audio/WavPack/Types.hs index 5ef2598..9279065 100644 --- a/Codec/Audio/WavPack/Types.hs +++ b/Codec/Audio/WavPack/Types.hs @@ -4,11 +4,17 @@ -- | 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 @@ -22,15 +28,16 @@ data BlockHeader -- | 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 + -- '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) + -- 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 ∷ !Word32 + , bhFlags ∷ !BlockHeader -- | crc for actual decoded data , bhCRC ∷ !Word32 } @@ -49,7 +56,7 @@ instance Binary BlockHeader where putWord32le $ bhTotalSamples bh putWord32le $ bhBlockIndex bh putWord32le $ bhBlockSamples bh - putWord32le $ bhFlags bh + put $ bhFlags bh putWord32le $ bhCRC bh get = do skip 4 -- "wvpk" @@ -60,7 +67,7 @@ instance Binary BlockHeader where totalSamples ← getWord32le blockIndex ← getWord32le blockSamples ← getWord32le - flags ← getWord32le + flags ← get crc ← getWord32le return BlockHeader { bhSize = size @@ -73,3 +80,117 @@ instance Binary BlockHeader where , 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 diff --git a/wavpack.cabal b/wavpack.cabal index 239e4e9..eb2460c 100644 --- a/wavpack.cabal +++ b/wavpack.cabal @@ -25,6 +25,7 @@ Library base == 4.*, base-unicode-symbols == 0.2.*, binary == 0.5.*, + binary-strict == 0.4.*, bytestring == 0.9.* Exposed-Modules: -- 2.40.0