DecorrSamples

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

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index d8c0df1e592d889c1b203acb5a2ef3dd99d790f5..00e1d02e2631340d426f66a04d9909bc26364d8f 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -11,11 +11,13 @@ module Codec.Audio.WavPack.Metadata
     , Dummy(..)
     , DecorrTerms(..)
     , DecorrWeights(..)
+    , DecorrSamples(..)
     , RIFFHeader(..)
     , RIFFTrailer(..)
     , Unknown(..)
     )
     where
+import Codec.Audio.WavPack.Internal
 import Control.Monad
 import Data.Binary
 import Data.Binary.Get
@@ -94,6 +96,7 @@ instance Binary SubBlock where
           getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy        )
           getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms  )
           getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights)
+          getSubBlock 0x04 = fmap SubBlock (get ∷ Get DecorrSamples)
           getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader   )
           getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer  )
           getSubBlock unknownID
@@ -177,35 +180,36 @@ instance Metadata DecorrWeights where
     metaSize = fromIntegral ∘ UV.length ∘ decwVec
 
 instance Binary DecorrWeights where
-    put = UV.mapM_ (putWord8 ∘ packW) ∘ decwVec
-        where
-          packW ∷ Int16 → Word8
-          packW w
-              = let w'   | w  >  1024 =  1024
-                         | w  < -1024 = -1024
-                         | otherwise  =     w
-                    w''  | w' >     0 = w' - ((w' + 64) `shiftR` 7)
-                         | otherwise  = w'
-                    w'''              = (w'' + 4) `shiftR` 3
-                in
-                  fromIntegral w'''
+    put = UV.mapM_ (putWord8 ∘ packWeight) ∘ decwVec
     get = do n   ← remaining
-             vec ← UV.replicateM (fromIntegral n) $ fmap unpackW getWord8
+             vec ← UV.replicateM (fromIntegral n)
+                    $ fmap unpackWeight getWord8
              -- THINKME: the same caution as DecorrTerms, but never
-             -- try to reverse the vector simply. Think about the
+             -- try to simply reverse the vector. Think about the
              -- interleaving.
              return $ DecorrWeights vec
-        where
-          unpackW ∷ Word8 → Int16
-          unpackW w
-              = let w'  ∷ Int8
-                    w'  = fromIntegral w
-                    w'' ∷ Int16
-                    w'' = (fromIntegral w') `shiftL` 3
-                    w''' | w'' > 0   = w'' + ((w'' + 64) `shiftR` 7)
-                         | otherwise = w''
-                in
-                  w'''
+
+-- | Decorrelation samples
+data DecorrSamples
+    = DecorrSamples {
+      -- | The decorrelation sample vector stored in the metadata
+      --   as-is. Actual interpretation of the vector depends on the
+      --   number of channels and each corresponding decorrelation
+      --   terms.
+        decsVec ∷ !(UV.Vector Int32)
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata DecorrSamples where
+    metaID _ = 0x04
+    metaSize = fromIntegral ∘ (⋅ 2) ∘ UV.length ∘ decsVec
+
+instance Binary DecorrSamples where
+    put = UV.mapM_ (putWord16le ∘ fromIntegral ∘ log2s) ∘ decsVec
+    get = do n   ← remaining
+             vec ← UV.replicateM (fromIntegral $ n `div` 2)
+                    $ fmap (exp2s ∘ fromIntegral) getWord16le
+             return $ DecorrSamples vec
 
 -- | RIFF header for .wav files (before audio)
 data RIFFHeader