renamed Types.hs -> Block.hs
[wavpack.git] / Codec / Audio / WavPack / Block.hs
1 {-# LANGUAGE
2     UnicodeSyntax
3   #-}
4 -- | Data types for WavPack codec.
5 module Codec.Audio.WavPack.Block
6     ( BlockHeader(..)
7     , BlockFlags(..)
8     )
9     where
10 import Data.Binary
11 import Data.Binary.BitPut (putBit, putNBits, runBitPut)
12 import Data.Binary.Get
13 import Data.Binary.Put
14 import qualified Data.Binary.Strict.BitGet as BG
15 import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
16 import qualified Data.ByteString as S
17 import qualified Data.ByteString.Lazy as L
18
19 -- | The preamble to every block in both the .wv and .wvc files.
20 data BlockHeader
21     = BlockHeader {
22       -- | size of entire block (minus 8, of course)
23         bhSize         ∷ !Word32
24       -- | 0x402 to 0x410 are currently valid for decode
25       , bhVersion      ∷ !Word16
26       -- | track number (0 if not used, like now)
27       , bhTrackNo      ∷ !Word8
28       -- | track sub-index (0 if not used, like now)
29       , bhIndexNo      ∷ !Word8
30       -- | total samples for entire file, but this is only valid if
31       --   'bhBlockIndex' == 0 and a value of -1 indicates unknown
32       --   length
33       , bhTotalSamples ∷ !Word32
34       -- | index of first sample in block relative to beginning of
35       --   file (normally this would start at 0 for the first block)
36       , bhBlockIndex   ∷ !Word32
37       -- | number of samples in this block (0 = no audio)
38       , bhBlockSamples ∷ !Word32
39       -- | various flags for id and decoding
40       , bhFlags        ∷ !BlockHeader
41       -- | crc for actual decoded data
42       , bhCRC          ∷ !Word32
43       }
44     deriving (Show, Eq)
45
46 instance Binary BlockHeader where
47     put bh
48         = do putWord8 119 -- 'w'
49              putWord8 118 -- 'v'
50              putWord8 112 -- 'p'
51              putWord8 107 -- 'k'
52              putWord32le $ bhSize         bh
53              putWord16le $ bhVersion      bh
54              putWord8    $ bhTrackNo      bh
55              putWord8    $ bhIndexNo      bh
56              putWord32le $ bhTotalSamples bh
57              putWord32le $ bhBlockIndex   bh
58              putWord32le $ bhBlockSamples bh
59              put         $ bhFlags        bh
60              putWord32le $ bhCRC          bh
61
62     get = do skip 4 -- "wvpk"
63              size         ← getWord32le
64              version      ← getWord16le
65              trackNo      ← getWord8
66              indexNo      ← getWord8
67              totalSamples ← getWord32le
68              blockIndex   ← getWord32le
69              blockSamples ← getWord32le
70              flags        ← get
71              crc          ← getWord32le
72              return BlockHeader {
73                               bhSize         = size
74                             , bhVersion      = version
75                             , bhTrackNo      = trackNo
76                             , bhIndexNo      = indexNo
77                             , bhTotalSamples = totalSamples
78                             , bhBlockIndex   = blockIndex
79                             , bhBlockSamples = blockSamples
80                             , bhFlags        = flags
81                             , bhCRC          = crc
82                             }
83
84 -- | Various flags for decoding blocks
85 data BlockFlags
86     = BlockFlags {
87       -- | 1 <= n <= 4
88         bfBytesPerSample ∷ !Word8
89       -- | 'False' = stereo output; 'True' = mono output
90       , bfMono           ∷ !Bool
91       -- | 'False' = lossless mode; 'True' = hybrid mode
92       , bfHybrid         ∷ !Bool
93       -- | 'False' = true stereo; 'True' = joint stereo (mid/side)
94       , bfJointStereo    ∷ !Bool
95       -- | 'False' = independent channels; 'True' = cross-channel
96       --   decorrelation
97       , bfCrossDecorr    ∷ !Bool
98       -- | 'False' = flat noise spectrum in hybrid; 'True' = hybrid
99       --   noise shaping
100       , bfHybridShape    ∷ !Bool
101       -- | 'False' = integer data; 'True' = floating point data
102       , bfFloatData      ∷ !Bool
103       -- | 'True' = extended size integers (> 24-bit); 'False' =
104       --   shifted integers
105       , bfExtendedInt    ∷ !Bool
106       -- | 'False' = hybrid mode parameters control noise level;
107       --   'True' = hybrid mode parameters control bitrate
108       , bfHybridBitrate  ∷ !Bool
109       -- | 'True' = hybrid noise balanced between channels
110       , bfHybridBalance  ∷ !Bool
111       -- | 'True' = initial block in sequence (for multichannel)
112       , bfInitialBlock   ∷ !Bool
113       -- | 'True' = final block in sequence (for multichannel)
114       , bfFinalBlock     ∷ !Bool
115       -- | amount of data left-shift after decode (0-31 places)
116       , bfLeftShift      ∷ !Word8
117       -- | maximum magnitude of decoded data (number of bits integers
118       --   require minus 1)
119       , bfMaxMagnitude   ∷ !Word8
120       -- | sampling rate (0x1111 = unknown/custom) (THINKME)
121       , bfSamplingRate   ∷ !Word8
122       -- | 'True' = use IIR for negative hybrid noise shaping
123       , bfIIRShaping     ∷ !Bool
124       -- | 'True' = false stereo (data is mono but output is stereo)
125       , bfFalseStereo    ∷ !Bool
126       }
127     deriving (Show, Eq)
128
129 instance Binary BlockFlags where
130     put bf
131         = let bs = runBitPut $
132                    do putBit False -- reserved
133                       putBit $ bfFalseStereo bf
134                       putBit $ bfIIRShaping  bf
135                       putNBits 2 (0 ∷ Word8) -- reserved
136                       putNBits 4 $ bfSamplingRate bf
137                       putNBits 5 $ bfMaxMagnitude bf
138                       putNBits 5 $ bfLeftShift    bf
139                       putBit $ bfFinalBlock    bf
140                       putBit $ bfInitialBlock  bf
141                       putBit $ bfFinalBlock    bf
142                       putBit $ bfHybridBalance bf
143                       putBit $ bfHybridBitrate bf
144                       putBit $ bfExtendedInt   bf
145                       putBit $ bfFloatData     bf
146                       putBit $ bfHybridShape   bf
147                       putBit $ bfCrossDecorr   bf
148                       putBit $ bfJointStereo   bf
149                       putBit $ bfHybrid        bf
150                       putBit $ bfMono          bf
151                       putNBits 2 $ bfBytesPerSample bf - 1
152           in
153             putLazyByteString (L.reverse bs)
154
155     get = do bs ← getBytes 4
156              let Right bf
157                      = runBitGet (S.reverse bs) $
158                        do BG.skip 1 -- reserved
159                           falseStereo    ← getBit
160                           iirShaping     ← getBit
161                           BG.skip 2 -- reserved
162                           samplingRate   ← getAsWord8 4
163                           maxMagnitude   ← getAsWord8 5
164                           leftShift      ← getAsWord8 5
165                           finalBlock     ← getBit
166                           initialBlock   ← getBit
167                           hybridBalance  ← getBit
168                           hybridBitrate  ← getBit
169                           extendedInt    ← getBit
170                           floatData      ← getBit
171                           hybridShape    ← getBit
172                           crossDecorr    ← getBit
173                           jointStereo    ← getBit
174                           hybrid         ← getBit
175                           mono           ← getBit
176                           bytesPerSample ← getAsWord8 2
177                           return BlockFlags {
178                                        bfBytesPerSample = bytesPerSample + 1
179                                      , bfMono           = mono
180                                      , bfHybrid         = hybrid
181                                      , bfJointStereo    = jointStereo
182                                      , bfCrossDecorr    = crossDecorr
183                                      , bfHybridShape    = hybridShape
184                                      , bfFloatData      = floatData
185                                      , bfExtendedInt    = extendedInt
186                                      , bfHybridBitrate  = hybridBitrate
187                                      , bfHybridBalance  = hybridBalance
188                                      , bfInitialBlock   = initialBlock
189                                      , bfFinalBlock     = finalBlock
190                                      , bfLeftShift      = leftShift
191                                      , bfMaxMagnitude   = maxMagnitude
192                                      , bfSamplingRate   = samplingRate
193                                      , bfIIRShaping     = iirShaping
194                                      , bfFalseStereo    = falseStereo
195                                      }
196              return bf