From: PHO Date: Sun, 24 Jul 2011 09:43:12 +0000 (+0900) Subject: working on decorrStereoPass... X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=commitdiff_plain;h=14e615d1521862ddfab67156d48e00798b1615bc working on decorrStereoPass... --- diff --git a/Codec/Audio/WavPack/Decorrelation.hs b/Codec/Audio/WavPack/Decorrelation.hs index 5fc22f0..0230244 100644 --- 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 33c5152..98d9f4e 100644 --- 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