]> gitweb @ CieloNegro.org - wavpack.git/blobdiff - Codec/Audio/WavPack/Block.hs
renamed Types.hs -> Block.hs
[wavpack.git] / Codec / Audio / WavPack / Block.hs
diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
new file mode 100644 (file)
index 0000000..e3732ee
--- /dev/null
@@ -0,0 +1,196 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
+-- | Data types for WavPack codec.
+module Codec.Audio.WavPack.Block
+    ( 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
+    = BlockHeader {
+      -- | size of entire block (minus 8, of course)
+        bhSize         ∷ !Word32
+      -- | 0x402 to 0x410 are currently valid for decode
+      , bhVersion      ∷ !Word16
+      -- | track number (0 if not used, like now)
+      , bhTrackNo      ∷ !Word8
+      -- | 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
+      , bhTotalSamples ∷ !Word32
+      -- | index of first sample in block relative to beginning of
+      --   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        ∷ !BlockHeader
+      -- | crc for actual decoded data
+      , bhCRC          ∷ !Word32
+      }
+    deriving (Show, Eq)
+
+instance Binary BlockHeader where
+    put bh
+        = do putWord8 119 -- 'w'
+             putWord8 118 -- 'v'
+             putWord8 112 -- 'p'
+             putWord8 107 -- 'k'
+             putWord32le $ bhSize         bh
+             putWord16le $ bhVersion      bh
+             putWord8    $ bhTrackNo      bh
+             putWord8    $ bhIndexNo      bh
+             putWord32le $ bhTotalSamples bh
+             putWord32le $ bhBlockIndex   bh
+             putWord32le $ bhBlockSamples bh
+             put         $ bhFlags        bh
+             putWord32le $ bhCRC          bh
+
+    get = do skip 4 -- "wvpk"
+             size         ← getWord32le
+             version      ← getWord16le
+             trackNo      ← getWord8
+             indexNo      ← getWord8
+             totalSamples ← getWord32le
+             blockIndex   ← getWord32le
+             blockSamples ← getWord32le
+             flags        ← get
+             crc          ← getWord32le
+             return BlockHeader {
+                              bhSize         = size
+                            , bhVersion      = version
+                            , bhTrackNo      = trackNo
+                            , bhIndexNo      = indexNo
+                            , bhTotalSamples = totalSamples
+                            , bhBlockIndex   = blockIndex
+                            , bhBlockSamples = blockSamples
+                            , 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