working on decorrStereoPass...

diff --git a/Codec/Audio/WavPack/Decorrelation.hs b/Codec/Audio/WavPack/Decorrelation.hs
index 5fc22f073a0a4ba7b20ce880352552c8a544074a..0230244b90ff045da22c8579e475aab0c59519c1 100644 (file)
--- a/Codec/Audio/WavPack/Decorrelation.hs
+++ b/Codec/Audio/WavPack/Decorrelation.hs
@@ -1,13 +1,22 @@
 {-# LANGUAGE
-    UnicodeSyntax
+    DoAndIfThenElse
+  , FlexibleContexts
+  , ScopedTypeVariables
+  , UnicodeSyntax
   #-}
 -- | FIXME
 module Codec.Audio.WavPack.Decorrelation
     ( DecorrPass(..)
+    , decorrStereoPass
     )
     where
+import Control.Monad.ST
+import Data.Bits
 import Data.Int
-import qualified Data.Vector.Unboxed as UV
+import Data.STRef
+import qualified Data.Strict as S
+import qualified Data.Vector.Generic.Mutable as MV
+import Prelude.Unicode
 
 {-
 maxTerm ∷ Num a ⇒ a
@@ -15,7 +24,7 @@ maxTerm = 8
 -}
 
 -- | FIXME
-data DecorrPass
+data DecorrPass v s
     = DecorrPass {
       -- | The decorrelation term: @(term /= 0) && ((-3 <= term <= 8)
       --   || (term == 17) || (term <= 18))@
@@ -24,13 +33,46 @@ data DecorrPass
       , dpDelta    ∷ !Int8
       -- | The decorrelation weight for channel A: @-1024 <= weight <=
       --   1024@
-      , dpWeightA  ∷ !Int16
+      , dpWeightA  ∷ !(STRef s Int16)
       -- | The decorrelation weight for channel B: @-1024 <= weight <=
       --   1024@
-      , dpWeightB  ∷ !Int16
+      , dpWeightB  ∷ !(S.Maybe (STRef s Int16))
       -- | The decorrelation samples for channel A.
-      , dpSamplesA ∷ !(UV.Vector Int32)
+      , dpSamplesA ∷ !(v s Int32)
       -- | The decorrelation samples for channel B.
-      , dpSamplesB ∷ !(UV.Vector Int32)
+      , dpSamplesB ∷ !(S.Maybe (v s Int32))
       }
-    deriving (Eq, Show)
+
+-- |General function to perform stereo decorrelation pass on specified
+-- buffer (although since this is the reverse function it might
+-- technically be called /correlation/ instead). This version handles
+-- all sample resolutions and weight deltas. The dpSamplesX data is
+-- *not* returned normalized for term values 1-8, so it should be
+-- normalized if it is going to be used to call this function again.
+decorrStereoPass ∷ ∀v s. MV.MVector v Int32
+                 ⇒ DecorrPass v s
+                 → v s Int32
+                 → ST s ()
+{-# INLINEABLE decorrStereoPass #-}
+decorrStereoPass dp buffer
+    | dpTerm dp ≡ 17
+        = flip mapM_ [0 .. (MV.length buffer `div` 2) - 1] $ \n →
+              do a0 ← MV.unsafeRead (dpSamplesA dp) 0
+                 a1 ← MV.unsafeRead (dpSamplesA dp) 1
+                 let samA = 2 ⋅ a0 - a1
+                 MV.unsafeWrite (dpSamplesA dp) 1 a0
+                 tmpA ← MV.unsafeRead buffer (n ⋅ 2)
+                 fail "FIXME"
+    | otherwise
+        = fail "FIXME"
+
+applyWeight ∷ Int16 → Int32 → Int32
+{-# INLINE applyWeight #-}
+applyWeight weight sample
+    | sample `shiftR` 0xFFFF ≡ 0
+        = (fromIntegral weight ⋅ sample + 512) `shiftR` 10
+    | otherwise
+        = ( (((sample .&. 0xFFFF) ⋅ fromIntegral weight) `shiftR` 9) +
+            (((sample .&. complement 0xFFFF) `shiftR` 9) ⋅ fromIntegral weight) +
+            1
+          ) `shiftR` 1

diff --git a/Codec/Audio/WavPack/Unpack.hs b/Codec/Audio/WavPack/Unpack.hs
index 33c51522df4ea463bf641c2de927795961af1a64..98d9f4eb8a140411b8055da98afd630940dc630a 100644 (file)
--- a/Codec/Audio/WavPack/Unpack.hs
+++ b/Codec/Audio/WavPack/Unpack.hs
@@ -10,19 +10,27 @@ module Codec.Audio.WavPack.Unpack
     )
     where
 import Codec.Audio.WavPack.Block
+import Codec.Audio.WavPack.Words
 import Control.Monad.ST
+import Data.Bits
+import Data.Bitstream.Generic (Bitstream)
 import Data.Int
 import Data.STRef
+import qualified Data.Strict as S
 import qualified Data.Vector.Generic.Mutable as MV
 import Data.Word
 import Prelude.Unicode
 
 -- | FIXME
-data WavpackStream s
+data WavpackStream bs s
     = WavpackStream {
-        wpsHeader      ∷ !BlockHeader
+        wpsWVBlock     ∷ !Block
+      , wpsWVCBlock    ∷ !(S.Maybe Block)
+      , wpsWordsData   ∷ !(WordsData s)
       , wpsMuteError   ∷ !(STRef s Bool)
       , wpsSampleIndex ∷ !(STRef s Word32)
+      , wpsWVBits      ∷ !(STRef s bs)
+      , wpsWVCBits     ∷ !(S.Maybe (STRef s bs))
       }
 
 -- |This monster actually unpacks the WavPack bitstream(s) into the
@@ -32,16 +40,24 @@ data WavpackStream s
 -- returned in longs. It is up to the caller to potentially reformat
 -- this for the final output including any multichannel distribution,
 -- block alignment or endian compensation.
-unpackSamples ∷ ∀v s. (MV.MVector v Int32)
-              ⇒ WavpackStream s
+unpackSamples ∷ ∀bs v s. (Bitstream bs, MV.MVector v Int32)
+              ⇒ WavpackStream bs s
               → Int    -- ^ Number of channels.
               → Int    -- ^ Reduced number of channels (1 or 2).
               → Word32 -- ^ Number of samples to get.
               → ST s (v s Int32)
 {-# INLINEABLE unpackSamples #-}
 unpackSamples wps numChannels reducedChannels nSamples0
-    = do let hdr   = wpsHeader wps
-             flags = bhFlags hdr
+    = do let hdr        = blockHeader $ wpsWVBlock wps
+             flags      = bhFlags hdr
+             muteLimit0 = (1 `shiftL` fromIntegral (bfMaxMagnitude flags)) + 2
+             muteLimit ∷ Int32 -- FIXME: Do we really need to explicitly type this?
+             muteLimit
+                 | bfHybrid flags ∧ S.isNothing (wpsWVCBlock wps)
+                     = muteLimit0 ⋅ 2
+                 | otherwise
+                     = muteLimit0
+
          nSamples ← do idx ← readSTRef (wpsSampleIndex wps)
                        if idx + nSamples0 > bhBlockIndex hdr + bhBlockSamples hdr then
                            return $ bhBlockIndex hdr + bhBlockSamples hdr - idx
@@ -57,4 +73,23 @@ unpackSamples wps numChannels reducedChannels nSamples0
                 modifySTRef (wpsSampleIndex wps) (+ nSamples)
                 return v
          else
-             error "FIXME"
+             do v ← if S.isNothing (wpsWVCBlock wps) ∧ bfMono flags then
+                       -- handle lossless or hybrid lossy mono data
+                       fail "FIXME: unsupported stream type: monaural stream"
+                    else
+                       if S.isNothing (wpsWVCBlock wps) ∧ (¬) (bfMono flags) then
+                           -- handle lossless or hybrid lossy stereo data
+                           do v ← if bfHybrid flags then
+                                       fail "FIXME: unsupported stream type: lossy stereo stream"
+                                   else
+                                       getWordsLossless
+                                           (bfMono flags)
+                                           (wpsWordsData wps)
+                                           (wpsWVBits wps)
+                                           nSamples
+                              error "FIXME"
+                              return v
+                       else
+                           error "FIXME"
+                error "FIXME"
+                return v