X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=blobdiff_plain;f=Codec%2FAudio%2FWavPack%2FMetadata.hs;h=fcd873b5776ef17f7ad1767e1328848a0a978ad6;hp=f88224161d18b7435b40e78a77262060ff4477fe;hb=e7d7bed418f63de393b316b2b4246f44752b5743;hpb=3750749a13950d505adfcbc328e7a4d6a6a2059c diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs index f882241..fcd873b 100644 --- a/Codec/Audio/WavPack/Metadata.hs +++ b/Codec/Audio/WavPack/Metadata.hs @@ -13,17 +13,24 @@ module Codec.Audio.WavPack.Metadata , DecorrWeights(..) , DecorrSamples(..) , EntropyVars(..) + , WVBitstream(..) , RIFFHeader(..) , RIFFTrailer(..) + , ConfigInfo(..) , Unknown(..) ) where +import qualified Codec.Audio.WavPack.BitString as B import Codec.Audio.WavPack.Internal import Control.Monad import Data.Binary +import Data.Binary.BitPut (putBit, putNBits, runBitPut) import Data.Binary.Get import Data.Binary.Put +import Data.Binary.Strict.BitGet (getBit, runBitGet) +import qualified Data.Binary.Strict.BitGet as BG import Data.Bits +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Int import qualified Data.Strict as S @@ -100,8 +107,10 @@ instance Binary SubBlock where getSubBlock 0x03 = fmap SubBlock (get ∷ Get DecorrWeights) getSubBlock 0x04 = fmap SubBlock (get ∷ Get DecorrSamples) getSubBlock 0x05 = fmap SubBlock (get ∷ Get EntropyVars ) + getSubBlock 0x0A = fmap SubBlock (get ∷ Get WVBitstream ) getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader ) getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer ) + getSubBlock 0x25 = fmap SubBlock (get ∷ Get ConfigInfo ) getSubBlock unknownID = if unknownID .&. 0x20 ≡ 0 then fail ("Unknown WavPack metadata ID: " ⧺ show unknownID) @@ -121,7 +130,7 @@ data Dummy = Dummy { -- | Must be less than 2^25 bytes long due to the limitation -- of WavPack specification. - dumSize ∷ Word32 + dumSize ∷ !Word32 } deriving (Eq, Show, Typeable) @@ -263,15 +272,31 @@ instance Binary EntropyVars where med2 ← fmap exp2 getWord16le return (med0, med1, med2) +-- | WV Bitstream +data WVBitstream + = WVBitstream { + wvStream ∷ !B.BitString + } + deriving (Eq, Show, Typeable) + +instance Metadata WVBitstream where + metaID _ = 0x0A + metaSize = (`div` 8) ∘ B.length ∘ wvStream + +instance Binary WVBitstream where + put = putLazyByteString ∘ B.toByteString ∘ wvStream + get = fmap (WVBitstream ∘ B.fromByteString) getRemainingLazyByteString + -- | RIFF header for .wav files (before audio) data RIFFHeader = RIFFHeader { - riffHeader ∷ L.ByteString + riffHeader ∷ !L.ByteString } deriving (Eq, Show, Typeable) instance Metadata RIFFHeader where metaID _ = 0x21 + metaSize = fromIntegral ∘ L.length ∘ riffHeader instance Binary RIFFHeader where put = putLazyByteString ∘ riffHeader @@ -280,17 +305,156 @@ instance Binary RIFFHeader where -- | RIFF trailer for .wav files (after audio) data RIFFTrailer = RIFFTrailer { - riffTrailer ∷ L.ByteString + riffTrailer ∷ !L.ByteString } deriving (Eq, Show, Typeable) instance Metadata RIFFTrailer where metaID _ = 0x22 + metaSize = fromIntegral ∘ L.length ∘ riffTrailer instance Binary RIFFTrailer where put = putLazyByteString ∘ riffTrailer get = fmap RIFFTrailer getRemainingLazyByteString +-- | Configuration information. +data ConfigInfo + = ConfigInfo { + -- | fast mode + cfgFast ∷ !Bool + -- | high quality mode + , cfgHigh ∷ !Bool + -- | very high + , cfgVeryHigh ∷ !Bool + -- | bitrate is kbps, not bits / sample + , cfgBitrateKbps ∷ !Bool + -- | automatic noise shaping + , cfgAutoShaping ∷ !Bool + -- | shaping mode specified + , cfgShapeOverride ∷ !Bool + -- | joint-stereo mode specified + , cfgJointOverride ∷ !Bool + -- | dynamic noise shaping + , cfgDynamicShaping ∷ !Bool + -- | create executable + , cfgCreateEXE ∷ !Bool + -- | create correction file + , cfgCreateWVC ∷ !Bool + -- | maximize hybrid compression + , cfgOptimizeWVC ∷ !Bool + -- | calc noise in hybrid mode + , cfgCalcNoise ∷ !Bool + -- | obsolete (for information) + , cfgLossyMode ∷ !Bool + -- | extra processing mode level (1-6) + , cfgExtraModeLevel ∷ !(S.Maybe Word8) + -- | no wvx stream w/ floats & big ints + , cfgSkipWVX ∷ !Bool + -- | compute & store MD5 signature + , cfgMD5Checksum ∷ !Bool + -- | merge blocks of equal redundancy + , cfgMergeBlocks ∷ !Bool + -- | optimize for mono streams posing + , cfgOptimizeMono ∷ !Bool + } + deriving (Eq, Show, Typeable) + +instance Metadata ConfigInfo where + metaID _ = 0x25 + metaSize ci + | S.isJust $ cfgExtraModeLevel ci + = 4 + | otherwise + = 3 + +instance Binary ConfigInfo where + put ci + = let !bs = runBitPut $ + do putBit $ cfgOptimizeMono ci + putNBits 2 (0 ∷ Word8) -- unused + putBit $ cfgMergeBlocks ci + putBit $ cfgMD5Checksum ci + putBit $ cfgSkipWVX ci + putBit $ S.isJust $ cfgExtraModeLevel ci + putBit $ cfgLossyMode ci + putBit $ cfgCalcNoise ci + putNBits 2 (0 ∷ Word8) -- unused + putBit $ cfgOptimizeWVC ci + putBit $ cfgCreateWVC ci + putBit $ cfgCreateEXE ci + putBit $ cfgDynamicShaping ci + putBit $ cfgJointOverride ci + putBit $ cfgShapeOverride ci + putBit $ cfgAutoShaping ci + putBit $ cfgBitrateKbps ci + putBit $ cfgVeryHigh ci + putBit $ cfgHigh ci + putBit False -- unused + putBit $ cfgFast ci + putBit False -- unused + in + do putLazyByteString (L.reverse bs) + case cfgExtraModeLevel ci of + S.Nothing → return () + S.Just eml → putWord8 eml + + get = do bs ← getBytes 3 + eml ← do xmode ← fmap (¬) isEmpty + if xmode then + fmap S.Just getWord8 + else + return S.Nothing + let r = runBitGet (S.reverse bs) $ + do optimizeMono ← getBit + BG.skip 2 -- unused + mergeBlocks ← getBit + md5Checksum ← getBit + skipWVX ← getBit + extraMode ← getBit + lossyMode ← getBit + calcNoise ← getBit + BG.skip 2 -- unused + optimizeWVC ← getBit + createWVC ← getBit + createEXE ← getBit + dynamicShaping ← getBit + jointOverride ← getBit + shapeOverride ← getBit + autoShaping ← getBit + bitrateKbps ← getBit + veryHigh ← getBit + high ← getBit + BG.skip 1 -- unused + fast ← getBit + BG.skip 1 -- unused + return ConfigInfo { + cfgFast = fast + , cfgHigh = high + , cfgVeryHigh = veryHigh + , cfgBitrateKbps = bitrateKbps + , cfgAutoShaping = autoShaping + , cfgShapeOverride = shapeOverride + , cfgJointOverride = jointOverride + , cfgDynamicShaping = dynamicShaping + , cfgCreateEXE = createEXE + , cfgCreateWVC = createWVC + , cfgOptimizeWVC = optimizeWVC + , cfgCalcNoise = calcNoise + , cfgLossyMode = lossyMode + , cfgExtraModeLevel = if extraMode then + eml + else + S.Nothing + , cfgSkipWVX = skipWVX + , cfgMD5Checksum = md5Checksum + , cfgMergeBlocks = mergeBlocks + , cfgOptimizeMono = optimizeMono + } + + case r of + Left err → fail err + Right ci → return ci + -- | Unknown but optional metadata found in the WavPack block. data Unknown = Unknown {