Binary instance for BlockFlags

diff --git a/Codec/Audio/WavPack/Types.hs b/Codec/Audio/WavPack/Types.hs
index 5ef259890e0f26b3710391a35801344e369cb27c..9279065db40c515b1c55f7a3035728a9de73721c 100644 (file)
--- a/Codec/Audio/WavPack/Types.hs
+++ b/Codec/Audio/WavPack/Types.hs
@@ -4,11 +4,17 @@
 -- | Data types for WavPack codec.
 module Codec.Audio.WavPack.Types
     ( BlockHeader(..)
+    , BlockFlags(..)
     )
     where
 import Data.Binary
+import Data.Binary.BitPut (putBit, putNBits, runBitPut)
 import Data.Binary.Get
 import Data.Binary.Put
+import qualified Data.Binary.Strict.BitGet as BG
+import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
 
 -- | The preamble to every block in both the .wv and .wvc files.
 data BlockHeader
@@ -22,15 +28,16 @@ data BlockHeader
       -- | track sub-index (0 if not used, like now)
       , bhIndexNo      ∷ !Word8
       -- | total samples for entire file, but this is only valid if
-      -- 'bhBlockIndex' == 0 and a value of -1 indicates unknown length
+      --   'bhBlockIndex' == 0 and a value of -1 indicates unknown
+      --   length
       , bhTotalSamples ∷ !Word32
       -- | index of first sample in block relative to beginning of
-      -- file (normally this would start at 0 for the first block)
+      --   file (normally this would start at 0 for the first block)
       , bhBlockIndex   ∷ !Word32
       -- | number of samples in this block (0 = no audio)
       , bhBlockSamples ∷ !Word32
       -- | various flags for id and decoding
-      , bhFlags        ∷ !Word32
+      , bhFlags        ∷ !BlockHeader
       -- | crc for actual decoded data
       , bhCRC          ∷ !Word32
       }
@@ -49,7 +56,7 @@ instance Binary BlockHeader where
              putWord32le $ bhTotalSamples bh
              putWord32le $ bhBlockIndex   bh
              putWord32le $ bhBlockSamples bh
-             putWord32le $ bhFlags        bh
+             put         $ bhFlags        bh
              putWord32le $ bhCRC          bh
 
     get = do skip 4 -- "wvpk"
@@ -60,7 +67,7 @@ instance Binary BlockHeader where
              totalSamples ← getWord32le
              blockIndex   ← getWord32le
              blockSamples ← getWord32le
-             flags        ← getWord32le
+             flags        ← get
              crc          ← getWord32le
              return BlockHeader {
                               bhSize         = size
@@ -73,3 +80,117 @@ instance Binary BlockHeader where
                             , bhFlags        = flags
                             , bhCRC          = crc
                             }
+
+-- | Various flags for decoding blocks
+data BlockFlags
+    = BlockFlags {
+      -- | 1 <= n <= 4
+        bfBytesPerSample ∷ !Word8
+      -- | 'False' = stereo output; 'True' = mono output
+      , bfMono           ∷ !Bool
+      -- | 'False' = lossless mode; 'True' = hybrid mode
+      , bfHybrid         ∷ !Bool
+      -- | 'False' = true stereo; 'True' = joint stereo (mid/side)
+      , bfJointStereo    ∷ !Bool
+      -- | 'False' = independent channels; 'True' = cross-channel
+      --   decorrelation
+      , bfCrossDecorr    ∷ !Bool
+      -- | 'False' = flat noise spectrum in hybrid; 'True' = hybrid
+      --   noise shaping
+      , bfHybridShape    ∷ !Bool
+      -- | 'False' = integer data; 'True' = floating point data
+      , bfFloatData      ∷ !Bool
+      -- | 'True' = extended size integers (> 24-bit); 'False' =
+      --   shifted integers
+      , bfExtendedInt    ∷ !Bool
+      -- | 'False' = hybrid mode parameters control noise level;
+      --   'True' = hybrid mode parameters control bitrate
+      , bfHybridBitrate  ∷ !Bool
+      -- | 'True' = hybrid noise balanced between channels
+      , bfHybridBalance  ∷ !Bool
+      -- | 'True' = initial block in sequence (for multichannel)
+      , bfInitialBlock   ∷ !Bool
+      -- | 'True' = final block in sequence (for multichannel)
+      , bfFinalBlock     ∷ !Bool
+      -- | amount of data left-shift after decode (0-31 places)
+      , bfLeftShift      ∷ !Word8
+      -- | maximum magnitude of decoded data (number of bits integers
+      --   require minus 1)
+      , bfMaxMagnitude   ∷ !Word8
+      -- | sampling rate (0x1111 = unknown/custom) (THINKME)
+      , bfSamplingRate   ∷ !Word8
+      -- | 'True' = use IIR for negative hybrid noise shaping
+      , bfIIRShaping     ∷ !Bool
+      -- | 'True' = false stereo (data is mono but output is stereo)
+      , bfFalseStereo    ∷ !Bool
+      }
+    deriving (Show, Eq)
+
+instance Binary BlockFlags where
+    put bf
+        = let bs = runBitPut $
+                   do putBit False -- reserved
+                      putBit $ bfFalseStereo bf
+                      putBit $ bfIIRShaping  bf
+                      putNBits 2 (0 ∷ Word8) -- reserved
+                      putNBits 4 $ 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
+                      putBit $ bfFloatData     bf
+                      putBit $ bfHybridShape   bf
+                      putBit $ bfCrossDecorr   bf
+                      putBit $ bfJointStereo   bf
+                      putBit $ bfHybrid        bf
+                      putBit $ bfMono          bf
+                      putNBits 2 $ bfBytesPerSample bf - 1
+          in
+            putLazyByteString (L.reverse bs)
+
+    get = do bs ← getBytes 4
+             let Right bf
+                     = runBitGet (S.reverse bs) $
+                       do BG.skip 1 -- reserved
+                          falseStereo    ← getBit
+                          iirShaping     ← getBit
+                          BG.skip 2 -- reserved
+                          samplingRate   ← getAsWord8 4
+                          maxMagnitude   ← getAsWord8 5
+                          leftShift      ← getAsWord8 5
+                          finalBlock     ← getBit
+                          initialBlock   ← getBit
+                          hybridBalance  ← getBit
+                          hybridBitrate  ← getBit
+                          extendedInt    ← getBit
+                          floatData      ← getBit
+                          hybridShape    ← getBit
+                          crossDecorr    ← getBit
+                          jointStereo    ← getBit
+                          hybrid         ← getBit
+                          mono           ← getBit
+                          bytesPerSample ← getAsWord8 2
+                          return BlockFlags {
+                                       bfBytesPerSample = bytesPerSample + 1
+                                     , bfMono           = mono
+                                     , bfHybrid         = hybrid
+                                     , bfJointStereo    = jointStereo
+                                     , bfCrossDecorr    = crossDecorr
+                                     , bfHybridShape    = hybridShape
+                                     , bfFloatData      = floatData
+                                     , bfExtendedInt    = extendedInt
+                                     , bfHybridBitrate  = hybridBitrate
+                                     , bfHybridBalance  = hybridBalance
+                                     , bfInitialBlock   = initialBlock
+                                     , bfFinalBlock     = finalBlock
+                                     , bfLeftShift      = leftShift
+                                     , bfMaxMagnitude   = maxMagnitude
+                                     , bfSamplingRate   = samplingRate
+                                     , bfIIRShaping     = iirShaping
+                                     , bfFalseStereo    = falseStereo
+                                     }
+             return bf

diff --git a/wavpack.cabal b/wavpack.cabal
index 239e4e9dc998ad2078df084a1ff12929dac5f211..eb2460c136df3c46dfa96fab9bb11939792c3e5d 100644 (file)
--- a/wavpack.cabal
+++ b/wavpack.cabal
@@ -25,6 +25,7 @@ Library
         base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         binary               == 0.5.*,
+        binary-strict        == 0.4.*,
         bytestring           == 0.9.*
 
     Exposed-Modules: