DecorrTerms

diff --git a/Codec/Audio/WavPack/Decorrelation.hs b/Codec/Audio/WavPack/Decorrelation.hs
new file mode 100644 (file)
index 0000000..b72909f
--- /dev/null
+++ b/Codec/Audio/WavPack/Decorrelation.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
+-- | FIXME
+module Codec.Audio.WavPack.Decorrelation
+    ( DecorrPass(..)
+    )
+    where
+import Data.Int
+import qualified Data.Vector.Unboxed as UV
+
+{-
+maxTerm ∷ Num a ⇒ a
+maxTerm = 8
+-}
+
+-- | FIXME
+data DecorrPass
+    = DecorrPass {
+      -- | The decorrelation term: (term /= 0) && ((-3 <= term <= 8)
+      --   || (term == 17) || (term <= 18))
+        dpTerm     ∷ !Int8
+      -- | The decorrelation delta: 0 <= delta <= 8
+      , dpDelta    ∷ !Int8
+      -- | The decorrelation weight for channel A: -1024 <= weight <=
+      --   1024
+      , dpWeightA  ∷ !Int16
+      -- | The decorrelation weight for channel B: -1024 <= weight <=
+      --   1024
+      , dpWeightB  ∷ !Int16
+      -- | The decorrelation samples for channel A.
+      , dpSamplesA ∷ !(UV.Vector Int32)
+      -- | The decorrelation samples for channel B.
+      , dpSamplesB ∷ !(UV.Vector Int32)
+      }
+    deriving (Eq, Show)

diff --git a/Codec/Audio/WavPack/Metadata.hs b/Codec/Audio/WavPack/Metadata.hs
index bc1d07c3bd2059f940546b9fc2ad4bb18a65f00a..601d42e666b8d45b2e68be9b28b9424af5feafec 100644 (file)
--- a/Codec/Audio/WavPack/Metadata.hs
+++ b/Codec/Audio/WavPack/Metadata.hs
@@ -9,6 +9,7 @@ module Codec.Audio.WavPack.Metadata
     , SubBlock
 
     , Dummy(..)
+    , DecorrTerms(..)
     , RIFFHeader(..)
     , RIFFTrailer(..)
     , Unknown(..)
@@ -20,7 +21,9 @@ import Data.Binary.Get
 import Data.Binary.Put
 import Data.Bits
 import qualified Data.ByteString.Lazy as L
+import Data.Int
 import Data.Typeable
+import qualified Data.Vector.Unboxed as UV
 import Prelude.Unicode
 
 -- | Type class for every metadata sub-blocks.
@@ -87,8 +90,9 @@ instance Binary SubBlock where
              return $ runGet (getSubBlock rawID) subb
         where
           getSubBlock ∷ Word8 → Get SubBlock
-          getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy)
-          getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader)
+          getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy      )
+          getSubBlock 0x02 = fmap SubBlock (get ∷ Get DecorrTerms)
+          getSubBlock 0x21 = fmap SubBlock (get ∷ Get RIFFHeader )
           getSubBlock 0x22 = fmap SubBlock (get ∷ Get RIFFTrailer)
           getSubBlock unknownID
               = if unknownID .&. 0x20 ≡ 0 then
@@ -121,6 +125,42 @@ instance Binary Dummy where
     put = putLazyByteString ∘ flip L.replicate 0x00 ∘ fromIntegral ∘ dumSize
     get = fmap (Dummy ∘ fromIntegral) remaining
 
+-- | Decorrelation terms and deltas.
+data DecorrTerms
+    = DecorrTerms {
+        -- | [ (term, delta) ]
+        dectVec ∷ !(UV.Vector (Int8, Int8))
+      }
+    deriving (Eq, Show, Typeable)
+
+instance Metadata DecorrTerms where
+    metaID _ = 0x02
+    metaSize = fromIntegral ∘ UV.length ∘ dectVec
+
+instance Binary DecorrTerms where
+    put = UV.mapM_ (putWord8 ∘ packDT) ∘ dectVec
+        where
+          packDT ∷ (Int8, Int8) → Word8
+          packDT (term, δ)
+              = fromIntegral ( (term + 5 .&. 0x1F)
+                               .|.
+                               ((δ `shiftL` 5) .&. 0xE0)
+                             )
+
+    get = do n   ← remaining
+             vec ← UV.replicateM (fromIntegral n) $ fmap unpackDT getWord8
+             -- THINKME: unpack.c(read_decorr_terms) reverses the
+             -- order only when they are decoding. I don't know why so
+             -- I leave it unreversed for now.
+             return $ DecorrTerms vec
+        where
+          unpackDT ∷ Word8 → (Int8, Int8)
+          unpackDT w
+              = let term = (fromIntegral $ w .&. 0x1F) - 5
+                    δ    = fromIntegral $ (w `shiftR` 5) .&. 0x07
+                in
+                  (term, δ)
+
 -- | RIFF header for .wav files (before audio)
 data RIFFHeader
     = RIFFHeader {
@@ -165,4 +205,4 @@ instance Metadata Unknown where
 
 instance Binary Unknown where
     put = putLazyByteString ∘ unkData
-    get = (⊥)
+    get = error "unsupported operation"

diff --git a/examples/WvInfo.hs b/examples/WvInfo.hs
index 8b1f5b4dfdafbf659d46b34fc136e972ace9a5f5..5e0b86fbe62bdbd020e6dc76bbbbcf78752808a3 100644 (file)
--- a/examples/WvInfo.hs
+++ b/examples/WvInfo.hs
@@ -7,10 +7,12 @@ import Codec.Audio.WavPack.Block
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Strict as S
 import System.Environment
+import System.IO
 
 main ∷ IO ()
 main = do [wvFile] ← getArgs
           wvStream ← L.readFile wvFile
+          hSetBuffering stdout NoBuffering
           showWvInfo wvStream
 
 showWvInfo ∷ L.ByteString → IO ()

diff --git a/wavpack.cabal b/wavpack.cabal
index 740e60ac06c6ad3d3c1f3b99b4f6db13466246fc..cead654fc62e49663a38ee9335d30c9a548b16ad 100644 (file)
--- a/wavpack.cabal
+++ b/wavpack.cabal
@@ -31,11 +31,13 @@ Library
         binary               == 0.5.*,
         binary-strict        == 0.4.*,
         bytestring           == 0.9.*,
-        strict               == 0.3.*
+        strict               == 0.3.*,
+        vector               == 0.7.*
 
     Exposed-Modules:
         Codec.Audio.WavPack
         Codec.Audio.WavPack.Block
+        Codec.Audio.WavPack.Decorrelation
         Codec.Audio.WavPack.Metadata
 
     GHC-Options: