X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=blobdiff_plain;f=Codec%2FAudio%2FWavPack%2FMetadata.hs;h=09bceb873927fdc0c8da3fd7a34cd45d41f2792e;hp=f88224161d18b7435b40e78a77262060ff4477fe;hb=fc5bbbe214bd5b31684fd54f9e7e70557bf872ef;hpb=3750749a13950d505adfcbc328e7a4d6a6a2059c

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 {