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?p=wavpack.git;a=commitdiff_plain;h=281f6781b81e7b77876d4e218e347a914e3ac2a0

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))