--- /dev/null
+{-# 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