fix a bug in put :: BlockFlags -> Put

[wavpack.git] / Codec / Audio / WavPack / Block.hs

diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
index 8e46be89f6d3e71310897bd7996c1f27b395b9d2..db527064654a261705ac8a2e458323ecdf138943 100644 (file)
--- a/Codec/Audio/WavPack/Block.hs
+++ b/Codec/Audio/WavPack/Block.hs
@@ -120,8 +120,8 @@ data BlockFlags
       -- | maximum magnitude of decoded data (number of bits integers
       --   require minus 1)
       , bfMaxMagnitude   ∷ !Word8
-      -- | sampling rate (0x1111 = unknown/custom) (THINKME)
-      , bfSamplingRate   ∷ !Word8
+      -- | sampling rate ('Nothing' = unknown/custom)
+      , bfSamplingRate   ∷ !(Maybe Int)
       -- | 'True' = use IIR for negative hybrid noise shaping
       , bfIIRShaping     ∷ !Bool
       -- | 'True' = false stereo (data is mono but output is stereo)
@@ -136,12 +136,11 @@ instance Binary BlockFlags where
                       putBit $ bfFalseStereo bf
                       putBit $ bfIIRShaping  bf
                       putNBits 2 (0 ∷ Word8) -- reserved
-                      putNBits 4 $ bfSamplingRate bf
+                      putNBits 4 $ encodeSamplingRate $ 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
@@ -192,25 +191,62 @@ instance Binary BlockFlags where
                                      , bfFinalBlock     = finalBlock
                                      , bfLeftShift      = leftShift
                                      , bfMaxMagnitude   = maxMagnitude
-                                     , bfSamplingRate   = samplingRate
+                                     , bfSamplingRate   = decodeSamplingRate samplingRate
                                      , bfIIRShaping     = iirShaping
                                      , bfFalseStereo    = falseStereo
                                      }
              return bf
 
-findNextHeader ∷ L.ByteString → (Maybe BlockHeader, L.ByteString)
+encodeSamplingRate ∷ Maybe Int → Word8
+encodeSamplingRate (Just   6000) = 0x00
+encodeSamplingRate (Just   8000) = 0x01
+encodeSamplingRate (Just   9600) = 0x02
+encodeSamplingRate (Just  11025) = 0x03
+encodeSamplingRate (Just  12000) = 0x04
+encodeSamplingRate (Just  16000) = 0x05
+encodeSamplingRate (Just  22050) = 0x06
+encodeSamplingRate (Just  24000) = 0x07
+encodeSamplingRate (Just  32000) = 0x08
+encodeSamplingRate (Just  44100) = 0x09
+encodeSamplingRate (Just  48000) = 0x0A
+encodeSamplingRate (Just  64000) = 0x0B
+encodeSamplingRate (Just  88200) = 0x0C
+encodeSamplingRate (Just  96000) = 0x0D
+encodeSamplingRate (Just 192000) = 0x0E
+encodeSamplingRate             _ = 0x0F
+
+decodeSamplingRate ∷ Word8 → Maybe Int
+decodeSamplingRate 0x00 = Just   6000
+decodeSamplingRate 0x01 = Just   8000
+decodeSamplingRate 0x02 = Just   9600
+decodeSamplingRate 0x03 = Just  11025
+decodeSamplingRate 0x04 = Just  12000
+decodeSamplingRate 0x05 = Just  16000
+decodeSamplingRate 0x06 = Just  22025
+decodeSamplingRate 0x07 = Just  24000
+decodeSamplingRate 0x08 = Just  32000
+decodeSamplingRate 0x09 = Just  44100
+decodeSamplingRate 0x0A = Just  48000
+decodeSamplingRate 0x0B = Just  64000
+decodeSamplingRate 0x0C = Just  88200
+decodeSamplingRate 0x0D = Just  96000
+decodeSamplingRate 0x0E = Just 192000
+decodeSamplingRate    _ =     Nothing
+
+-- | Find a WavPack header in a given stream. Returns 'Nothing' if no
+-- headers are found.
+findNextHeader ∷ L.ByteString -- ^ the input
+               → Maybe (BlockHeader, L.ByteString) -- ^ a header and the rest of input
 findNextHeader src
     = case L.uncons src of
         Nothing
-            → (Nothing, L.empty)
-
+            → Nothing
         Just (119, src') -- 'w'
             → let (header, rest) = L.splitAt 32 src
                in
                  case L.length header ≡ 32 of
                    False
-                       → (Nothing, L.empty)
-
+                       → Nothing
                    True
                        → let Just (magicW, header'  ) = L.uncons header
                              Just (magicV, header'' ) = L.uncons header'
@@ -221,9 +257,8 @@ findNextHeader src
                                -- Found the magic 'wvpk'.
                                let bh = runGet get header
                                in
-                                 (Just bh, rest)
+                                 Just (bh, rest)
                            else
                                findNextHeader src'
-
         Just (_, src')
             → findNextHeader src'