working on decorrStereoPass...
[wavpack.git] / 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