WvInfo.hs

[wavpack.git] / Codec / Audio / WavPack / Block.hs

diff --git a/Codec/Audio/WavPack/Block.hs b/Codec/Audio/WavPack/Block.hs
index e3732eeba813f0b613537e81442447a38ffd8876..8e46be89f6d3e71310897bd7996c1f27b395b9d2 100644 (file)
--- a/Codec/Audio/WavPack/Block.hs
+++ b/Codec/Audio/WavPack/Block.hs
@@ -5,6 +5,8 @@
 module Codec.Audio.WavPack.Block
     ( BlockHeader(..)
     , BlockFlags(..)
+
+    , findNextHeader 
     )
     where
 import Data.Binary
@@ -15,11 +17,12 @@ import qualified Data.Binary.Strict.BitGet as BG
 import Data.Binary.Strict.BitGet (getBit, getAsWord8, runBitGet)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
+import Prelude.Unicode
 
 -- | The preamble to every block in both the .wv and .wvc files.
 data BlockHeader
     = BlockHeader {
-      -- | size of entire block (minus 8, of course)
+      -- | size of entire block (excluding the header)
         bhSize         ∷ !Word32
       -- | 0x402 to 0x410 are currently valid for decode
       , bhVersion      ∷ !Word16
@@ -37,7 +40,7 @@ data BlockHeader
       -- | number of samples in this block (0 = no audio)
       , bhBlockSamples ∷ !Word32
       -- | various flags for id and decoding
-      , bhFlags        ∷ !BlockHeader
+      , bhFlags        ∷ !BlockFlags
       -- | crc for actual decoded data
       , bhCRC          ∷ !Word32
       }
@@ -49,7 +52,7 @@ instance Binary BlockHeader where
              putWord8 118 -- 'v'
              putWord8 112 -- 'p'
              putWord8 107 -- 'k'
-             putWord32le $ bhSize         bh
+             putWord32le $ bhSize         bh + 32 - 8
              putWord16le $ bhVersion      bh
              putWord8    $ bhTrackNo      bh
              putWord8    $ bhIndexNo      bh
@@ -70,7 +73,7 @@ instance Binary BlockHeader where
              flags        ← get
              crc          ← getWord32le
              return BlockHeader {
-                              bhSize         = size
+                              bhSize         = size + 8 - 32
                             , bhVersion      = version
                             , bhTrackNo      = trackNo
                             , bhIndexNo      = indexNo
@@ -194,3 +197,33 @@ instance Binary BlockFlags where
                                      , bfFalseStereo    = falseStereo
                                      }
              return bf
+
+findNextHeader ∷ L.ByteString → (Maybe BlockHeader, L.ByteString)
+findNextHeader src
+    = case L.uncons src of
+        Nothing
+            → (Nothing, L.empty)
+
+        Just (119, src') -- 'w'
+            → let (header, rest) = L.splitAt 32 src
+               in
+                 case L.length header ≡ 32 of
+                   False
+                       → (Nothing, L.empty)
+
+                   True
+                       → let Just (magicW, header'  ) = L.uncons header
+                             Just (magicV, header'' ) = L.uncons header'
+                             Just (magicP, header''') = L.uncons header''
+                             magicK = L.head header'''
+                         in
+                           if magicW ≡ 119 ∧ magicV ≡ 118 ∧ magicP ≡ 112 ∧ magicK ≡ 107 then
+                               -- Found the magic 'wvpk'.
+                               let bh = runGet get header
+                               in
+                                 (Just bh, rest)
+                           else
+                               findNextHeader src'
+
+        Just (_, src')
+            → findNextHeader src'