4 -- | Data types for WavPack codec.
5 module Codec.Audio.WavPack.Block
13 import Data.Binary.BitPut (putBit, putNBits, runBitPut)
14 import Data.Binary.Get
15 import Data.Binary.Put
16 import qualified Data.Binary.Strict.BitGet as BG
17 import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
18 import qualified Data.ByteString as S
19 import qualified Data.ByteString.Lazy as L
20 import Prelude.Unicode
22 -- | The preamble to every block in both the .wv and .wvc files.
25 -- | size of entire block (excluding the header)
27 -- | 0x402 to 0x410 are currently valid for decode
29 -- | track number (0 if not used, like now)
31 -- | track sub-index (0 if not used, like now)
33 -- | total samples for entire file, but this is only valid if
34 -- 'bhBlockIndex' == 0 and a value of -1 indicates unknown
36 , bhTotalSamples ∷ !Word32
37 -- | index of first sample in block relative to beginning of
38 -- file (normally this would start at 0 for the first block)
39 , bhBlockIndex ∷ !Word32
40 -- | number of samples in this block (0 = no audio)
41 , bhBlockSamples ∷ !Word32
42 -- | various flags for id and decoding
43 , bhFlags ∷ !BlockFlags
44 -- | crc for actual decoded data
49 instance Binary BlockHeader where
51 = do putWord8 119 -- 'w'
55 putWord32le $ bhSize bh + 32 - 8
56 putWord16le $ bhVersion bh
57 putWord8 $ bhTrackNo bh
58 putWord8 $ bhIndexNo bh
59 putWord32le $ bhTotalSamples bh
60 putWord32le $ bhBlockIndex bh
61 putWord32le $ bhBlockSamples bh
63 putWord32le $ bhCRC bh
65 get = do skip 4 -- "wvpk"
70 totalSamples ← getWord32le
71 blockIndex ← getWord32le
72 blockSamples ← getWord32le
76 bhSize = size + 8 - 32
80 , bhTotalSamples = totalSamples
81 , bhBlockIndex = blockIndex
82 , bhBlockSamples = blockSamples
87 -- | Various flags for decoding blocks
91 bfBytesPerSample ∷ !Word8
92 -- | 'False' = stereo output; 'True' = mono output
94 -- | 'False' = lossless mode; 'True' = hybrid mode
96 -- | 'False' = true stereo; 'True' = joint stereo (mid/side)
97 , bfJointStereo ∷ !Bool
98 -- | 'False' = independent channels; 'True' = cross-channel
100 , bfCrossDecorr ∷ !Bool
101 -- | 'False' = flat noise spectrum in hybrid; 'True' = hybrid
103 , bfHybridShape ∷ !Bool
104 -- | 'False' = integer data; 'True' = floating point data
105 , bfFloatData ∷ !Bool
106 -- | 'True' = extended size integers (> 24-bit); 'False' =
108 , bfExtendedInt ∷ !Bool
109 -- | 'False' = hybrid mode parameters control noise level;
110 -- 'True' = hybrid mode parameters control bitrate
111 , bfHybridBitrate ∷ !Bool
112 -- | 'True' = hybrid noise balanced between channels
113 , bfHybridBalance ∷ !Bool
114 -- | 'True' = initial block in sequence (for multichannel)
115 , bfInitialBlock ∷ !Bool
116 -- | 'True' = final block in sequence (for multichannel)
117 , bfFinalBlock ∷ !Bool
118 -- | amount of data left-shift after decode (0-31 places)
119 , bfLeftShift ∷ !Word8
120 -- | maximum magnitude of decoded data (number of bits integers
122 , bfMaxMagnitude ∷ !Word8
123 -- | sampling rate (0x1111 = unknown/custom) (THINKME)
124 , bfSamplingRate ∷ !Word8
125 -- | 'True' = use IIR for negative hybrid noise shaping
126 , bfIIRShaping ∷ !Bool
127 -- | 'True' = false stereo (data is mono but output is stereo)
128 , bfFalseStereo ∷ !Bool
132 instance Binary BlockFlags where
134 = let bs = runBitPut $
135 do putBit False -- reserved
136 putBit $ bfFalseStereo bf
137 putBit $ bfIIRShaping bf
138 putNBits 2 (0 ∷ Word8) -- reserved
139 putNBits 4 $ bfSamplingRate bf
140 putNBits 5 $ bfMaxMagnitude bf
141 putNBits 5 $ bfLeftShift bf
142 putBit $ bfFinalBlock bf
143 putBit $ bfInitialBlock bf
144 putBit $ bfFinalBlock bf
145 putBit $ bfHybridBalance bf
146 putBit $ bfHybridBitrate bf
147 putBit $ bfExtendedInt bf
148 putBit $ bfFloatData bf
149 putBit $ bfHybridShape bf
150 putBit $ bfCrossDecorr bf
151 putBit $ bfJointStereo bf
154 putNBits 2 $ bfBytesPerSample bf - 1
156 putLazyByteString (L.reverse bs)
158 get = do bs ← getBytes 4
160 = runBitGet (S.reverse bs) $
161 do BG.skip 1 -- reserved
164 BG.skip 2 -- reserved
165 samplingRate ← getAsWord8 4
166 maxMagnitude ← getAsWord8 5
167 leftShift ← getAsWord8 5
169 initialBlock ← getBit
170 hybridBalance ← getBit
171 hybridBitrate ← getBit
179 bytesPerSample ← getAsWord8 2
181 bfBytesPerSample = bytesPerSample + 1
184 , bfJointStereo = jointStereo
185 , bfCrossDecorr = crossDecorr
186 , bfHybridShape = hybridShape
187 , bfFloatData = floatData
188 , bfExtendedInt = extendedInt
189 , bfHybridBitrate = hybridBitrate
190 , bfHybridBalance = hybridBalance
191 , bfInitialBlock = initialBlock
192 , bfFinalBlock = finalBlock
193 , bfLeftShift = leftShift
194 , bfMaxMagnitude = maxMagnitude
195 , bfSamplingRate = samplingRate
196 , bfIIRShaping = iirShaping
197 , bfFalseStereo = falseStereo
201 findNextHeader ∷ L.ByteString → (Maybe BlockHeader, L.ByteString)
203 = case L.uncons src of
207 Just (119, src') -- 'w'
208 → let (header, rest) = L.splitAt 32 src
210 case L.length header ≡ 32 of
215 → let Just (magicW, header' ) = L.uncons header
216 Just (magicV, header'' ) = L.uncons header'
217 Just (magicP, header''') = L.uncons header''
218 magicK = L.head header'''
220 if magicW ≡ 119 ∧ magicV ≡ 118 ∧ magicP ≡ 112 ∧ magicK ≡ 107 then
221 -- Found the magic 'wvpk'.
222 let bh = runGet get header
229 → findNextHeader src'