From 5bf7c1be1cfce7ef8764ca3fbc34e8ef9bcf5037 Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Sat, 8 Jan 2011 15:41:04 +0900
Subject: [PATCH] DecorrWeights

---
 Codec/Audio/WavPack/Decorrelation.hs | 14 +++----
 Codec/Audio/WavPack/Metadata.hs      | 58 +++++++++++++++++++++++++---
 2 files changed, 59 insertions(+), 13 deletions(-)

diff --git a/Codec/Audio/WavPack/Decorrelation.hs b/Codec/Audio/WavPack/Decorrelation.hs
index b72909f..5fc22f0 100644
--- a/Codec/Audio/WavPack/Decorrelation.hs
+++ b/Codec/Audio/WavPack/Decorrelation.hs
@@ -17,16 +17,16 @@ maxTerm = 8
 -- | FIXME
 data DecorrPass
     = DecorrPass {
-      -- | The decorrelation term: (term /= 0) && ((-3 <= term <= 8)
-      --   || (term == 17) || (term <= 18))
+      -- | The decorrelation term: @(term /= 0) && ((-3 <= term <= 8)
+      --   || (term == 17) || (term <= 18))@
         dpTerm     ∷ !Int8
-      -- | The decorrelation delta: 0 <= delta <= 8
+      -- | The decorrelation delta: @0 <= delta <= 8@
       , dpDelta    ∷ !Int8
-      -- | The decorrelation weight for channel A: -1024 <= weight <=
-      --   1024
+      -- | The decorrelation weight for channel A: @-1024 <= weight <=
+      --   1024@
       , dpWeightA  ∷ !Int16
-      -- | The decorrelation weight for channel B: -1024 <= weight <=
-      --   1024
+      -- | The decorrelation weight for channel B: @-1024 <= weight <=
+      --   1024@
       , dpWeightB  ∷ !Int16
       -- | The decorrelation samples for channel A.
       , dpSamplesA ∷ !(UV.Vector Int32)
diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index 601d42e..d8c0df1 100644
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -10,6 +10,7 @@ module Codec.Audio.WavPack.Metadata
 
     , Dummy(..)
     , DecorrTerms(..)
+    , DecorrWeights(..)
     , RIFFHeader(..)
     , RIFFTrailer(..)
     , Unknown(..)
@@ -90,10 +91,11 @@ instance Binary SubBlock where
              return $ runGet (getSubBlock rawID) subb
         where
           getSubBlock ∷ Word8 → Get SubBlock
-          getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy      )
-          getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms)
-          getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader )
-          getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer)
+          getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy        )
+          getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms  )
+          getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights)
+          getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader   )
+          getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer  )
           getSubBlock unknownID
               = if unknownID .&. 0x20 ≡ 0 then
                     fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
@@ -128,7 +130,7 @@ instance Binary Dummy where
 -- | Decorrelation terms and deltas.
 data DecorrTerms
     = DecorrTerms {
-        -- | [ (term, delta) ]
+        -- | @[ (term, delta) ]@
         dectVec ∷ !(UV.Vector (Int8, Int8))
       }
     deriving (Eq, Show, Typeable)
@@ -146,7 +148,6 @@ instance Binary DecorrTerms where
                                .|.
                                ((δ `shiftL` 5) .&. 0xE0)
                              )
-
     get = do n   ← remaining
              vec ← UV.replicateM (fromIntegral n) $ fmap unpackDT getWord8
              -- THINKME: unpack.c(read_decorr_terms) reverses the
@@ -161,6 +162,51 @@ instance Binary DecorrTerms where
                 in
                   (term, δ)
 
+-- | Decorrelation weights.
+data DecorrWeights
+    = DecorrWeights {
+      -- | For mono blocks, this is a weight vector for the single
+      --   channel. For stereo blocks, it's interleaved as A, B, A, B,
+      --   ...
+        decwVec ∷ !(UV.Vector Int16)
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata DecorrWeights where
+    metaID _ = 0x03
+    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'''
+    get = do n   ← remaining
+             vec ← UV.replicateM (fromIntegral n) $ fmap unpackW getWord8
+             -- THINKME: the same caution as DecorrTerms, but never
+             -- try to reverse the vector simply. 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'''
+
 -- | RIFF header for .wav files (before audio)
 data RIFFHeader
     = RIFFHeader {
-- 
2.40.0