, Dummy(..)
, DecorrTerms(..)
, DecorrWeights(..)
+ , DecorrSamples(..)
+ , EntropyVars(..)
, RIFFHeader(..)
, RIFFTrailer(..)
, Unknown(..)
)
where
+import Codec.Audio.WavPack.Internal
import Control.Monad
import Data.Binary
import Data.Binary.Get
import Data.Bits
import qualified Data.ByteString.Lazy as L
import Data.Int
+import qualified Data.Strict as S
import Data.Typeable
import qualified Data.Vector.Unboxed as UV
import Prelude.Unicode
getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy )
getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms )
getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights)
+ getSubBlock 0x04 = fmap SubBlock (get ∷ Get DecorrSamples)
+ getSubBlock 0x05 = fmap SubBlock (get ∷ Get EntropyVars )
getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader )
getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer )
getSubBlock unknownID
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'''
+ put = UV.mapM_ (putWord8 ∘ packWeight) ∘ decwVec
get = do n ← remaining
- vec ← UV.replicateM (fromIntegral n) $ fmap unpackW getWord8
+ vec ← UV.replicateM (fromIntegral n)
+ $ fmap unpackWeight getWord8
-- THINKME: the same caution as DecorrTerms, but never
- -- try to reverse the vector simply. Think about the
+ -- try to simply reverse the vector. Think about the
-- interleaving.
return $ DecorrWeights vec
+
+-- | Decorrelation samples
+data DecorrSamples
+ = DecorrSamples {
+ -- | The decorrelation sample vector stored in the metadata
+ -- as-is. Actual interpretation of the vector depends on the
+ -- number of channels and each corresponding decorrelation
+ -- terms.
+ decsVec ∷ !(UV.Vector Int32)
+ }
+ deriving (Eq, Show, Typeable)
+
+instance Metadata DecorrSamples where
+ metaID _ = 0x04
+ metaSize = fromIntegral ∘ (⋅ 2) ∘ UV.length ∘ decsVec
+
+instance Binary DecorrSamples where
+ put = UV.mapM_ (putWord16le ∘ fromIntegral ∘ log2s) ∘ decsVec
+ get = do n ← remaining
+ vec ← UV.replicateM (fromIntegral $ n `div` 2)
+ $ fmap (exp2s ∘ fromIntegral) getWord16le
+ return $ DecorrSamples vec
+
+-- | Median log2 values.
+data EntropyVars
+ = EntropyVars {
+ -- | Median log2 values for channel A, which always exists.
+ entVarA ∷ !(Word32, Word32, Word32)
+ -- | Median log2 values for channel B, which is absent when it's
+ -- mono.
+ , entVarB ∷ !(S.Maybe (Word32, Word32, Word32))
+ }
+ deriving (Eq, Show, Typeable)
+
+instance Metadata EntropyVars where
+ metaID _ = 0x05
+ metaSize ev
+ | S.isNothing $ entVarB ev = 6
+ | otherwise = 12
+
+instance Binary EntropyVars where
+ put ev
+ = do putMedians $ entVarA ev
+ case entVarB ev of
+ S.Nothing → return ()
+ S.Just medsB → putMedians medsB
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'''
+ -- THINKME: words.c(write_entropy_vars) is a destructive
+ -- subroutine. It calls read_entropy_vars() to read the
+ -- values back to compensate for the loss through the log
+ -- function.
+ putMedians ∷ (Word32, Word32, Word32) → Put
+ putMedians (med0, med1, med2)
+ = do putWord16le $ log2 med0
+ putWord16le $ log2 med1
+ putWord16le $ log2 med2
+
+ get = do medsA ← getMedians
+ medsB ← do isMono ← isEmpty
+ if isMono then
+ return S.Nothing
+ else
+ fmap S.Just getMedians
+ return $! EntropyVars medsA medsB
+ where
+ getMedians ∷ Get (Word32, Word32, Word32)
+ getMedians
+ = do med0 ← fmap exp2 getWord16le
+ med1 ← fmap exp2 getWord16le
+ med2 ← fmap exp2 getWord16le
+ return (med0, med1, med2)
-- | RIFF header for .wav files (before audio)
data RIFFHeader