From: PHO Date: Tue, 1 Mar 2011 15:31:24 +0000 (+0900) Subject: started implementing readCode X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=37c42ce6bcf9fef0a16b9c142288a2655a2b3556;p=wavpack.git started implementing readCode --- diff --git a/Codec/Audio/WavPack/Internal.hs b/Codec/Audio/WavPack/Internal.hs index 5769a3f..7d3cdf4 100644 --- a/Codec/Audio/WavPack/Internal.hs +++ b/Codec/Audio/WavPack/Internal.hs @@ -14,6 +14,8 @@ module Codec.Audio.WavPack.Internal , exp2 , countBits + + , b2n ) where import Data.Int @@ -26,6 +28,7 @@ import Prelude.Unicode -- signed character version for storage in metadata. The weights are -- clipped here in the case they are outside that range. packWeight ∷ Int16 → Word8 +{-# INLINEABLE packWeight #-} packWeight !w = let !w' | w > 1024 = 1024 | w < -1024 = -1024 @@ -43,6 +46,7 @@ packWeight !w -- > unpackWeight . packWeight = id -- unpackWeight ∷ Word8 → Int16 +{-# INLINEABLE unpackWeight #-} unpackWeight !w = let w' ∷ Int8 w' = fromIntegral w @@ -57,6 +61,7 @@ unpackWeight !w -- input values are valid and the return values are in the range of -- +/-8192. log2s ∷ Int32 → Int16 +{-# INLINE log2s #-} log2s !n | n < 0 = fromIntegral $ negate $ log2 $ fromIntegral $ negate n | otherwise = fromIntegral $ log2 $ fromIntegral n @@ -78,24 +83,25 @@ log2s !n -- value. The maximum value allowed is about 0xff800000 and returns -- 8447. log2 ∷ Word32 → Word16 +{-# INLINEABLE log2 #-} log2 !n | n' < (1 `shiftL` 8) = let dbits ∷ Word16 - dbits = fromIntegral $ getNBits $ fromIntegral n' + !dbits = getNBits $ fromIntegral n' !index = (n' `shiftL` fromIntegral (9 - dbits)) .&. 0xFF - !log2n = fromIntegral $ getLog2 $ fromIntegral index + !log2n = getLog2 $ fromIntegral index in (dbits `shiftL` 8) + log2n | otherwise = let dbits ∷ Word16 - dbits | n' < (1 `shiftL` 16) - = fromIntegral (getNBits $ fromIntegral $ n' `shiftR` 8) + 8 - | n' < (1 `shiftL` 24) - = fromIntegral (getNBits $ fromIntegral $ n' `shiftR` 16) + 16 - | otherwise - = fromIntegral (getNBits $ fromIntegral $ n' `shiftR` 24) + 24 + !dbits | n' < (1 `shiftL` 16) + = (getNBits $ fromIntegral $ n' `shiftR` 8) + 8 + | n' < (1 `shiftL` 24) + = (getNBits $ fromIntegral $ n' `shiftR` 16) + 16 + | otherwise + = (getNBits $ fromIntegral $ n' `shiftR` 24) + 24 !index = (n' `shiftR` fromIntegral (dbits - 9)) .&. 0xFF - !log2n = fromIntegral $ getLog2 $ fromIntegral index + !log2n = getLog2 $ fromIntegral index in (dbits `shiftL` 8) + log2n where @@ -107,6 +113,7 @@ log2 !n -- since a full 32-bit value is returned this can be used for unsigned -- conversions as well (i.e. the input range is -8192 to +8447). exp2s ∷ Int16 → Int32 +{-# INLINE exp2s #-} exp2s !l | l < 0 = fromIntegral $ negate $ exp2 $ fromIntegral $ negate l | otherwise = fromIntegral $ exp2 $ fromIntegral l @@ -114,9 +121,10 @@ exp2s !l -- | Return the original integer represented by the supplied logarithm -- (at least within the provided accuracy). exp2 ∷ Word16 → Word32 +{-# INLINEABLE exp2 #-} exp2 !l = let exp2l ∷ Word32 - exp2l = fromIntegral (getExp2 $ fromIntegral $ l .&. 0xFF) .|. 0x100 + exp2l = (getExp2 $ fromIntegral $ l .&. 0xFF) .|. 0x100 l' ∷ Word32 l' = fromIntegral $ l `shiftR` 8 in @@ -127,15 +135,23 @@ exp2 !l -- | 'countBits' @av@ returns the number of bits that is required to -- represent @av@. -countBits ∷ Word32 → Word8 +countBits ∷ Num a ⇒ Word32 → a +{-# INLINEABLE countBits #-} countBits av | av < (1 `shiftL` 8) = getNBits (fromIntegral av) | av < (1 `shiftL` 16) = getNBits (fromIntegral (av `shiftR` 8)) + 8 | av < (1 `shiftL` 24) = getNBits (fromIntegral (av `shiftR` 16)) + 16 | otherwise = getNBits (fromIntegral (av `shiftR` 24)) + 24 -getNBits ∷ Word8 → Word8 -getNBits = UV.unsafeIndex nbitsTable ∘ fromIntegral +-- | Return 0 for 'False' and 1 for 'True'. +b2n ∷ Num a ⇒ Bool → a +{-# INLINE b2n #-} +b2n True = 1 +b2n False = 0 + +getNBits ∷ Num a ⇒ Word8 → a +{-# INLINE getNBits #-} +getNBits = fromIntegral ∘ UV.unsafeIndex nbitsTable ∘ fromIntegral where nbitsTable ∷ UV.Vector Word8 nbitsTable @@ -158,8 +174,9 @@ getNBits = UV.unsafeIndex nbitsTable ∘ fromIntegral , 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8 -- 240 - 255 ] -getLog2 ∷ Word8 → Word8 -getLog2 = UV.unsafeIndex log2Table ∘ fromIntegral +getLog2 ∷ Num n ⇒ Word8 → n +{-# INLINE getLog2 #-} +getLog2 = fromIntegral ∘ UV.unsafeIndex log2Table ∘ fromIntegral where log2Table ∷ UV.Vector Word8 log2Table @@ -182,8 +199,9 @@ getLog2 = UV.unsafeIndex log2Table ∘ fromIntegral , 0xF4, 0xF5, 0xF6, 0xF7, 0xF7, 0xF8, 0xF9, 0xF9, 0xFa, 0xFB, 0xFC, 0xFC, 0xFD, 0xFE, 0xFF, 0xFF ] -getExp2 ∷ Word8 → Word8 -getExp2 = UV.unsafeIndex exp2Table ∘ fromIntegral +getExp2 ∷ Num n ⇒ Word8 → n +{-# INLINE getExp2 #-} +getExp2 = fromIntegral ∘ UV.unsafeIndex exp2Table ∘ fromIntegral where exp2Table ∷ UV.Vector Word8 exp2Table diff --git a/Codec/Audio/WavPack/Unpack.hs b/Codec/Audio/WavPack/Unpack.hs new file mode 100644 index 0000000..8d27906 --- /dev/null +++ b/Codec/Audio/WavPack/Unpack.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} +module Codec.Audio.WavPack.Unpack + ( + ) + where +import Codec.Audio.WavPack.Internal +import Data.Bits +import Data.Bitstream.Generic (Bitstream) +import qualified Data.Bitstream.Generic as B +import Data.Word + +-- Read a single unsigned value from the specified bitstream with a +-- value from 0 to maxCode. If there are exactly a power of two number +-- of possible codes then this will read a fixed number of bits; +-- otherwise it reads the minimum number of bits and then determines +-- whether another bit is needed to define the code. +readCode ∷ Bitstream bs ⇒ bs → Word32 → (Word32, bs) +{-# INLINEABLE readCode #-} +readCode bs 0 = (0, bs) +readCode bs 1 = (b2n $ B.head bs, B.tail bs) +readCode bs maxCode + = let !bitCount = countBits maxCode + !extras = (1 `shiftL` bitCount) - maxCode - 1 + in + error "unk" \ No newline at end of file diff --git a/wavpack.cabal b/wavpack.cabal index 06ebd95..399a284 100644 --- a/wavpack.cabal +++ b/wavpack.cabal @@ -46,6 +46,7 @@ Library Codec.Audio.WavPack.Decorrelation Codec.Audio.WavPack.Internal Codec.Audio.WavPack.Metadata + Codec.Audio.WavPack.Unpack GHC-Options: -Wall