Codec/Audio/WavPack/Decorrelation.hs

   1 {-# LANGUAGE
   2     DoAndIfThenElse
   3   , FlexibleContexts
   4   , ScopedTypeVariables
   5   , UnicodeSyntax
   6   #-}
   7 -- | FIXME
   8 module Codec.Audio.WavPack.Decorrelation
   9     ( DecorrPass(..)
  10     , decorrStereoPass
  11     )
  12     where
  13 import Control.Monad.ST
  14 import Data.Bits
  15 import Data.Int
  16 import Data.STRef
  17 import qualified Data.Strict as S
  18 import qualified Data.Vector.Generic.Mutable as MV
  19 import Prelude.Unicode
  20
  21 {-
  22 maxTerm ∷ Num a ⇒ a
  23 maxTerm = 8
  24 -}
  25
  26 -- | FIXME
  27 data DecorrPass v s
  28     = DecorrPass {
  29       -- | The decorrelation term: @(term /= 0) && ((-3 <= term <= 8)
  30       --   || (term == 17) || (term <= 18))@
  31         dpTerm     ∷ !Int8
  32       -- | The decorrelation delta: @0 <= delta <= 8@
  33       , dpDelta    ∷ !Int8
  34       -- | The decorrelation weight for channel A: @-1024 <= weight <=
  35       --   1024@
  36       , dpWeightA  ∷ !(STRef s Int16)
  37       -- | The decorrelation weight for channel B: @-1024 <= weight <=
  38       --   1024@
  39       , dpWeightB  ∷ !(S.Maybe (STRef s Int16))
  40       -- | The decorrelation samples for channel A.
  41       , dpSamplesA ∷ !(v s Int32)
  42       -- | The decorrelation samples for channel B.
  43       , dpSamplesB ∷ !(S.Maybe (v s Int32))
  44       }
  45
  46 -- |General function to perform stereo decorrelation pass on specified
  47 -- buffer (although since this is the reverse function it might
  48 -- technically be called /correlation/ instead). This version handles
  49 -- all sample resolutions and weight deltas. The dpSamplesX data is
  50 -- *not* returned normalized for term values 1-8, so it should be
  51 -- normalized if it is going to be used to call this function again.
  52 decorrStereoPass ∷ ∀v s. MV.MVector v Int32
  53                  ⇒ DecorrPass v s
  54                  → v s Int32
  55                  → ST s ()
  56 {-# INLINEABLE decorrStereoPass #-}
  57 decorrStereoPass dp buffer
  58     | dpTerm dp ≡ 17
  59         = flip mapM_ [0 .. (MV.length buffer `div` 2) - 1] $ \n →
  60               do a0 ← MV.unsafeRead (dpSamplesA dp) 0
  61                  a1 ← MV.unsafeRead (dpSamplesA dp) 1
  62                  let samA = 2 ⋅ a0 - a1
  63                  MV.unsafeWrite (dpSamplesA dp) 1 a0
  64                  tmpA ← MV.unsafeRead buffer (n ⋅ 2)
  65                  fail "FIXME"
  66     | otherwise
  67         = fail "FIXME"
  68
  69 applyWeight ∷ Int16 → Int32 → Int32
  70 {-# INLINE applyWeight #-}
  71 applyWeight weight sample
  72     | sample `shiftR` 0xFFFF ≡ 0
  73         = (fromIntegral weight ⋅ sample + 512) `shiftR` 10
  74     | otherwise
  75         = ( (((sample .&. 0xFFFF) ⋅ fromIntegral weight) `shiftR` 9) +
  76             (((sample .&. complement 0xFFFF) `shiftR` 9) ⋅ fromIntegral weight) +
  77             1
  78           ) `shiftR` 1