EntropyVars

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index 00e1d02e2631340d426f66a04d9909bc26364d8f..f88224161d18b7435b40e78a77262060ff4477fe 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -12,6 +12,7 @@ module Codec.Audio.WavPack.Metadata
     , DecorrTerms(..)
     , DecorrWeights(..)
     , DecorrSamples(..)
+    , EntropyVars(..)
     , RIFFHeader(..)
     , RIFFTrailer(..)
     , Unknown(..)
@@ -25,6 +26,7 @@ import Data.Binary.Put
 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
@@ -97,6 +99,7 @@ instance Binary SubBlock where
           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
@@ -211,6 +214,55 @@ instance Binary DecorrSamples where
                     $ 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
+          -- 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
     = RIFFHeader {