X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=wavpack.git;a=blobdiff_plain;f=Codec%2FAudio%2FWavPack%2FUnpack.hs;h=98d9f4eb8a140411b8055da98afd630940dc630a;hp=f816657e9924e8b105b7bf99c232fdf5fb40332f;hb=14e615d1521862ddfab67156d48e00798b1615bc;hpb=c12220b6ce900bced2b48b1fbc3a098e06d94946

diff --git a/Codec/Audio/WavPack/Unpack.hs b/Codec/Audio/WavPack/Unpack.hs
index f816657..98d9f4e 100644
--- a/Codec/Audio/WavPack/Unpack.hs
+++ b/Codec/Audio/WavPack/Unpack.hs
@@ -1,40 +1,95 @@
 {-# LANGUAGE
-    BangPatterns
-  , UnboxedTuples
+    DoAndIfThenElse
+  , FlexibleContexts
+  , ScopedTypeVariables
   , UnicodeSyntax
   #-}
 module Codec.Audio.WavPack.Unpack
-    (
+    ( WavpackStream(..)
+    , unpackSamples
     )
     where
-import Codec.Audio.WavPack.Internal
+import Codec.Audio.WavPack.Block
+import Codec.Audio.WavPack.Words
+import Control.Monad.ST
 import Data.Bits
 import Data.Bitstream.Generic (Bitstream)
-import qualified Data.Bitstream.Generic as B
+import Data.Int
+import Data.STRef
+import qualified Data.Strict as S
+import qualified Data.Vector.Generic.Mutable as MV
 import Data.Word
 import Prelude.Unicode
 
--- 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
--- whether another bit is needed to define the code.
-readCode ∷ Bitstream bs ⇒ bs → Word32 → (# Word32, bs #)
-{-# INLINEABLE readCode #-}
-readCode bs 0       = (# 0, bs #)
-readCode bs 1       = (# b2n (B.head bs), B.tail bs #)
-readCode bs maxCode
-    = let !bitCount = countBits maxCode
-          !extras   = bit bitCount - maxCode - 1
-          !code     = B.toBits (B.take (bitCount - 1) bs)
-          (# code', bitCount' #)
-                    = if code ≥ extras then
-                          (# (code `shiftL` 1)
-                             - extras
-                             + b2n (bs B.!! bitCount)
-                           , bitCount #)
-                      else
-                          (# code, bitCount - 1 #)
-          !bs'      = B.drop bitCount' bs
-      in
-        (# code', bs' #)
+-- | FIXME
+data WavpackStream bs s
+    = WavpackStream {
+        wpsWVBlock     ∷ !Block
+      , wpsWVCBlock    ∷ !(S.Maybe Block)
+      , wpsWordsData   ∷ !(WordsData s)
+      , wpsMuteError   ∷ !(STRef s Bool)
+      , wpsSampleIndex ∷ !(STRef s Word32)
+      , wpsWVBits      ∷ !(STRef s bs)
+      , wpsWVCBits     ∷ !(S.Maybe (STRef s bs))
+      }
+
+-- |This monster actually unpacks the WavPack bitstream(s) into the
+-- specified buffer as 32-bit integers or floats (depending on orignal
+-- data). Lossy samples will be clipped to their original limits
+-- (i.e. 8-bit samples are clipped to -128/+127) but are still
+-- returned in longs. It is up to the caller to potentially reformat
+-- this for the final output including any multichannel distribution,
+-- block alignment or endian compensation.
+unpackSamples ∷ ∀bs v s. (Bitstream bs, MV.MVector v Int32)
+              ⇒ WavpackStream bs s
+              → Int    -- ^ Number of channels.
+              → Int    -- ^ Reduced number of channels (1 or 2).
+              → Word32 -- ^ Number of samples to get.
+              → ST s (v s Int32)
+{-# INLINEABLE unpackSamples #-}
+unpackSamples wps numChannels reducedChannels nSamples0
+    = do let hdr        = blockHeader $ wpsWVBlock wps
+             flags      = bhFlags hdr
+             muteLimit0 = (1 `shiftL` fromIntegral (bfMaxMagnitude flags)) + 2
+             muteLimit ∷ Int32 -- FIXME: Do we really need to explicitly type this?
+             muteLimit
+                 | bfHybrid flags ∧ S.isNothing (wpsWVCBlock wps)
+                     = muteLimit0 ⋅ 2
+                 | otherwise
+                     = muteLimit0
+
+         nSamples ← do idx ← readSTRef (wpsSampleIndex wps)
+                       if idx + nSamples0 > bhBlockIndex hdr + bhBlockSamples hdr then
+                           return $ bhBlockIndex hdr + bhBlockSamples hdr - idx
+                       else
+                           return nSamples0
+
+         muteError ← readSTRef (wpsMuteError wps)
+         if muteError then
+             do v ← if reducedChannels ≡ 1 ∨ numChannels ≡ 1 ∨ bfMono flags then
+                        MV.replicate (fromIntegral nSamples) 0
+                    else
+                        MV.replicate (fromIntegral nSamples ⋅ 2) 0
+                modifySTRef (wpsSampleIndex wps) (+ nSamples)
+                return v
+         else
+             do v ← if S.isNothing (wpsWVCBlock wps) ∧ bfMono flags then
+                       -- handle lossless or hybrid lossy mono data
+                       fail "FIXME: unsupported stream type: monaural stream"
+                    else
+                       if S.isNothing (wpsWVCBlock wps) ∧ (¬) (bfMono flags) then
+                           -- handle lossless or hybrid lossy stereo data
+                           do v ← if bfHybrid flags then
+                                       fail "FIXME: unsupported stream type: lossy stereo stream"
+                                   else
+                                       getWordsLossless
+                                           (bfMono flags)
+                                           (wpsWordsData wps)
+                                           (wpsWVBits wps)
+                                           nSamples
+                              error "FIXME"
+                              return v
+                       else
+                           error "FIXME"
+                error "FIXME"
+                return v