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 ('Nothing' = unknown/custom)
124 , bfSamplingRate ∷ !(Maybe Int)
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 $ encodeSamplingRate $ bfSamplingRate bf
140 putNBits 5 $ bfMaxMagnitude bf
141 putNBits 5 $ bfLeftShift bf
142 putBit $ bfFinalBlock bf
143 putBit $ bfInitialBlock bf
144 putBit $ bfHybridBalance bf
145 putBit $ bfHybridBitrate bf
146 putBit $ bfExtendedInt bf
147 putBit $ bfFloatData bf
148 putBit $ bfHybridShape bf
149 putBit $ bfCrossDecorr bf
150 putBit $ bfJointStereo bf
153 putNBits 2 $ bfBytesPerSample bf - 1
155 putLazyByteString (L.reverse bs)
157 get = do bs ← getBytes 4
159 = runBitGet (S.reverse bs) $
160 do BG.skip 1 -- reserved
163 BG.skip 2 -- reserved
164 samplingRate ← getAsWord8 4
165 maxMagnitude ← getAsWord8 5
166 leftShift ← getAsWord8 5
168 initialBlock ← getBit
169 hybridBalance ← getBit
170 hybridBitrate ← getBit
178 bytesPerSample ← getAsWord8 2
180 bfBytesPerSample = bytesPerSample + 1
183 , bfJointStereo = jointStereo
184 , bfCrossDecorr = crossDecorr
185 , bfHybridShape = hybridShape
186 , bfFloatData = floatData
187 , bfExtendedInt = extendedInt
188 , bfHybridBitrate = hybridBitrate
189 , bfHybridBalance = hybridBalance
190 , bfInitialBlock = initialBlock
191 , bfFinalBlock = finalBlock
192 , bfLeftShift = leftShift
193 , bfMaxMagnitude = maxMagnitude
194 , bfSamplingRate = decodeSamplingRate samplingRate
195 , bfIIRShaping = iirShaping
196 , bfFalseStereo = falseStereo
200 encodeSamplingRate ∷ Maybe Int → Word8
201 encodeSamplingRate (Just 6000) = 0x00
202 encodeSamplingRate (Just 8000) = 0x01
203 encodeSamplingRate (Just 9600) = 0x02
204 encodeSamplingRate (Just 11025) = 0x03
205 encodeSamplingRate (Just 12000) = 0x04
206 encodeSamplingRate (Just 16000) = 0x05
207 encodeSamplingRate (Just 22050) = 0x06
208 encodeSamplingRate (Just 24000) = 0x07
209 encodeSamplingRate (Just 32000) = 0x08
210 encodeSamplingRate (Just 44100) = 0x09
211 encodeSamplingRate (Just 48000) = 0x0A
212 encodeSamplingRate (Just 64000) = 0x0B
213 encodeSamplingRate (Just 88200) = 0x0C
214 encodeSamplingRate (Just 96000) = 0x0D
215 encodeSamplingRate (Just 192000) = 0x0E
216 encodeSamplingRate _ = 0x0F
218 decodeSamplingRate ∷ Word8 → Maybe Int
219 decodeSamplingRate 0x00 = Just 6000
220 decodeSamplingRate 0x01 = Just 8000
221 decodeSamplingRate 0x02 = Just 9600
222 decodeSamplingRate 0x03 = Just 11025
223 decodeSamplingRate 0x04 = Just 12000
224 decodeSamplingRate 0x05 = Just 16000
225 decodeSamplingRate 0x06 = Just 22025
226 decodeSamplingRate 0x07 = Just 24000
227 decodeSamplingRate 0x08 = Just 32000
228 decodeSamplingRate 0x09 = Just 44100
229 decodeSamplingRate 0x0A = Just 48000
230 decodeSamplingRate 0x0B = Just 64000
231 decodeSamplingRate 0x0C = Just 88200
232 decodeSamplingRate 0x0D = Just 96000
233 decodeSamplingRate 0x0E = Just 192000
234 decodeSamplingRate _ = Nothing
236 -- | Find a WavPack header in a given stream. Returns 'Nothing' if no
237 -- headers are found.
238 findNextHeader ∷ L.ByteString -- ^ the input
239 → Maybe (BlockHeader, L.ByteString) -- ^ a header and the rest of input
241 = case L.uncons src of
244 Just (119, src') -- 'w'
245 → let (header, rest) = L.splitAt 32 src
247 case L.length header ≡ 32 of
251 → let Just (magicW, header' ) = L.uncons header
252 Just (magicV, header'' ) = L.uncons header'
253 Just (magicP, header''') = L.uncons header''
254 magicK = L.head header'''
256 if magicW ≡ 119 ∧ magicV ≡ 118 ∧ magicP ≡ 112 ∧ magicK ≡ 107 then
257 -- Found the magic 'wvpk'.
258 let bh = runGet get header
264 → findNextHeader src'