]> gitweb @ CieloNegro.org - wavpack.git/blob - Codec/Audio/WavPack/Words.hs
fb08b5e68875d280f93dfca55ef2b08e1be2576d
[wavpack.git] / Codec / Audio / WavPack / Words.hs
1 {-# LANGUAGE
2     BangPatterns
3   , FlexibleContexts
4   , ScopedTypeVariables
5   , UnboxedTuples
6   , UnicodeSyntax
7   #-}
8 -- | FIXME
9 module Codec.Audio.WavPack.Words
10     ( WordsData(..)
11     )
12     where
13 import Codec.Audio.WavPack.Entropy
14 import Codec.Audio.WavPack.Internal
15 import Data.Bits
16 import Data.Bitstream.Generic (Bitstream)
17 import qualified Data.Bitstream.Generic as B
18 import Data.Int
19 import qualified Data.Vector.Generic as GV
20 import qualified Data.Vector.Generic.Mutable as MV
21 import Data.Vector.Generic.New (New)
22 import qualified Data.Vector.Generic.New as New
23 import Data.Word
24 import Prelude.Unicode
25
26 -- | FIXME
27 data WordsData
28     = WordsData {
29         wdBitrateDelta ∷ !(Word32, Word32)
30       , wdBitrateAcc   ∷ !(Word32, Word32)
31       , wdPendingData  ∷ !Word32
32       , wdHoldingOne   ∷ !Word32
33       , wdZeroesAcc    ∷ !Word32
34       , wdHoldingZero  ∷ !Bool
35       , wdPendingCount ∷ !Int
36       , wdEntropyData  ∷ !(EntropyData, EntropyData)
37       }
38     deriving (Eq, Show)
39
40 -- | This is an optimized version of 'getWord' that is used for
41 -- lossless only ('edErrorLimit' ≡ 0). Also, rather than obtaining a
42 -- single sample, it can be used to obtain an entire buffer of either
43 -- mono or stereo samples.
44 getWordsLossless ∷ ∀bs n v. (Bitstream bs, Integral n, GV.Vector v Int32)
45                  ⇒ Bool -- ^ Is the stream monaural?
46                  → WordsData
47                  → bs -- ^ WV bitstream.
48                  → n  -- ^ Number of samples to get.
49                  → (# WordsData, bs, v Int32 #)
50 {-# INLINEABLE getWordsLossless #-}
51 getWordsLossless isMono w0 bs0 nSamples0
52     = let v0  = New.create $ MV.new $ fromIntegral nSamples
53           (# w1, bs1, n1, v1 #)
54               = go w0 bs0 0 v0
55           v2  = GV.new $ New.take (fromIntegral n1) v1
56       in
57         (# w1, bs1, v2 #)
58     where
59       nSamples ∷ n
60       {-# INLINE nSamples #-}
61       nSamples = if isMono
62                  then nSamples0
63                  else nSamples0 ⋅ 2
64
65       go ∷ WordsData
66          → bs
67          → n
68          → New v Int32
69          → (# WordsData, bs, n, New v Int32 #)
70       {-# INLINE go #-}
71       go w bs n v
72           | n ≥ nSamples = (# w, bs, n, v #)
73           | otherwise
74               = error "FIXME"
75           where
76             c ∷ EntropyData
77             c | n `rem` 2 ≡ 0 = fst $ wdEntropyData w
78               | otherwise     = snd $ wdEntropyData w
79
80 -- | Read a single unsigned value from the specified bitstream with a
81 -- value from 0 to maxCode. If there are exactly a power of two number
82 -- of possible codes then this will read a fixed number of bits;
83 -- otherwise it reads the minimum number of bits and then determines
84 -- whether another bit is needed to define the code.
85 readCode ∷ Bitstream bs ⇒ bs → Word32 → (# Word32, bs #)
86 {-# INLINEABLE readCode #-}
87 readCode bs 0       = (# 0, bs #)
88 readCode bs 1       = (# b2n (B.head bs), B.tail bs #)
89 readCode bs maxCode
90     = let !bitCount = countBits maxCode
91           !extras   = bit bitCount - maxCode - 1
92           !code     = B.toBits (B.take (bitCount - 1) bs)
93           (# code', bitCount' #)
94                     = if code ≥ extras then
95                           (# (code `shiftL` 1)
96                              - extras
97                              + b2n (bs B.!! bitCount)
98                            , bitCount #)
99                       else
100                           (# code, bitCount - 1 #)
101           !bs'      = B.drop bitCount' bs
102       in
103         (# code', bs' #)