From: PHO Date: Sun, 9 Jan 2011 05:13:21 +0000 (+0900) Subject: ConfigInfo X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=commitdiff_plain;h=fc5bbbe214bd5b31684fd54f9e7e70557bf872ef ConfigInfo --- diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs index 7879cf1..aff1da3 100644 --- a/Codec/Audio/WavPack/Block.hs +++ b/Codec/Audio/WavPack/Block.hs @@ -17,8 +17,8 @@ import Data.Binary import Data.Binary.BitPut (putBit, putNBits, runBitPut) import Data.Binary.Get import Data.Binary.Put -import qualified Data.Binary.Strict.BitGet as BG import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet) +import qualified Data.Binary.Strict.BitGet as BG import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Strict as S diff --git a/Codec/Audio/WavPack/Internal.hs b/Codec/Audio/WavPack/Internal.hs index b852a76..bb4cd37 100644 --- a/Codec/Audio/WavPack/Internal.hs +++ b/Codec/Audio/WavPack/Internal.hs @@ -70,7 +70,7 @@ log2s !n -- zero and can therefore represent both zero and negative -- values. They have 8 bits of precision and in \"roundtrip\" -- conversions the total error never exceeds 1 part in 225 except for --- the cases of +/-115 and +/-195 (which error by 1). +-- the cases of +\/-115 and +\/-195 (which error by 1). -- -- This function returns the log2 for the specified 32-bit unsigned -- value. The maximum value allowed is about 0xff800000 and returns diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs index f882241..09bceb8 100644 --- a/Codec/Audio/WavPack/Metadata.hs +++ b/Codec/Audio/WavPack/Metadata.hs @@ -15,15 +15,20 @@ module Codec.Audio.WavPack.Metadata , EntropyVars(..) , RIFFHeader(..) , RIFFTrailer(..) + , ConfigInfo(..) , Unknown(..) ) where 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 @@ -102,6 +107,7 @@ instance Binary SubBlock where getSubBlock 0x05 = fmap SubBlock (get ∷ Get EntropyVars ) 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) @@ -291,6 +297,144 @@ 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 { diff --git a/wavpack.cabal b/wavpack.cabal index 7001778..f5ad92c 100644 --- a/wavpack.cabal +++ b/wavpack.cabal @@ -1,7 +1,12 @@ Name: wavpack Synopsis: A Haskell implementation of the WavPack audio compression codec Description: - A Haskell implementation of the WavPack audio compression codec: + + A Haskell implementation of the WavPack audio compression + codec: + + This implementation is currently based on wavpack-4.50.1. + Version: 0.1 License: PublicDomain License-File: COPYING