takeWhileLessThan

diff --git a/Codec/Audio/WavPack/Words.hs b/Codec/Audio/WavPack/Words.hs
index 182c23ce4e03b8b59fee8211d57951a93c7780dc..4b81f840a21fc8fdf415c0ffce1c87a3620c7e7e 100644 (file)
--- 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))