module Codec.Audio.WavPack.Words
( WordsData(..)
- , getWordsLossless
+-- , getWordsLossless
)
where
import Codec.Audio.WavPack.Entropy
import Codec.Audio.WavPack.Internal
+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.Vector.Generic as GV
import qualified Data.Vector.Generic.Mutable as MV
import Data.Vector.Generic.New (New)
import Prelude.Unicode
-- | FIXME
-data WordsData
+data WordsData s
= WordsData {
- wdBitrateDelta ∷ !(Word32, Word32)
- , wdBitrateAcc ∷ !(Word32, Word32)
- , wdPendingData ∷ !Word32
- , wdHoldingOne ∷ !Word32
- , wdZeroesAcc ∷ !Word32
- , wdHoldingZero ∷ !Bool
- , wdPendingCount ∷ !Int
- , wdEntropyData ∷ !(EntropyData, EntropyData)
+ wdBitrateDelta ∷ !(STRef s (Word32, Word32))
+ , wdBitrateAcc ∷ !(STRef s (Word32, Word32))
+ , wdPendingData ∷ !(STRef s Word32)
+ , wdHoldingOne ∷ !(STRef s Word32)
+ , wdZeroesAcc ∷ !(STRef s Word32)
+ , wdHoldingZero ∷ !(STRef s Bool)
+ , wdPendingCount ∷ !(STRef s Int)
+ , wdEntropyData ∷ !(EntropyData s, EntropyData s)
}
- deriving (Eq, Show)
-- | 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 v. (Bitstream bs, GV.Vector v Int32)
⇒ Bool -- ^ Is the stream monaural?
→ WordsData
in
go2 0 w' bs n v
| otherwise
- = error "FIXME"
+ = let next8 ∷ Word8
+ next8 = B.toBits (B.take (8 ∷ Int) bs)
+ in
+ if next8 ≡ 0xFF then
+ error "FIXME"
+ else
+ error "FIXME"
go2 ∷ Word32 → WordsData → bs → Int → New v Int32
→ (# WordsData, bs, Int, New v Int32 #)
go2 0 w bs n v
= let ent = getEntropy n w
low = 0
- high = getMedian0 ent
+ high = getMedian0 ent - 1
ent' = decMedian0 ent
w' = setEntropy ent' n w
in
| isMono = w { wdEntropyData = (e, snd $ wdEntropyData w) }
| n `testBit` 0 = w { wdEntropyData = (e, snd $ wdEntropyData w) }
| otherwise = w { wdEntropyData = (fst $ wdEntropyData w, e) }
+-}
-- | 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 #)
+readCode ∷ Bitstream bs ⇒ STRef s bs → Word32 → ST s Word32
{-# INLINEABLE readCode #-}
-readCode bs 0 = (# 0, bs #)
-readCode bs 1 = (# b2n (B.head bs), B.tail bs #)
+readCode bs 0 = return 0
+readCode bs 1 = fmap b2n $ takeHead 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' #)
+ = do let bitCount = countBits maxCode
+ extras = bit bitCount - maxCode - 1
+ code ← takeBits bs (bitCount - 1)
+ if code ≥ extras then
+ do nextBit ← takeHead bs
+ return $ (code `shiftL` 1) - extras + b2n nextBit
+ else
+ return code
+
+takeHead ∷ Bitstream bs ⇒ STRef s bs → ST s Bool
+{-# INLINEABLE takeHead #-}
+takeHead bsr
+ = do bs ← readSTRef bsr
+ writeSTRef bsr (B.tail bs)
+ return (B.head bs)
+
+takeBits ∷ (Integral n, Bitstream bs, Bits a) ⇒ STRef s bs → n → ST s a
+{-# INLINEABLE takeBits #-}
+takeBits bsr n
+ = do bs ← readSTRef bsr
+ writeSTRef bsr (B.drop n bs)
+ return (B.toBits (B.take n bs))