+-- | 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 s. (Bitstream bs, MV.MVector v Int32)
+ ⇒ Bool -- ^ Is the stream monaural?
+ → WordsData s
+ → STRef s bs -- ^ WV bitstream
+ → Int -- ^ Number of samples to get
+ → ST s (v s Int32)
+{-# INLINEABLE getWordsLossless #-}
+getWordsLossless isMono w bs nSamples0
+ = do v ← MV.new nSamples
+ n ← runContT (for 0 (< nSamples) (+ 1) (loop v)) return
+ return $ MV.take n v
+ where
+ nSamples ∷ Int
+ nSamples = if isMono
+ then nSamples0
+ else nSamples0 ⋅ 2
+
+ loop ∷ v s Int32
+ → Int
+ → ContT Int (ST s) ()
+ → ContT Int (ST s) ()
+ → ContT Int (ST s) ()
+ loop v n break continue
+ = do let c | isMono = fst $ wdEntropyData w
+ | n `testBit` 0 = fst $ wdEntropyData w
+ | otherwise = snd $ wdEntropyData w
+ med00 ← lift $ readSTRef (edMedian0 $ fst $ wdEntropyData w)
+ hldZero ← lift $ readSTRef (wdHoldingZero w)
+ hldOne ← lift $ readSTRef (wdHoldingOne w)
+ med10 ← lift $ readSTRef (edMedian0 $ snd $ wdEntropyData w)
+ when (med00 < 2 ∧ hldZero ≡ False ∧ hldOne ≡ 0 ∧ med10 < 2) $
+ do zAcc ← lift $ readSTRef (wdZeroesAcc w)
+ if zAcc > 0 then
+ do lift $ modifySTRef (wdZeroesAcc w) ((-) 1)
+ when (zAcc > 1) $
+ do lift $ MV.unsafeWrite v n 0
+ continue
+ else
+ do cBits ← lift $ takeWhileLessThan id 33 bs
+
+ when (cBits ≡ 33) $
+ break
+
+ if cBits < 2 then
+ lift $ writeSTRef (wdZeroesAcc w) cBits
+ else
+ error "FIXME"
+ error "FIXME"
+
+{-
+getWordsLossless ∷ ∀bs v. (Bitstream bs, GV.Vector v Int32)
+ ⇒ Bool -- ^ Is the stream monaural?
+ → WordsData
+ → bs -- ^ WV bitstream.
+ → Int -- ^ Number of samples to get.
+ → (# WordsData, bs, v Int32 #)
+{-# INLINEABLE getWordsLossless #-}
+getWordsLossless isMono w0 bs0 nSamples0
+ = let v0 = New.create $ MV.new nSamples
+ (# w1, bs1, n1, v1 #)
+ = go0 w0 bs0 0 v0
+ v2 = GV.new $ New.take n1 v1
+ in
+ (# w1, bs1, v2 #)
+ where
+ go0 ∷ WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go0 w bs n v
+ | n ≥ nSamples
+ = (# w, bs, n, v #)
+ | edMedian0 (fst $ wdEntropyData w) < 2 ∧
+ wdHoldingZero w ≡ False ∧
+ wdHoldingOne w ≡ 0 ∧
+ edMedian1 (fst $ wdEntropyData w) < 2
+ = if wdZeroesAcc w > 0 then
+ let w' = w { wdZeroesAcc = wdZeroesAcc w - 1 }
+ in
+ if wdZeroesAcc w' > 0 then
+ let (# n', v' #) = appendWord 0 n v
+ in
+ go0 w' bs n' v'
+ else
+ go1 w' bs n v
+ else
+ let cBits = min 33 $ B.length (B.takeWhile id bs)
+ bs' = B.drop cBits bs
+ in
+ if cBits ≡ 33 then
+ (# w, bs', n, v #)
+ else
+ let (# w', bs'' #) = go0' cBits w bs'
+ in
+ if wdZeroesAcc w' > 0 then
+ let w'' = w' {
+ wdEntropyData =
+ ( clearMedian $ fst $ wdEntropyData w'
+ , clearMedian $ snd $ wdEntropyData w' )
+ }
+ (# n', v' #)
+ = appendWord 0 n v
+ in
+ go0 w'' bs'' n' v'
+ else
+ go1 w' bs'' n v
+ | otherwise
+ = go1 w bs n v
+
+ go0' ∷ Word32 → WordsData → bs → (# WordsData, bs #)
+ go0' cBits w bs
+ | cBits < 2
+ = let w' = w { wdZeroesAcc = cBits }
+ in
+ (# w', bs #)
+ | otherwise
+ = let w' = w { wdZeroesAcc = 0 }
+ in
+ go0'' 1 cBits w' bs
+
+ go0'' ∷ Word32 → Word32 → WordsData → bs → (# WordsData, bs #)
+ go0'' mask cBits w bs
+ | cBits ≡ 1
+ = let w' = w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ in
+ (# w', bs #)
+ | otherwise
+ = let cBits' = cBits - 1
+ w' = if B.head bs then
+ w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ else
+ w
+ mask' = mask `shiftL` 1
+ bs' = B.tail bs
+ in
+ go0'' mask' cBits' w' bs'