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 ∷ !(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 $ 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 = decodeSamplingRate samplingRate
196 , bfIIRShaping = iirShaping
197 , bfFalseStereo = falseStereo
201 encodeSamplingRate ∷ Maybe Int → Word8
202 encodeSamplingRate (Just 6000) = 0x00
203 encodeSamplingRate (Just 8000) = 0x01
204 encodeSamplingRate (Just 9600) = 0x02
205 encodeSamplingRate (Just 11025) = 0x03
206 encodeSamplingRate (Just 12000) = 0x04
207 encodeSamplingRate (Just 16000) = 0x05
208 encodeSamplingRate (Just 22050) = 0x06
209 encodeSamplingRate (Just 24000) = 0x07
210 encodeSamplingRate (Just 32000) = 0x08
211 encodeSamplingRate (Just 44100) = 0x09
212 encodeSamplingRate (Just 48000) = 0x0A
213 encodeSamplingRate (Just 64000) = 0x0B
214 encodeSamplingRate (Just 88200) = 0x0C
215 encodeSamplingRate (Just 96000) = 0x0D
216 encodeSamplingRate (Just 192000) = 0x0E
217 encodeSamplingRate _ = 0x0F
219 decodeSamplingRate ∷ Word8 → Maybe Int
220 decodeSamplingRate 0x00 = Just 6000
221 decodeSamplingRate 0x01 = Just 8000
222 decodeSamplingRate 0x02 = Just 9600
223 decodeSamplingRate 0x03 = Just 11025
224 decodeSamplingRate 0x04 = Just 12000
225 decodeSamplingRate 0x05 = Just 16000
226 decodeSamplingRate 0x06 = Just 22025
227 decodeSamplingRate 0x07 = Just 24000
228 decodeSamplingRate 0x08 = Just 32000
229 decodeSamplingRate 0x09 = Just 44100
230 decodeSamplingRate 0x0A = Just 48000
231 decodeSamplingRate 0x0B = Just 64000
232 decodeSamplingRate 0x0C = Just 88200
233 decodeSamplingRate 0x0D = Just 96000
234 decodeSamplingRate 0x0E = Just 192000
235 decodeSamplingRate _ = Nothing
237 findNextHeader ∷ L.ByteString → (Maybe BlockHeader, L.ByteString)
239 = case L.uncons src of
243 Just (119, src') -- 'w'
244 → let (header, rest) = L.splitAt 32 src
246 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
265 → findNextHeader src'