From: PHO <pho@cielonegro.org>
Date: Thu, 21 Jul 2011 18:02:18 +0000 (+0900)
Subject: takeWhileLessThan
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=281f6781b81e7b77876d4e218e347a914e3ac2a0;p=wavpack.git
takeWhileLessThan
---
diff --git a/Codec/Audio/WavPack/Words.hs b/Codec/Audio/WavPack/Words.hs
index 182c23c..4b81f84 100644
--- a/Codec/Audio/WavPack/Words.hs
+++ b/Codec/Audio/WavPack/Words.hs
@@ -96,7 +96,15 @@ getWordsLossless isMono w bs nSamples0
do lift $ MV.unsafeWrite v n 0
continue
else
- error "FIXME"
+ 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"
{-
@@ -284,7 +292,7 @@ readCode bs 1 = fmap b2n $ takeHead bs
readCode bs maxCode
= do let bitCount = countBits maxCode
extras = bit bitCount - maxCode - 1
- code â takeBits bs (bitCount - 1)
+ code â takeBits (bitCount - 1) bs
if code ⥠extras then
do nextBit â takeHead bs
return $ (code `shiftL` 1) - extras + b2n nextBit
@@ -298,9 +306,27 @@ takeHead bsr
writeSTRef bsr (B.tail bs)
return (B.head bs)
-takeBits â· (Integral n, Bitstream bs, Bits a) â STRef s bs â n â ST s a
+takeWhileLessThan â· (Integral n, Bitstream bs)
+ â (Bool â Bool)
+ â n
+ â STRef s bs
+ â ST s n
+{-# INLINEABLE takeWhileLessThan #-}
+takeWhileLessThan f n bsr = go 0
+ where
+ {-# INLINE go #-}
+ go i | i < n
+ = do b â takeHead bsr
+ if b then
+ go (i + 1)
+ else
+ return i
+ | otherwise
+ = return i
+
+takeBits â· (Integral n, Bitstream bs, Bits a) â n â STRef s bs â ST s a
{-# INLINEABLE takeBits #-}
-takeBits bsr n
+takeBits n bsr
= do bs â readSTRef bsr
writeSTRef bsr (B.drop n bs)
return (B.toBits (B.take n bs))