, SubBlock
, Dummy(..)
+ , DecorrTerms(..)
+ , RIFFHeader(..)
+ , RIFFTrailer(..)
, Unknown(..)
)
where
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.
return $ runGet (getSubBlock rawID) subb
where
getSubBlock ∷ Word8 → Get SubBlock
- getSubBlock 0x00 = fmap SubBlock (get ∷ Get Dummy)
+ 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
fail ("Unknown WavPack metadata ID: " ⧺ show unknownID)
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 {
+ riffHeader ∷ L.ByteString
+ }
+ deriving (Eq, Show, Typeable)
+
+instance Metadata RIFFHeader where
+ metaID _ = 0x21
+
+instance Binary RIFFHeader where
+ put = putLazyByteString ∘ riffHeader
+ get = fmap RIFFHeader getRemainingLazyByteString
+
+-- | RIFF trailer for .wav files (after audio)
+data RIFFTrailer
+ = RIFFTrailer {
+ riffTrailer ∷ L.ByteString
+ }
+ deriving (Eq, Show, Typeable)
+
+instance Metadata RIFFTrailer where
+ metaID _ = 0x22
+
+instance Binary RIFFTrailer where
+ put = putLazyByteString ∘ riffTrailer
+ get = fmap RIFFTrailer getRemainingLazyByteString
+
-- | Unknown but optional metadata found in the WavPack block.
data Unknown
= Unknown {
instance Metadata Unknown where
metaID = unkID
- metaSize = fromIntegral ∘ L.length ∘ unkData
instance Binary Unknown where
put = putLazyByteString ∘ unkData
- get = (⊥)
+ get = error "unsupported operation"