working on getWordsLossless...

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

diff --git a/Codec/Audio/WavPack/Words.hs b/Codec/Audio/WavPack/Words.hs
index 09235472ba308379a99659ffd0218a94e82ee3c9..fb08b5e68875d280f93dfca55ef2b08e1be2576d 100644 (file)
--- a/Codec/Audio/WavPack/Words.hs
+++ b/Codec/Audio/WavPack/Words.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE
     BangPatterns
+  , FlexibleContexts
+  , ScopedTypeVariables
   , UnboxedTuples
   , UnicodeSyntax
   #-}
@@ -13,6 +15,11 @@ import Codec.Audio.WavPack.Internal
 import Data.Bits
 import Data.Bitstream.Generic (Bitstream)
 import qualified Data.Bitstream.Generic as B
+import Data.Int
+import qualified Data.Vector.Generic as GV
+import qualified Data.Vector.Generic.Mutable as MV
+import Data.Vector.Generic.New (New)
+import qualified Data.Vector.Generic.New as New
 import Data.Word
 import Prelude.Unicode
 
@@ -30,13 +37,47 @@ data WordsData
       }
     deriving (Eq, Show)
 
--- This is an optimized version of 'getWord' that is used for lossless
--- only (error_limit ≡ 0). Also, rather than obtaining a single
--- sample, it can be used to obtain an entire buffer of either mono or
--- stereo samples.
---getWordsLossless ∷ 
+-- | This is an optimized version of 'getWord' that is used for
+-- lossless only ('edErrorLimit' ≡ 0). Also, rather than obtaining a
+-- single sample, it can be used to obtain an entire buffer of either
+-- mono or stereo samples.
+getWordsLossless ∷ ∀bs n v. (Bitstream bs, Integral n, GV.Vector v Int32)
+                 ⇒ Bool -- ^ Is the stream monaural?
+                 → WordsData
+                 → bs -- ^ WV bitstream.
+                 → n  -- ^ Number of samples to get.
+                 → (# WordsData, bs, v Int32 #)
+{-# INLINEABLE getWordsLossless #-}
+getWordsLossless isMono w0 bs0 nSamples0
+    = let v0  = New.create $ MV.new $ fromIntegral nSamples
+          (# w1, bs1, n1, v1 #)
+              = go w0 bs0 0 v0
+          v2  = GV.new $ New.take (fromIntegral n1) v1
+      in
+        (# w1, bs1, v2 #)
+    where
+      nSamples ∷ n
+      {-# INLINE nSamples #-}
+      nSamples = if isMono
+                 then nSamples0
+                 else nSamples0 ⋅ 2
+
+      go ∷ WordsData
+         → bs
+         → n
+         → New v Int32
+         → (# WordsData, bs, n, New v Int32 #)
+      {-# INLINE go #-}
+      go w bs n v
+          | n ≥ nSamples = (# w, bs, n, v #)
+          | otherwise
+              = error "FIXME"
+          where
+            c ∷ EntropyData
+            c | n `rem` 2 ≡ 0 = fst $ wdEntropyData w
+              | otherwise     = snd $ wdEntropyData w
 
--- Read a single unsigned value from the specified bitstream with a
+-- | Read a single unsigned value from the specified bitstream with a
 -- value from 0 to maxCode. If there are exactly a power of two number
 -- of possible codes then this will read a fixed number of bits;
 -- otherwise it reads the minimum number of bits and then determines